WOLFRAM NOTEBOOK

In[]:=
GraphNeighborhoodVolumes[GridGraph[{10,10}],{50}]
Out[]=
50{1,4,9,16,25,35,45,55,65,75,84,91,96,99,100}

Computing Center of Graph

In[]:=
GraphCenter[GridGraph[{10,10}]]
Out[]=
{45,46,55,56}
In[]:=
HighlightGraph[GridGraph[{10,10}],GraphCenter[GridGraph[{10,10}]],VertexSize.3]
Out[]=
In[]:=
With[{g=UndirectedGraph[HypergraphToGraph[WolframModel[{{1,2,3}}{{1,4,6},{2,5,4},{3,6,5}},{{0,0,0}},4,"FinalState"]]]},HighlightGraph[g,GraphCenter[g],VertexSize3]]
Out[]=
In[]:=
With[{g=UndirectedGraph[Rule@@@WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}},{{0,0},{0,0}},8,"FinalState"],GraphLayout"SpringElectricalEmbedding"]},HighlightGraph[g,GraphCenter[g],VertexSize2]]
Out[]=
In[]:=
With[{g=UndirectedGraph[Rule@@@WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}},{{0,0},{0,0}},10,"FinalState"],GraphLayout"SpringElectricalEmbedding"]},HighlightGraph[g,GraphCenter[g],VertexSize4]]
Out[]=

Computing balls

MakeBallPicture[g_,rmax_]:=Module[{gg=UndirectedGraph[g],cg},cg=GraphCenter[gg];Table[HighlightGraph[gg,NeighborhoodGraph[gg,cg,r]],{r,0,rmax}]]
In[]:=
MakeBallPicture[GridGraph[{11,11}],5]
Out[]=
In[]:=
Graph[#,ImageSizeTiny]&/@%141
Out[]=
In[]:=
MakeBallPicture[GridGraph[{7,7,7}],5]
Out[]=
In[]:=
MakeBallPicture[UndirectedGraph[Rule@@@WolframModel[{{x,y},{x,z}}{{x,z},{x,w},{y,w},{z,w}},{{0,0},{0,0}},10,"FinalState"],GraphLayout"SpringElectricalEmbedding"],5]
Out[]=

Random Case

Dimension measurement

Sierpinski

Measurements

Wolfram Cloud

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.


I understand and wish to continue anyway »

You are using a browser not supported by the Wolfram Cloud. Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.