geodesics10=RankedGeodesics[ellipsoid113,15];
In[]:=
Position[geodesics10,926]
In[]:=
{{220,2,1,1}}
Out[]=
geodesics10〚Position[geodesics10,926]〚All,1〛〛
In[]:=
Out[]=
FindShortestPath[ellipsoid113,926,3251]〚16〛
In[]:=
2060
Out[]=
geodesics10Horizontal=RankedGeodesics[ellipsoid113,15,{926,2060,3251}];
In[]:=
geodesics10Horizontal〚{1,-40}〛
In[]:=
Out[]=
geodesics10Horizontal〚-40;;-1〛
In[]:=
1936,2281
tube[graph_,v1_,v2_,r_]:=NeighborhoodGraph[graph,FindShortestPath[graph,v1,v2],r]
In[]:=
HighlightGraph[ellipsoid113,{Style[tube[ellipsoid113,926,3251,3],Red],Style[tube[ellipsoid113,1936,2281,3],Red]}]
In[]:=
Out[]=
gg=NeighborhoodGraph[GridGraph[{10,10}],56,4];
In[]:=
Graph[gg,VertexLabelsAutomatic]
In[]:=
Out[]=
geodesics=RankedGeodesics[gg,4,{60,56,52}];
In[]:=
geodesics〚12〛
In[]:=
Out[]=
HighlightGraph[gg,Append[Style[Subgraph[gg,FindShortestPath[gg,##]&@@#〚2,1〛],ColorData["TemperatureMap"][#〚1〛/8]]&/@geodesics〚2;;〛,Style[Subgraph[gg,FindShortestPath[gg,##]&@@geodesics〚1,2,1〛],ColorData["TemperatureMap"][0/8]]]]
In[]:=
Out[]=
geodesics
In[]:=
RankedGeodesics
,4,{60,56,52}
In[]:=
Out[]=
Association[%]
In[]:=
Out[]=
Last/@Values[%]
In[]:=
Out[]=
geodesicsSequence[graph_,radius_,vs:{v1_,center_,v2_}]:=Last/@Values[Association[RankedGeodesics[graph,radius,vs]]]
In[]:=
geodesicsSequence[GridGraph[{10,10}],4,{60,56,52}]
In[]:=
Out[]=
Graph3D[NeighborhoodGraph[GridGraph[{10,10,10}],445,4],VertexLabelsAutomatic]
In[]:=
Out[]=
Function[{g},Graph3D[g,ImageSize65,BaseStyle{Graphics3DBoxOptions{Method{"ShrinkWrap"True}}},EdgeShapeFunction(Tube[#,If[MemberQ[GraphHighlight/.Options[g,GraphHighlight],#2],0.2,.065]]&)]]/@geodesicsSequence[GridGraph[{10,10,10}],4,{45,445,845}]
In[]:=
Out[]=
NeighborhoodGraph[BuckyballGraph[7,"Embedded"],357,4,VertexLabelsAutomatic]
In[]:=
Out[]=
RandomChoice[VertexList[BuckyballGraph[7,"Embedded"]]]
In[]:=
357
Out[]=
Function[{g},Graph3D[g,ImageSize65,BaseStyle{Graphics3DBoxOptions{Method{"ShrinkWrap"True}}},EdgeShapeFunction(Tube[#,If[MemberQ[GraphHighlight/.Options[g,GraphHighlight],#2],0.01,.005]]&)]]/@geodesicsSequence[BuckyballGraph[7,"Embedded"],4,{221,357,519}]
In[]:=
Out[]=
PlanarGraph[#,ImageSizeTiny,VertexSizeTiny]&/@Apply[UndirectedEdge,(WolframModel[{{0,1},{2,1}}{{0,2}},#,"FinalState"]&)/@WolframModel[{{0,1},{0,2},{0,3}}{{4,5},{6,5},{4,7},{8,7},{6,9},{8,9},{4,1},{6,2},{8,3}},{{0,1},{2,1},{0,3},{4,3},{0,5},{6,5},{2,7},{4,7},{2,8},{6,8},{4,9},{6,9}},4,"StatesList"],{2}]
In[]:=
Out[]=
RankedGeodesics
,5
In[]:=
Out[]=
RankedGeodesics
,5
In[]:=
Out[]=
RankedGeodesics,6
In[]:=
Out[]=
NeighborhoodGraphIndexGraph
,{1},6
In[]:=
Out[]=
TableMaxFirst/@RankedGeodesics
,r,{r,8}
In[]:=
{1,3,5,7,9,3,5,7}
Out[]=
ListLinePlot[%]
In[]:=
Out[]=
Mean[%%]//N
In[]:=
5.
Out[]=
{1,3,5,7,9,3,5,7}/(2Range[8])
In[]:=
,,,,,,,
1
2
3
4
5
6
7
8
9
10
1
4
5
14
7
16
Out[]=
N[%]
In[]:=
{0.5,0.75,0.833333,0.875,0.9,0.25,0.357143,0.4375}
Out[]=