Chilakamarri Graphs

Author

Eric W. Weisstein
April 26, 2024

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

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

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

Figure

chilakamarri=SortBy[GraphData["Chilakamarri*"],GraphData[#,"V"]&]

GraphicsRow[Show[GraphData[#]//StyleGraphs,PlotLabel->GraphData[#,"Name"],LabelStyle->Directive[14,Black,Italic,FontFamily->"Times"]]&/@{"ChilakamarriGraphCore","ChilakamarriButterflyGraph","ChilakamarriMothGraph"},Dividers->All,ImageSize->700]

Embeddings

<<MathWorld`Graphs`

"ChilakamarriButterflyGraph"

Names

GraphData["ChilakamarriButterflyGraph","StandardName"]

GraphData["ChilakamarriButterflyGraph","StandardNames"]

Primary

GraphData["ChilakamarriButterflyGraph"]//StyleGraphs[#,ImageSize->Small]&

All

GraphData["ChilakamarriButterflyGraph","Graph","All"]//StyleGraphs

Inexact

Select[GraphData["ChilakamarriButterflyGraph","Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData["ChilakamarriButterflyGraph","EdgeList"]]

Default embedding

GraphPlot@GraphData["ChilakamarriButterflyGraph","Edges"]

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Degenerate

GraphData["ChilakamarriButterflyGraph","Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData["ChilakamarriButterflyGraph","Graph","Degenerate"]

Configuration

GraphData["ChilakamarriButterflyGraph","Configuration"]

GraphData["ChilakamarriButterflyGraph","Graph","Configuration"]//StyleGraphs

Perspective

GraphData["ChilakamarriButterflyGraph","Graph","Perspective"]//StyleGraphs

Perspective construction

GraphData["ChilakamarriButterflyGraph","Polyhedron"]

HoneycombToroidal construction

GraphData["ChilakamarriButterflyGraph","NotationRules","HoneycombToroidal"]

GeneralizedPetersen

GraphData["ChilakamarriButterflyGraph","Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData["ChilakamarriButterflyGraph","Graph","IGraph"]//StyleGraphs

Bilateral

GraphData["ChilakamarriButterflyGraph","Graph","Bilateral"]//StyleGraphs

Circular

GraphData["ChilakamarriButterflyGraph","Graph","Circular"]//StyleGraphs

Planar

GraphData["ChilakamarriButterflyGraph","Planar"]

GraphData["ChilakamarriButterflyGraph","Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData["ChilakamarriButterflyGraph",{"RCN","CN"}]

GraphData["ChilakamarriButterflyGraph","Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData["ChilakamarriButterflyGraph"],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriButterflyGraph"],TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriButterflyGraph"],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriButterflyGraph"],TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriButterflyGraph"],TimeConstraint->5 3600])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["ChilakamarriButterflyGraph"],"CrossingNumber"->cn])//PolyhedralGraphQ

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["ChilakamarriButterflyGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData["ChilakamarriButterflyGraph","V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData["ChilakamarriButterflyGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union//Timing

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["ChilakamarriButterflyGraph","Circulant"]

GraphData["ChilakamarriButterflyGraph","Graph","Circulant"]//StyleGraphs

Complement graph

compl=GraphData["ChilakamarriButterflyGraph","ComplementGraph","Name"]

Line graph

GraphData["ChilakamarriButterflyGraph","Line"]

LineGraphQ[GraphData["ChilakamarriButterflyGraph"]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== "ChilakamarriButterflyGraph"&]

RootGraph[GraphData["ChilakamarriButterflyGraph"]]

Halin

GraphData["ChilakamarriButterflyGraph","Halin"]

GraphData["ChilakamarriButterflyGraph","Graph","Halin"]//StyleGraphs

Rigid

GraphData["ChilakamarriButterflyGraph","Rigid"]

GraphData["ChilakamarriButterflyGraph","Graph","Rigid"]//StyleGraphs

Flexible

GraphData["ChilakamarriButterflyGraph","Flexible"]

GraphData["ChilakamarriButterflyGraph","Graph","Flexible"]//StyleGraphs

LCF

GraphData["ChilakamarriButterflyGraph","LCF"]

GraphData["ChilakamarriButterflyGraph","HamiltonianCycleCount"]

GraphData["ChilakamarriButterflyGraph","LCFSignature"]

GraphData["ChilakamarriButterflyGraph","LCFNotations"]

GraphData["ChilakamarriButterflyGraph","Graph","LCF"]//StyleGraphs

Tally[LCFNotation[#][[2]]&/@%]

UnitDistance

GraphData["ChilakamarriButterflyGraph","UnitDistance"]

UnitDistanceGraphQ[GraphData["ChilakamarriButterflyGraph"],Debug->True]//Timing

GraphData["ChilakamarriButterflyGraph","Graph","UnitDistance"]//StyleGraphs

Select[%,!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&]

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ChilakamarriButterflyGraph","VertexList"],GraphData["ChilakamarriButterflyGraph","EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]],MaxIterations->500]&/@Complement@@(GraphData["ChilakamarriButterflyGraph","Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData["ChilakamarriButterflyGraph"],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData["ChilakamarriButterflyGraph"],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{"ChilakamarriButterflyGraph",l=FindSubgraphUnitDistanceEmbedding[GraphData["ChilakamarriButterflyGraph"],TimeConstraint->300,"Results"->All]//Timing}

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

Matchstick

GraphData["ChilakamarriButterflyGraph","Matchstick"]

GraphData["ChilakamarriButterflyGraph","Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData["ChilakamarriButterflyGraph","Edges"]]

3D All

GraphData["ChilakamarriButterflyGraph","Graph",{"3D","All"}]

3D UnitDistance

GraphData["ChilakamarriButterflyGraph","Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData["ChilakamarriButterflyGraph","Polyhedral"]

GraphData["ChilakamarriButterflyGraph","Graph",{"3D","Polyhedron"}]

"ChilakamarriGraphCore"

Names

GraphData["ChilakamarriGraphCore","StandardName"]

GraphData["ChilakamarriGraphCore","StandardNames"]

Primary

GraphData["ChilakamarriGraphCore"]//StyleGraphs[#,ImageSize->Small]&

All

GraphData["ChilakamarriGraphCore","Graph","All"]//StyleGraphs

Inexact

Select[GraphData["ChilakamarriGraphCore","Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData["ChilakamarriGraphCore","EdgeList"]]

Default embedding

GraphPlot@GraphData["ChilakamarriGraphCore","Edges"]

GraphPlot[GraphData["ChilakamarriGraphCore","EdgeList"]]

Mean[v[[#]]]&/@{{5,8},{1,4},{3,6},{2,7}}

v=Join[CirclePoints[Csc[Pi/8]/2,8],{{-(1/2),0},{(1/2),0},{0,(1/2)},{0,-(1/2)}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@Join[Partition[Range[8],2,1,1],{{6,11},{3,11},{7,12},{2,12},{8,9},{5,9},{4,10},{1,10},{9,11},{10,11},{10,12},{9,12}}],VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Degenerate

GraphData["ChilakamarriGraphCore","Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData["ChilakamarriGraphCore","Graph","Degenerate"]

Configuration

GraphData["ChilakamarriGraphCore","Configuration"]

GraphData["ChilakamarriGraphCore","Graph","Configuration"]//StyleGraphs

Perspective

GraphData["ChilakamarriGraphCore","Graph","Perspective"]//StyleGraphs

Perspective construction

GraphData["ChilakamarriGraphCore","Polyhedron"]

HoneycombToroidal construction

GraphData["ChilakamarriGraphCore","NotationRules","HoneycombToroidal"]

GeneralizedPetersen

GraphData["ChilakamarriGraphCore","Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData["ChilakamarriGraphCore","Graph","IGraph"]//StyleGraphs

Bilateral

GraphData["ChilakamarriGraphCore","Graph","Bilateral"]//StyleGraphs

Circular

GraphData["ChilakamarriGraphCore","Graph","Circular"]//StyleGraphs

Circular construction

GraphData["ChilakamarriGraphCore","Hamiltonian"]

GraphData["ChilakamarriGraphCore","HamiltonianCycleCount"]

Length[hc=FindHamiltonianCycle[GraphData["ChilakamarriGraphCore"],All][[All,All,1]]]

circ=CircularEmbeddingFromHamiltonianCycle[GraphData["ChilakamarriGraphCore"],#]&/@hc

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph/@circ],
CircularCanonicalGraphEmbedding]]//Timing

gs=bilat

Length[quad=DeleteDuplicatesBy[Union@Select[bilat,BilateralGraphEmbeddingQ[#,Axis->"X"]&],CircularCanonicalGraphEmbedding[#,4]&]]

quad

gs={,,,,};

Planar

GraphData["ChilakamarriGraphCore","Planar"]

GraphData["ChilakamarriGraphCore","Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData["ChilakamarriGraphCore",{"RCN","CN"}]

GraphData["ChilakamarriGraphCore","Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData["ChilakamarriGraphCore"],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriGraphCore"],TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriGraphCore"],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriGraphCore"],TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriGraphCore"],TimeConstraint->5 3600])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["ChilakamarriGraphCore"],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[g,"OuterFace"->#]&/@faces

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["ChilakamarriGraphCore"],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData["ChilakamarriGraphCore","V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData["ChilakamarriGraphCore"],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union//Timing

GraphPlot@RotateGraph[,2Pi/5]

v={#,#2-3/4}&@@@{{0,3/4},{1,3/4},{1,1},{0,1},{1/2,1},{1/2,1+Sqrt[3]/2},{3/8,6/5},{5/8,6/5},{3/8,7/5},{5/8,7/5},{2/8,6/5},{6/8,6/5}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,6,4,1],e[2,12,6,11,1],e[4,5,3,10,9,4],e[9,7,5,8,10],{7,11},{8,12}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphPlot@RotateGraph[,Pi/5]

v={{0,0},{5,0},{5,5},{0,5},{1,1},{4,1},{2,2},{3,2},{2,3},{3,3},{1,4},{4,4}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,6,5,2,3,4,1,9,12,3],e[4,11,10,8,6,12,11,5],{2,10},e[5,7,9],{7,8}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

gs=UnlabelGraph/@{,}

Circulant

GraphData["ChilakamarriGraphCore","Circulant"]

GraphData["ChilakamarriGraphCore","Graph","Circulant"]//StyleGraphs

Complement graph

compl=GraphData["ChilakamarriGraphCore","ComplementGraph","Name"]

Line graph

GraphData["ChilakamarriGraphCore","Line"]

LineGraphQ[GraphData["ChilakamarriGraphCore"]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== "ChilakamarriGraphCore"&]

RootGraph[GraphData["ChilakamarriGraphCore"]]

Halin

GraphData["ChilakamarriGraphCore","Halin"]

GraphData["ChilakamarriGraphCore","Graph","Halin"]//StyleGraphs

Rigid

GraphData["ChilakamarriGraphCore","Rigid"]

GraphData["ChilakamarriGraphCore","Graph","Rigid"]//StyleGraphs

Flexible

GraphData["ChilakamarriGraphCore","Flexible"]

GraphData["ChilakamarriGraphCore","Graph","Flexible"]//StyleGraphs

LCF

GraphData["ChilakamarriGraphCore","LCF"]

GraphData["ChilakamarriGraphCore","HamiltonianCycleCount"]

GraphData["ChilakamarriGraphCore","LCFSignature"]

GraphData["ChilakamarriGraphCore","LCFNotations"]

GraphData["ChilakamarriGraphCore","Graph","LCF"]//StyleGraphs

Tally[LCFNotation[#][[2]]&/@%]

UnitDistance

GraphData["ChilakamarriGraphCore","UnitDistance"]

UnitDistanceGraphQ[GraphData["ChilakamarriGraphCore"],Debug->True]//Timing

GraphData["ChilakamarriGraphCore","Graph","UnitDistance"]//StyleGraphs

Select[%,!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&]

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ChilakamarriGraphCore","VertexList"],GraphData["ChilakamarriGraphCore","EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]],MaxIterations->500]&/@Complement@@(GraphData["ChilakamarriGraphCore","Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData["ChilakamarriGraphCore"],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData["ChilakamarriGraphCore"],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{"ChilakamarriGraphCore",l=FindSubgraphUnitDistanceEmbedding[GraphData["ChilakamarriGraphCore"],TimeConstraint->300,"Results"->All]//Timing}

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

Matchstick

GraphData["ChilakamarriGraphCore","Matchstick"]

GraphData["ChilakamarriGraphCore","Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData["ChilakamarriGraphCore","Edges"]]

3D All

GraphData["ChilakamarriGraphCore","Graph",{"3D","All"}]

3D UnitDistance

GraphData["ChilakamarriGraphCore","Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData["ChilakamarriGraphCore","Polyhedral"]

GraphData["ChilakamarriGraphCore","Graph",{"3D","Polyhedron"}]

"ChilakamarriMothGraph"

Names

GraphData["ChilakamarriMothGraph","StandardName"]

GraphData["ChilakamarriMothGraph","StandardNames"]

Primary

GraphData["ChilakamarriMothGraph"]//StyleGraphs[#,ImageSize->Small]&

All

GraphData["ChilakamarriMothGraph","Graph","All"]//StyleGraphs

Inexact

Select[GraphData["ChilakamarriMothGraph","Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData["ChilakamarriMothGraph","EdgeList"]]

Default embedding

GraphPlot@GraphData["ChilakamarriMothGraph","Edges"]

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Degenerate

GraphData["ChilakamarriMothGraph","Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData["ChilakamarriMothGraph","Graph","Degenerate"]

Configuration

GraphData["ChilakamarriMothGraph","Configuration"]

GraphData["ChilakamarriMothGraph","Graph","Configuration"]//StyleGraphs

Perspective

GraphData["ChilakamarriMothGraph","Graph","Perspective"]//StyleGraphs

Perspective construction

GraphData["ChilakamarriMothGraph","Polyhedron"]

HoneycombToroidal construction

GraphData["ChilakamarriMothGraph","NotationRules","HoneycombToroidal"]

GeneralizedPetersen

GraphData["ChilakamarriMothGraph","Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData["ChilakamarriMothGraph","Graph","IGraph"]//StyleGraphs

Bilateral

GraphData["ChilakamarriMothGraph","Graph","Bilateral"]//StyleGraphs

Circular

GraphData["ChilakamarriMothGraph","Graph","Circular"]//StyleGraphs

Planar

GraphData["ChilakamarriMothGraph","Planar"]

GraphData["ChilakamarriMothGraph","Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData["ChilakamarriMothGraph",{"RCN","CN"}]

GraphData["ChilakamarriMothGraph","Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData["ChilakamarriMothGraph"],TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriMothGraph"],TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriMothGraph"],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriMothGraph"],TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["ChilakamarriMothGraph"],TimeConstraint->5 3600])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["ChilakamarriMothGraph"],"CrossingNumber"->cn])//PolyhedralGraphQ

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["ChilakamarriMothGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData["ChilakamarriMothGraph","V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData["ChilakamarriMothGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union//Timing

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["ChilakamarriMothGraph","Circulant"]

GraphData["ChilakamarriMothGraph","Graph","Circulant"]//StyleGraphs

Complement graph

compl=GraphData["ChilakamarriMothGraph","ComplementGraph","Name"]

Line graph

GraphData["ChilakamarriMothGraph","Line"]

LineGraphQ[GraphData["ChilakamarriMothGraph"]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== "ChilakamarriMothGraph"&]

RootGraph[GraphData["ChilakamarriMothGraph"]]

Halin

GraphData["ChilakamarriMothGraph","Halin"]

GraphData["ChilakamarriMothGraph","Graph","Halin"]//StyleGraphs

Rigid

GraphData["ChilakamarriMothGraph","Rigid"]

GraphData["ChilakamarriMothGraph","Graph","Rigid"]//StyleGraphs

Flexible

GraphData["ChilakamarriMothGraph","Flexible"]

GraphData["ChilakamarriMothGraph","Graph","Flexible"]//StyleGraphs

LCF

GraphData["ChilakamarriMothGraph","LCF"]

GraphData["ChilakamarriMothGraph","HamiltonianCycleCount"]

GraphData["ChilakamarriMothGraph","LCFSignature"]

GraphData["ChilakamarriMothGraph","LCFNotations"]

GraphData["ChilakamarriMothGraph","Graph","LCF"]//StyleGraphs

Tally[LCFNotation[#][[2]]&/@%]

UnitDistance

GraphData["ChilakamarriMothGraph","UnitDistance"]

UnitDistanceGraphQ[GraphData["ChilakamarriMothGraph"],Debug->True]//Timing

GraphData["ChilakamarriMothGraph","Graph","UnitDistance"]//StyleGraphs

Select[%,!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&]

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ChilakamarriMothGraph","VertexList"],GraphData["ChilakamarriMothGraph","EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]],MaxIterations->500]&/@Complement@@(GraphData["ChilakamarriMothGraph","Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData["ChilakamarriMothGraph"],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData["ChilakamarriMothGraph"],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{"ChilakamarriMothGraph",l=FindSubgraphUnitDistanceEmbedding[GraphData["ChilakamarriMothGraph"],TimeConstraint->300,"Results"->All]//Timing}

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

Matchstick

GraphData["ChilakamarriMothGraph","Matchstick"]

GraphData["ChilakamarriMothGraph","Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData["ChilakamarriMothGraph","Edges"]]

3D All

GraphData["ChilakamarriMothGraph","Graph",{"3D","All"}]

3D UnitDistance

GraphData["ChilakamarriMothGraph","Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData["ChilakamarriMothGraph","Polyhedral"]

GraphData["ChilakamarriMothGraph","Graph",{"3D","Polyhedron"}]

Properties

"ChilakamarriMothGraph"

Chords

(chords={{1,3},{1,4},{1,9},{1,10},{1,14},{1,32},{2,12},{2,29},{2,41},{3,30},{3,45},{4,31},{4,34},{6,12},{6,14},{6,28},{6,29},{6,30},{6,31},{6,32},{6,44},{7,11},{7,26},{7,41},{9,28},{9,33},{10,29},{10,46},{11,18},{11,47},{12,46},{13,18},{13,25},{13,35},{13,41},{14,34},{14,41},{15,25},{15,26},{15,47},{16,25},{16,27},{16,36},{18,22},{18,23},{18,24},{18,26},{18,27},{18,38},{20,23},{20,25},{20,35},{21,24},{21,25},{21,37},{22,25},{22,36},{22,40},{23,41},{24,39},{27,40},{28,42},{30,43},{31,41},{32,33},{32,42},{33,34},{33,46},{34,45},{35,36},{35,37},{36,47},{37,38},{38,39},{39,40},{40,41},{41,42},{42,43},{43,44},{44,45}})//Length

GraphData[gn,"M"]

not=Complement[GraphData[gn,"EdgeIndices"],chords]

HighlightGraph[GraphData[gn,"Graph","Labeled"],UndirectedEdge@@@not,GraphHighlightStyle->"Thick"]

GraphData[gn,"CyclePolynomial"]

VertexColoring

FindVertexColoring[g,Method->"Brelaz"]

Timing[coloring=TimeConstrained[FindVertexColoring[g,Method->"Combinatorica"],600]]

Timing[coloring=TimeConstrained[FindVertexColoring[g,Method->"Trick"],600]]

Timing[coloring=TimeConstrained[FindVertexColoring[g,Method->"Static"],600]]

GraphData[gn,"ChromaticNumber"]

coloring=FindVertexColoring[g,Method->"Brelaz"]

coloring=GraphData[gn,"MinimumVertexColoring"]

VertexDegree[g]

GraphData[gn,"Graph","All"]/.g_System`Graph:>SetProperty[g,{
System`VertexStyle->MapIndexed[#2[[1]]->{Red,Yellow,Green,Blue}[[#]]&,coloring],
VertexSize->1,ImageSize->Large}]

Construction

"ChilakamarriButterflyGraph"

Construction

Used to construct the Chilakamarri moth graph

The Mathematical Coloring Book: Mathematics of Coloring and the Colorful ...
By Alexander Soifer

Length[v0={{768.4294181034483`,43.05702227011477`},{403.1802262931035`,36.177083333333144`},{1068.529094827586`,271.44827586206884`},{719.5339439655172`,174.9957794540228`},{456.8368354885058`,167.61700790229872`},{105.53520114942529`,260.0343929597699`},{738.721713362069`,195.65535201149407`},{583.2983117816092`,227.85228089080442`},{433.6880387931035`,194.18848778735617`},{919.126257183908`,385.8389906609193`},{246.6208692528736`,382.68301005747105`},{953.0024245689655`,625.11566091954`},{788.3481501436781`,553.7579022988504`},{728.1276939655172`,573.0642061781607`},{768.0491199712644`,726.6453843390802`},{663.1806752873564`,573.12347341954`},{585.1652298850574`,539.0250538793101`},{510.88362068965523`,573.7112068965515`},{441.51131465517244`,565.4236709770113`},{385.82974137931035`,544.3936781609193`},{218.51338002873564`,613.7067169540228`},{397.99434267241384`,721.2323096264365`},{714.5604346264367`,913.1643318965514`},{456.6590337643678`,904.7187499999998`}}]

EuclideanDistance@@v0[[{2,6}]]

v=v0/372;

EuclideanDistance@@v[[{23,18}]]

e=Select[Subsets[v,{2}],.96<EuclideanDistance@@#<1.05&]/.Thread[v->Range[24]]

e2=Complement[e,{{9,18}}]

Complement[{{1,2},{1,3},{1,9},{1,10},{2,6},{2,7},{2,11},{3,4},{3,12},{4,13},{4,17},{5,6},{5,20},{6,21},{7,14},{7,17},{8,10},{8,11},{8,13},{8,14},{8,19},{8,20},{9,17},{9,19},{10,15},{10,17},{11,17},{11,22},{12,17},{12,23},{13,23},{14,22},{15,19},{15,22},{15,24},{17,21},{16,24},{20,24},{21,24},{22,23},{18,23},{8,18},{8,16},{5,17}},e2]

remove={{7,13},{7,16},{9,18},{17,24}};
add={{5,17},{8,16},{8,18},{16,24},{18,23}};
e2=Union[add,Complement[e,remove]]

EuclideanDistance@@@(remove/.i_Integer:>v[[i]])

EuclideanDistance@@@(add/.i_Integer:>v[[i]])

EuclideanDistance@@@(e2/.i_Integer:>v[[i]])

Through[{Min,Max}[%]]

g=Graph[Range[24],UndirectedEdge@@@e2,VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph@g

VertexDegree[g]

Tally[Sort[%]]

Core as a subgraph

core=LabelGraph@FindIsomorphicSubgraph[gmain=GraphData["ChilakamarriButterflyGraph"],gcore=GraphData["ChilakamarriGraphCore"]][[1]]

LabelGraph@HighlightGraph[gmain,{VertexList[core],Style[EdgeList[core],Red]}]

Construction: Simultaneous equations

-------- Forwarded Message --------
Subject: Re: simultaneous quadratics
Date: Sat, 17 Mar 2018 11:56:06 -0500
From: Adam Strzebonski

Hi Eric,

This seems to be out of range for all methods I could think of.

Adam

eqn=(SquaredEuclideanDistance@@@{
{{-a,b},{0,(1-(Sqrt[7]))/4}},
{{-a,b},{c,d}},
{{c,d},{e,f}},
{{c,d},{-1/2,(1+(Sqrt[7]))/4}},
{{e,f},{g,h}},
{{g,h},{1/2,(-1-(Sqrt[7]))/4}},
{{0,((Sqrt[7])-1)/4},{e,f}},
{{i,j},{c,d}},
{{i,j},{k,l}},
{{i,j},{0,(1-(Sqrt[7]))/4}},
{{k,l},{g,h}},
{{k,l},{0,((Sqrt[7])-1)/4}}
}/.Abs[x_]^2:>x^2)

eqn//Column//TraditionalForm

Length[eqn]

vars=Variables[eqn]

Length[vars]

v=GraphData[gn,"VertexCoordinates"]

Mean[v0[[{17,8}]]]//N

Mean[v0[[{17,8}]]]

v=(#-{1.5705155129928317`,1.03074910587381`})&/@v0

v={{0.49515496577987905`,-0.9150044223519962`},{-0.4866977003769619`,-0.9334988818594736`},{1.3018745268662708`,-0.30104943957792607`},{0.3637155191725374`,-0.5603303439006304`},{-0.34245950361512767`,-0.5801657512977383`},{-1.2868187357094303`,-0.33173192049808453`},{0.41529554443208494`,-0.504793858531084`},{-0.0025092985261401246`,-0.4182429744469164`},{-0.4046874517210479`,-0.5087370419293042`},{0.9002539955660609`,0.006452481924360098`},{-0.9075561870442467`,-0.0020313369021136563`},{0.9913189616549252`,0.6496693374582869`},{0.5486999443826472`,0.45784740568223947`},{0.38681699766716093`,0.5097460720244715`},{0.4941326589729331`,0.9225987014893089`},{0.21222823777963185`,0.5099053925658137`},{0.0025092985261401246`,0.41824297444691627`},{-0.19717244662279065`,0.5114853212674575`},{-0.3836571402638733`,0.48920699890310204`},{-0.5333387888549006`,0.4326747601501666`},{-0.9831139537758004`,0.6190001332499073`},{-0.5006382477444073`,0.9080474253800517`},{0.3503458704115683`,1.4239937218050918`},{-0.3429374652391548`,1.401290544663824`}};

init={
{a,v[[16,1]]},{b,v[[16,2]]},
{c,v[[23,1]]},{d,v[[23,2]]},
{e,v[[12,1]]},{f,v[[12,2]]},
{g,v[[3,1]]},{h,v[[3,2]]},
{i,v[[13,1]]},{j,v[[13,2]]},
{k,v[[4,1]]},{l,v[[4,2]]}}

v[[{16,23,12,3,13,4}]]//Column

fr=FindRoot[eqn-1,init,WorkingPrecision->100]

Construction: Center and solve for exact coordinates

eqn2=SquaredEuclideanDistance@@@{
{{m,n},{-1/2,(1+(Sqrt[7]))/4}},
{{m,n},{o,p}},
{{o,p},{0,(1/4)((Sqrt[7])-1)}},
{{o,p},{-(1/2),-(1/4)(1+(Sqrt[7]))}}
}/.Abs[x_]^2:>x^2

vars2=Variables[eqn2]

Length[eqn2]

Factor/@GroebnerBasis[eqn2-1,vars2]

Factor/@GroebnerBasis[eqn2-1,{p},{m,n,o}]

Factor/@GroebnerBasis[eqn2-1,{m},{p,n,o}]

Reduce[Thread[eqn2==1],vars2,Reals]

rules2=Solve[Join[Thread[eqn2==1],{m>0,n>0,o>0,p<0}],vars2,Reals][[1]]//FullSimplify

vnew={
{(1/2),-(1/4)(1+(Sqrt[7]))},
{-(1/2),-(1/4)(1+(Sqrt[7]))},
{g,h},
{k,l},
{-k,l},
{-g,h},
{o,p},
{0,(1/4)(1-(Sqrt[7]))},
{-o,p},
{(1/4)((Sqrt[7])+1),0},
{-(1/4)((Sqrt[7])+1),0},
{e,f},
{i,j},
{m,n},
{(1/2),(1/4)(1+(Sqrt[7]))},
{a,b},
{0,(1/4)((Sqrt[7])-1)},
{-a,b},
{-m,n},
{-i,j},
{-e,f},
{-(1/2),(1/4)(1+(Sqrt[7]))},
{c,d},
{-c,d}
}/.fr/.rules2;

Length[vnew]

gnew=System`Graph[Range[24],GraphData["ChilakamarriButterflyGraph","Edges"],VertexCoordinates->vnew]

GraphEmbedding[gnew]

RecognizeGraph[gnew]

GraphData[gn,"Edges","Length"]

EuclideanDistance@@@List@@@(EdgeList[gnew]/.i_Integer:>vnew[[i]])//N

Exactification using RootApproximant on numeric roots

vars

roots=vars/.FindRoot[eqn-1,init,WorkingPrecision->50000];//Timing

N[roots[[All,2]]]

Do[Print[{i,(approx=RootApproximant[N[root=roots[[i]],5000],60])//Timing,N[approx-root,1*^5]}],{i,Length[roots]}]

data={{1,{374.1085`,(NumericalApproximation[Root, (RowDefault["0.163", FEExpressionsNumericalApproximationElider]), Root[10148926970824004196-404306612374742269992 #1+6701598790139372325768 ((#1)^2)-60750625660932855482064 ((#1)^3)+«78»+988039992081106464632625969764499456 ((#1)^55)+462969386386985964366255351643766784 ((#1)^56)-532163121893121834389426743856332800 ((#1)^57)+226471094416756268485085034291658752 ((#1)^58)-50024424363328687523541940602667008 ((#1)^59)+4764230891745589287956375295492096 ((#1)^60)&,12], ])},0``50000.789139303466},{2,{380.105645`,(NumericalApproximation[Root, (RowDefault["0.575", FEExpressionsNumericalApproximationElider]), Root[1215541820747025+157607217909727270 #1+3898819425329297619 ((#1)^2)-109052172313060339846 ((#1)^3)-4680641770985953983698 ((#1)^4)-7738576658179329700752 ((#1)^5)+«73»+336258464315689317919680383197186847932416 ((#1)^55)+82331402062655531055153055267244394676224 ((#1)^56)-89203925917649558933763878479697465573376 ((#1)^57)+29182227993026351668708237795179022516224 ((#1)^58)-4683429535821584093632635170480550051840 ((#1)^59)+312228635721438939575509011365370003456 ((#1)^60)&,20], ])},0``50000.24012807424},{3,{377.016866`,(NumericalApproximation[Root, (RowDefault["0.354", FEExpressionsNumericalApproximationElider]), Root[274434046125201-31941418411090512 #1+1414220559549120540 ((#1)^2)-32303106082391010480 ((#1)^3)+423170235699210145872 ((#1)^4)-3002883227872098112512 ((#1)^5)+«74»+610727511922901287852328641222485737472 ((#1)^55)+2767902315245030692678821877010009161728 ((#1)^56)+6016011341995761423305773718018054946816 ((#1)^57)+5931706862675395909443592549077910290432 ((#1)^58)+2625658016319602099459380453305867042816 ((#1)^59)+437609669386600349909896742217644507136 ((#1)^60)&,22], ])},0``50000.450813657626},{4,{367.544552`,(NumericalApproximation[Root, (RowDefault["1.43", FEExpressionsNumericalApproximationElider]), Root[5307855561-355269646944 #1-20633998579200 ((#1)^2)+815755970158704 ((#1)^3)+«79»+4066585970502282963558424746091610112 ((#1)^56)+361450991862618645237603256359714816 ((#1)^57)-482235740656439055422249016666095616 ((#1)^58)-26709574547521994013055221082619904 ((#1)^59)+26709574547521994013055221082619904 ((#1)^60)&,27], ])},0``49999.84421903967},{5,{354.415809`,(NumericalApproximation[Root, (RowDefault["0.972", FEExpressionsNumericalApproximationElider]), Root[156701317275760049577+1921027598556772608162 #1-62986495656407263132185 ((#1)^2)-31027636325008759131756 ((#1)^3)+«78»+53007455868882731900857192732950528 ((#1)^56)+78078100090697785659009473351516160 ((#1)^57)-18879180632390463512691434795827200 ((#1)^58)-6623084976678890915387551292325888 ((#1)^59)+2207694992226296971795850430775296 ((#1)^60)&,26], ])},0``50000.01222066678},{6,{339.685763`,(NumericalApproximation[Root, (RowDefault["0.645", FEExpressionsNumericalApproximationElider]), Root[1763584+376057728 #1+30543610224 ((#1)^2)+1117527450264 ((#1)^3)+«71»+11988411685307010914267644821504 ((#1)^53)+7009976285274648994350165393408 ((#1)^54)-834787087771481302137418285056 ((#1)^55)-1728922819798225145901380272128 ((#1)^56)-348654242301893137534612930560 ((#1)^57)+133075597099422899468274499584 ((#1)^58)+67373504401437285516230787072 ((#1)^59)+8421688050179660689528848384 ((#1)^60)&,25], ])},0``50000.19019171155},{7,{354.769826`,(NumericalApproximation[Root, (RowDefault["1.29", FEExpressionsNumericalApproximationElider]), Root[3009837937084972317+56054698193375697924 #1-406940752744414227324 ((#1)^2)-3568995638311189591296 ((#1)^3)+17625687604298347751424 ((#1)^4)+«74»+2204002113903312612380694152058199080960 ((#1)^56)-849648021935235022130892649056914374656 ((#1)^57)+225339495169020019209516756855737548800 ((#1)^58)-36480156467750315078340909911689396224 ((#1)^59)+2702233812425949265062289623088103424 ((#1)^60)&,22], ])},0``49999.88848763331},{8,{348.577632`,(NumericalApproximation[Root, (RowDefault["-0.302", FEExpressionsNumericalApproximationElider]), Root[59852011725-8613020255400 #1+506374498323702 ((#1)^2)-14912468909877816 ((#1)^3)+187763883640385607 ((#1)^4)+1225298136149031000 ((#1)^5)-75748918049414748386 ((#1)^6)+«72»+11526417595121762243939558871860772864 ((#1)^54)-4619115187808957142660643200253820928 ((#1)^55)-4298447287002236758858944634152812544 ((#1)^56)-419889061875112715295688480606126080 ((#1)^57)+503711571981742495846982853284855808 ((#1)^58)+190000814936199557699692239123382272 ((#1)^59)+21111201659577728633299137680375808 ((#1)^60)&,7], ])},0``50000.52016209422},{9,{348.347674`,(NumericalApproximation[Root, (RowDefault["0.517", FEExpressionsNumericalApproximationElider]), Root[16824624395623422309+3346174080091245533418 #1+39657244849319483334963 ((#1)^2)-133035459497003229214536 ((#1)^3)-986480325126692008748037 ((#1)^4)+«80»+33794530412986383465108383623865696256 ((#1)^57)+10885046881780962042304730805137571840 ((#1)^58)-12168882058495674037154216870865272832 ((#1)^59)+2704196012999038674923159304636727296 ((#1)^60)&,18], ])},0``50000.2868018799},{10,{358.155208`,(NumericalApproximation[Root, (RowDefault["0.445", FEExpressionsNumericalApproximationElider]), Root[251523225+35884961280 #1+818165765458 ((#1)^2)-49378060391364 ((#1)^3)-1139636498291513 ((#1)^4)+14454429904671116 ((#1)^5)+«76»+248976947434597343764463966585094144 ((#1)^56)+45578444627740538263807132642050048 ((#1)^57)-39018705099141238083719427080060928 ((#1)^58)-2640816418944373705979647758434304 ((#1)^59)+2640816418944373705979647758434304 ((#1)^60)&,22], ])},0``50000.35187656837},{11,{340.536934`,(NumericalApproximation[Root, (RowDefault["0.320", FEExpressionsNumericalApproximationElider]), Root[20778267600830167929-3235141311707958974478 #1+168828524642889046317015 ((#1)^2)-3355887723432797298526812 ((#1)^3)+21549585296362850894103687 ((#1)^4)+«75»+11564611769159807317281541421059276800 ((#1)^55)+3422054900546325830795168240080257024 ((#1)^56)-5152390478219508212797279470077607936 ((#1)^57)+2337361316635132286837131909112266752 ((#1)^58)-528454784425907070576104236476530688 ((#1)^59)+50329027088181625769152784426336256 ((#1)^60)&,18], ])},0``50000.49418494901},{12,{333.395305`,(NumericalApproximation[Root, (RowDefault["-0.536", FEExpressionsNumericalApproximationElider]), Root[3288816997-171372645378 #1-84465858649674 ((#1)^2)-2022862034183584 ((#1)^3)+109514264051722083 ((#1)^4)+«73»+36448777741580060948550404454481920 ((#1)^56)+20599645843001078773193772323831808 ((#1)^57)+5483032190720277914735359404539904 ((#1)^58)+786391048252837902643012256661504 ((#1)^59)+49149440515802368915188266041344 ((#1)^60)&,10], ])},0``50000.27098600042}};

soln=Thread[{a,b,c,d,e,f,g,h,i,j,k,l}->data[[All,2,2]]]

vnew={{1/2,1/4 (-1-Sqrt[7])},{-(1/2),1/4 (-1-Sqrt[7])},{g,h},{k,l},{-k,l},{-g,h},{1/4 (-1+Sqrt[7]),-(1/2)},{0,1/4 (1-Sqrt[7])},{1/4 (1-Sqrt[7]),-(1/2)},{1/4 (1+Sqrt[7]),0},{1/4 (-1-Sqrt[7]),0},{e,f},{i,j},{1/4 (-1+Sqrt[7]),1/2},{1/2,1/4 (1+Sqrt[7])},{a,b},{0,1/4 (-1+Sqrt[7])},{-a,b},{1/4 (1-Sqrt[7]),1/2},{-i,j},{-e,f},{-(1/2),1/4 (1+Sqrt[7])},{c,d},{-c,d}}/.soln

N[%]

GraphData["ChilakamarriButterflyGraph","VertexCoordinates"]-vnew//Expand

g=Annotate[GraphData["ChilakamarriButterflyGraph"],VertexCoordinates->vnew]

UnitDistanceGraphEmbeddingQ[g,WorkingPrecision->(10^4)]//Timing

UnitDistanceGraphEmbeddingQ[g,WorkingPrecision->(10^5)]//Timing

UnitDistanceGraphEmbeddingQ[g,WorkingPrecision->(10^6)]//Timing

UnitDistanceGraphEmbeddingQ[g,WorkingPrecision->Infinity]

"ChilakamarriGraphCore"

Construction

The Mathematical Coloring Book: Mathematics of Coloring and the Colorful ...
By Alexander Soifer, p. 116

Length[v0={{395.31408468559846`,480.94298829445563`},{560.0476990365113`,99.249936612576`},{616.0330565415824`,264.7924009043272`},{782.7985019438812`,327.9344626859364`},{937.5347310260313`,267.96956347194043`},{995.8236931626102`,105.8695645283974`},{1150.4887434499665`,498.17472743407706`},{776.6124175963491`,651.9338657876945`},{613.9106342968224`,709.077496408046`},{939.6442116717378`,714.2023696331981`},{990.6535243407711`,879.2595239604464`},{555.0975373985802`,875.9982409989859`}}]

d=EuclideanDistance@@v0[[{11,12}]]

v=v0/d;

EuclideanDistance@@v[[#]]&/@{{1,12},{7,11},{7,8}}

e=Select[Subsets[v,{2}],.92<EuclideanDistance@@#<1.06&]/.Thread[v->Range[12]]

g=System`Graph[Range[12],UndirectedEdge@@@e,VertexCoordinates->v,VertexLabels->"Name"]

VertexCount[g]

EdgeCount[g]

GraphEmbedding[g]

List@@@EdgeList[g]

Construction: exact

GraphData[gn,"Graph","Labeled"]

v=GraphEmbedding[g]

v2=(#-Mean[v])&/@v

Manipulate[Graphics[{
Line[{{-1/2,y2},{1/2,y2},{x,0},{1/2,-y2},{-1/2,-y2},{-x,0},{-1/2,y2}}/.{y1->(Sqrt[1-(x^2)]),y2->(1/2) (Sqrt[3+4 x-4 (x^2)])}],
Line[{{-x,0},{0,y1},{x,0},{0,-y1},{-x,0}}/.{y1->(Sqrt[1-(x^2)]),y2->(1/2) (Sqrt[3+4 x-4 (x^2)])}]}],
{{x,.4},.1,1}]

p4={0,-y4};
p7={x7,0};
p9={-x9,1/2};
p11={1/2,y11};
p10={x9,1/2};
p12={-1/2,y11};

eqns=SquaredEuclideanDistance@@@{{p4,p7},{p7,p11},{p4,p9},{p9,p11}}/.Abs[x_]^2:>x^2

Length[eqns]

vars=Variables[eqns]

Length[%]

solns=Solve[Thread[eqns==1],vars,Reals]

vexact={-p7,{1,-1}p12,-p10,p4,-p9,-p12,p7,-p4,p9,p10,p11,p12}/.solns[[2]]

N[%%]

v2

g=Graph[Range[12],EdgeList[g],VertexCoordinates->vexact]

RecognizeGraph[g]

UnitDistanceGraphQ[g,WorkingPrecision->∞]

"ChilakamarriMothGraph"

Figure

The Mathematical Coloring Book: Mathematics of Coloring and the Colorful ...
By Alexander Soifer

4-chromatic, unit-distance

Length[v0={{828.8515607392383`,212.97377521410874`},{485.7579727293216`,358.2941458192472`},{1053.575561330854`,389.06219010592736`},{1011.9938602236872`,423.7164821388325`},{966.255713671963`,442.5555854885056`},{901.0633328403201`,431.75917532961444`},{825.8621393959883`,344.1001433260085`},{854.4800998704079`,479.84286785835013`},{801.7283109364436`,496.1639586150551`},{758.2839703769439`,491.08769121872876`},{686.0721982758621`,581.161255845729`},{656.6206491576515`,582.2707910750506`},{698.4093102039667`,403.7678435598376`},{621.2592439993239`,409.8501662159115`},{573.0663226138157`,497.5666870915031`},{523.3154527974983`,505.14372041920205`},{473.6565651763579`,493.6631926836825`},{422.5892001915708`,454.1395931935991`},{359.30544990984896`,471.89790574994356`},{307.094056372549`,453.2772601138155`},{269.49058520678386`,426.0045392438583`},{194.50210058879873`,284.8578607448726`},{364.2667395622042`,174.96788194444434`},{382.59419195120574`,160.0955107617758`},{475.0305492168131`,227.25401101532566`},{590.031288736759`,202.57978715911645`},{597.2806354941403`,227.11028883536164`},{708.6423294173992`,225.47760487097116`},{718.96158193881`,198.6762927512957`},{917.3959213714221`,134.55320493858449`},{935.8038581812035`,146.86732131789495`},{1111.3576265635563`,235.4519241604687`},{1084.4873277974982`,519.4871939796033`},{817.4457685373`,611.6016135620914`},{529.6794709263016`,624.2434165117195`},{253.76737871872882`,557.3436161821049`},{261.3616587080234`,707.3838231772593`},{135.73122675794457`,450.2878387705656`},{109.27484787018254`,168.3221683429117`},{363.13420878408834`,52.13140917286455`},{646.2381588770565`,119.79006261268864`},{914.785926583277`,26.422385620914838`},{1188.9676037440838`,119.916538131057`},{1193.0205692190668`,403.5723813950866`},{1092.392047695515`,668.6995612181653`},{902.2418547160244`,730.9600095785439`},{459.7385092686499`,755.4387712700021`}}]

From relative rotation of 2 exact Chilakamarri butterflies sharing a vertex

GraphicsRow[Show[GraphData[#]//StyleGraphs,PlotLabel->GraphData[#,"Name"],LabelStyle->Directive[14,Black,Italic,FontFamily->"Times"]]&/@{"ChilakamarriButterflyGraph","ChilakamarriMothGraph"},Dividers->All,ImageSize->700]

Show[TranslateGraph[GraphData["ChilakamarriButterflyGraph","Graph","Labeled"],#],Axes->True]&/@{1,2}

TwoButterflies[q_,opts___?OptionQ]:=With[{g0=GraphData["ChilakamarriButterflyGraph","Graph"]},
Module[
{
v1=GraphEmbedding[TranslateGraph[g0,1]],
v2=GraphEmbedding[TranslateGraph[g0,2]],
e=EdgeList[g0],
n=VertexCount[g0]
},
Graph[Range[2n],Join[e,e/.i_Integer:>i+n],VertexCoordinates->Join[RotationMatrix[q].#&/@v1,RotationMatrix[-q].#&/@v2],opts]
]]

twobutterflies=TwoButterflies[.28,VertexLabels->Automatic]

EuclideanDistance@@GraphEmbedding[twobutterflies][[{15,46}]]

EdgeAdd[ContractCoincidentVertices[twobutterflies],15\[UndirectedEdge]46]

RecognizeGraph@%

g1=TwoButterflies[q]

d=EuclideanDistance@@GraphEmbedding[g1][[{15,46}]]

Solve[d==1,q]//FullSimplify

N[%]

g=IndexGraph@EdgeAdd[ContractCoincidentVertices[TwoButterflies[-ArcSin[(1/6) (1-(Sqrt[7]))]]],15\[UndirectedEdge]46]

g=;

BilateralGraphEmbeddingTypes[g]

RecognizeGraph@g

UnitDistanceGraphEmbeddingQ[g]

Attempt to exactify

v=GraphEmbedding[g]

v=;

From adams, 2024-04-26, this is a sum of Root objects of degree 60 and 120, so the degree bound is 7200.  The polynomial might factor and the result may be a root of a low degree factor, but RootReduce needs to check all factors...

Block[{$MaxRootDegree=1740},RootReduce[v[[3,1]]]]//Timing

<<MathWorld`Graphs`

ToAlgebraicRoot[v[[3,1]],"RootReduce"->False,WorkingPrecision->1000,"MaxDegree"->120,Debug->True]//Timing

ToAlgebraicRoot[v[[3,1]],"RootReduce"->False,WorkingPrecision->5000,"MaxDegree"->128,Debug->True]//Timing

ToAlgebraicRoot[v[[3,1]],"RootReduce"->False,WorkingPrecision->5000,"MaxDegree"->256,Debug->True]//Timing

ToAlgebraicRoot[v[[3,1]],"RootReduce"->False,WorkingPrecision->10000,"MaxDegree"->512,Debug->True]//Timing

Print[Map[RootReduce,#,{2}]//Timing]&/@GraphEmbedding[g]