Circular Embedding

Author

Eric W. Weisstein
October 26, 2010

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/CircularEmbedding.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/CircularEmbedding.html.

©2010 Wolfram Research, Inc. except for portions noted otherwise

Code

LCFEmbeddingQ[g_Graph,prec_:2]:=Module[{v=N[PropertyValue[g,VertexCoordinates]],rim},
FreeQ[v,{0,0}|{0.,0.}]&&Chop[Norm[Total[v]],10^-2]==0&&Length[Union[Round[10^prec Norm/@v]]]==1&&Intersection[List@@@EdgeList[g],rim=Sort[Sort/@Partition[Ordering[Mod[ArcTan@@@v,2π]],2,1,1]]]==rim
]

CircularEmbeddingQ[g_System`Graph,prec_:2]:=Module[{v=N[PropertyValue[g,VertexCoordinates]]},
FreeQ[v,{0.,0.}]&&Chop[Norm[Total[v]],10^-2]==0&&Length[Union[Round[10^prec Norm/@v]]]==1
]

CircularEmbeddingQ[g_Combinatorica`Graph,prec_:2]:=Module[{v=N[Vertices[g]]},
FreeQ[v,{0.,0.}]&&Chop[Norm[Total[v]],10^-2]==0&&Length[Union[Round[10^prec Norm/@v]]]==1
]

LCFFromEmbedding[g_]:=Module[{v=N[Vertices[g]],n,lcf,min,c},
n=Length[v];
c=Complement[Sort/@(Edges[g]/.Thread[Ordering[Mod[ArcTan@@@v,2π]]->Range[n]]),Sort/@Partition[Range[n],2,1,1]];
lcf=Sort/@Mod[MapIndexed[Flatten[#2[[1]]-Position[#1,1]]&,ToAdjacencyMatrix[FromUnorderedPairs[c]]]-1,n,-n/2]+1;
min=Select[Table[Take[lcf,#],{n/#}]&/@Divisors[n],Join@@#==lcf&,1];
LCFMinimal[min[[1,1]],n/Length[min[[1,1]]]]
]

Graphic

Monitor[Length[g=Select[GraphData["Connected"],GraphData[g=#,"Embeddings","Circular"]=!={}&]],g]

RandomSample[g,10]

GraphData/@%30

Examples

g=GraphData["CubicalGraph","Graphs","All"]

Graphics[Point[{{0.707`,0.707`},{0.`,1.`},{-0.707`,0.707`},{-1.`,0.`},{0.707`,-0.707`},{1.`,0.`},{-0.707`,-0.707`},{0.`,-1.`}}],Axes->True]

LCFEmbeddingQ/@g

Missing/Inconsistent

Circulant

Monitor[Select[GraphData[All],Count[Flatten[GraphData[g=#,"EmbeddingClasses"]],"Circulant"]=!=Count[GraphData[#,"StandardNames"],{"Circulant",_}]&],g]

Circular

(l=Monitor[Select[GraphData[All],Count[CircularEmbeddingQ/@GraphData[g=#,"Graphs","All"],True]=!=Count[Flatten[GraphData[#,"EmbeddingClasses"]],"Circular"]&],g])//Timing//AbsoluteTiming

{"Foster602A","Foster602B","Foster614A","Foster618A","Foster626A","Foster654A","Foster662A","Foster674A","Foster686A","Foster698A","Foster722A","Foster734A","Foster746A","Foster758A","Foster762A","Foster794A","Foster798A","Foster798B","Foster806A","Foster806B","Foster818A","Foster834A","Foster842A","Foster854A","Foster854B","Foster866A","Foster878A","Foster906A","Foster914A","Foster926A","Foster938A","Foster938B","Foster942A","Foster962B","Foster974A","Foster978A","Foster998A"}

(l=Monitor[Select[GraphData[;;8],Count[Function[e,CircularEmbeddingQ[ChangeVertices[Graph[g=#],e]]]/@GraphData[#,"Embeddings"],True]=!=Count[Flatten[GraphData[#,"EmbeddingClasses"]],"Circular"]&],g])//Timing//AbsoluteTiming

Graph[{"Antiprism",4}]

CircularEmbeddingQ/@GraphData[g,"Graphs","All"]

GraphData[g,"EmbeddingClasses"]

Count[Flatten[GraphData[g,"EmbeddingClasses"]],"Circular"]

LCF