Chromatically Equivalent Graphs

Author

Eric W. Weisstein
February 2, 2023

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

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

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

Examples

Bari, R.A.  "Chromatically Equivalent Graphs."  In Graphs and Combinatorics (Ed. R.A. Bari and F. Harary).  Berlin: Springer-Verlag, pp. 186–200, 1974.

Each of these graphs is a planar triangulation, drawn with an outer circle whose points are all to be connected to a single point, the point at infinity. The degree of the point at infinity is given by the circled number.

The label (n; p, q, r, •.• , t) tells us that the graph has n points, of which p are of degree 4, q of degree 5, r of degree 6, etc. Below each set of chromically equivalent graphs is their common Q-chromial.

Code

<<MathWorld`Graphs`

Circumcircle[pts_]:=Module[{x,y,r},
Circle[{#1,#2},Abs@#3]&@@NArgMin[Total[Abs[(x-#)^2+(y-#2)^2-r^2&@@@pts]],{x,y,r}]
]

tallies[g_]:=Module[{x,t=Tally[Sort[VertexDegree[g]]],p},
p=Cancel[(x^(-4))PolynomialFromSignature[t,x]];
If[PolynomialQ[p,x],CoefficientList[p,x],$Failed]
]

11

Select[GraphData["Cyclic",11],GraphData[#,"ChromaticallyUnique"]===False&]

11-1.1

v={{153.7734375`,22.4765625`},{209.69921875`,61.29296875`},{167.7734375`,61.09765625`},{133.91015625`,60.65625`},{215.47265625`,91.0078125`},{151.06640625`,89.1328125`},{88.45703125`,87.15234375`},{153.109375`,125.14453125`},{184.7578125`,142.91015625`},{120.125`,144.03515625`},{1,1}200}/200;
g=Graph[Range[11],Sort[Sort/@(UndirectedEdge@@@{{1,7},{7,10},{10,9},{5,9},{2,5},{1,2},{3,4},{3,2},{4,6},{3,6},{6,8},{7,8},{5,8},{8,10},{8,9},{4,7},{6,7},{5,6},{1,4},{1,3},{2,6},Sequence@@({#,11}&/@{1,7,10,9,5,2})})],VertexCoordinates->v,VertexLabels->"Name"]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

Select[GraphData[11],Expand[ChromaticPolynomial[g,x]-GraphData[#,"ChromaticPolynomial"][x]]==0&]

QChromaticPolynomial[g,u]//TraditionalForm

11-1.2

v={{179.71875`,27.33984375`},{148.0234375`,19.6015625`},{147.921875`,57.79296875`},{100.765625`,39.55078125`},{212.35546875`,87.01953125`},{148.0625`,84.7578125`},{148.03515625`,112.09765625`},{177.35546875`,140.328125`},{148.73828125`,149.6796875`},{102.96875`,131.171875`},{1,1}200}/200;
g=Graph[Range[11],Sort[Sort/@(UndirectedEdge@@@Join[Partition[rim={4,2,1,5,8,9,10},2,1,1],{#,11}&/@rim,{{2,3},{3,6},{6,7},{7,9},{7,8},{6,10},{4,6},{5,6},{1,3},{10,7},{5,7},{3,4},{3,5}}])],VertexCoordinates->v,VertexLabels->"Name"]

Graph[EdgeList[g]]

HamiltonianGraphQ[g]

Select[GraphData[11],Expand[ChromaticPolynomial[g,x]-GraphData[#,"ChromaticPolynomial"][x]]==0&]

QChromaticPolynomial[g,u]//TraditionalForm

11-2.1

Missing the point at the intersection of the horizontal and vertical lines at the bottom

v={{111.23828125`,80.81640625`},{114.7109375`,29.171875`},{201.2734375`,79.6015625`},{24.09765625`,81.640625`},{110.23046875`,131.02734375`},{202.0703125`,179.9609375`},{110.08984375`,182.41796875`},{26.66015625`,182.32421875`},{154.40625`,223.44140625`},{71.05078125`,224.2109375`},{-1,1}200}/200;
g=With[{rim={10,9,6,3,2,4,8}},Graph[Range[11],Sort[Sort/@(UndirectedEdge@@@{{5,6},{4,1},{1,3},{5,8},{10,7},{7,9},{8,7},{7,6},{4,5},{3,5},{1,5},{2,1},{5,7},Sequence@@Sort/@Partition[rim,2,1,1],Sequence@@({#,11}&/@rim)})],VertexCoordinates->v,VertexLabels->"Name"]]

GraphPlot[SetProperty[g,VertexLabels->None]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

Select[GraphData[11],Expand[ChromaticPolynomial[g,x]-GraphData[#,"ChromaticPolynomial"][x]]==0&]

QChromaticPolynomial[g,u]//TraditionalForm

11-2.2

v=Append[{{121.11328125`,67.9765625`},{145.15625`,113.37890625`},{117.29296875`,159.8984375`},{61.01953125`,177.765625`},{39.43359375`,115.55078125`},{94.6484375`,26.6640625`},{194.90234375`,31.1640625`},{244.0078125`,115.8515625`},{196.05859375`,206.18359375`},{131.16796875`,218.1875`}},{2,1}200]/200;
g=With[{rim=Range[4,10]},UndirectedEdge@@@Graph[Range[11],Sort[Sort/@Join[{{1,7},{1,5},{3,5},{3,9},{3,4},{3,10},{2,3},{2,9},{2,7},{2,1},{1,6},{2,5},{2,8}},Partition[rim,2,1,1],{#,11}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

Select[GraphData[11],Expand[ChromaticPolynomial[g,x]-GraphData[#,"ChromaticPolynomial"][x]]==0&]

QChromaticPolynomial[g,u]//TraditionalForm

11-3.1

v=Append[{{54.8515625`,99.4375`},{38.1015625`,60.27734375`},{90.29296875`,10.60546875`},{140.55859375`,60.40234375`},{124.21875`,98.84765625`},{89.7734375`,111.63671875`},{90.2734375`,98.84765625`},{90.01171875`,84.1015625`},{90.12890625`,59.5703125`},{90.11328125`,39.45703125`}},{1,1}200]/200;
g=With[{rim=Range[6]},UndirectedEdge@@@Graph[Range[11],Sort[Sort/@Join[{{3,10},{10,9},{9,8},{6,7},{7,8},{2,9},{4,9},{2,10},{4,10},{2,8},{4,8},{1,7},{7,5},{1,8},{8,5}},Partition[rim,2,1,1],{#,11}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

Select[GraphData[11],Expand[ChromaticPolynomial[g,x]-GraphData[#,"ChromaticPolynomial"][x]]==0&]

QChromaticPolynomial[g,u]//TraditionalForm

11-3.2

v=Append[{{41.53515625`,98.36328125`},{21.3515625`,58.2109375`},{39.6796875`,19.296875`},{97.7421875`,21.49609375`},{119.890625`,62.7421875`},{101.3671875`,101.484375`},{70.21875`,109.1171875`},{70.75390625`,84.99609375`},{71.421875`,59.6328125`},{71.58984375`,34.6328125`}},{1,1}200]/200;
g=With[{rim=Range[7]},UndirectedEdge@@@Graph[Range[11],Sort[Sort/@Join[{{3,10},{5,10},{4,10},{2,10},{10,9},{9,8},{7,8},{1,8},{6,8},{2,9},{5,9},{2,8},{5,8}},Partition[rim,2,1,1],{#,11}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

Select[GraphData[11],Expand[ChromaticPolynomial[g,x]-GraphData[#,"ChromaticPolynomial"][x]]==0&]

QChromaticPolynomial[g,u]//TraditionalForm

12

Select[GraphData["Cyclic",12],GraphData[#,"ChromaticallyUnique"]===False&]

12-1.1

v=Append[{{53.9609375`,100.67578125`},{25.4765625`,71.40625`},{22.6953125`,39.73828125`},{36.40625`,15.44140625`},{108.328125`,19.2734375`},{120.65625`,42.80078125`},{118.90625`,72.0546875`},{92.7421875`,99.21484375`},{101.4140625`,51.13671875`},{72.72265625`,70.04296875`},{40.15625`,51.01953125`}},{1,1}200]/200;
g=With[{rim=Range[8]},UndirectedEdge@@@Graph[Range[12],Sort[Sort/@Join[{{4,10},{5,10},{6,9},{3,11},{10,11},{9,10},{2,10},{7,10},{1,10},{8,10},{2,11},{4,11},{5,9},{7,9}},Partition[rim,2,1,1],{#,12}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

RegularGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

Select[GraphData[12],Expand[ChromaticPolynomial[g,x]-GraphData[#,"ChromaticPolynomial"][x]]==0&]

QChromaticPolynomial[g,u]//TraditionalForm

12-1.2

v=Append[{{37.47265625`,96.91796875`},{21.27734375`,58.9375`},{37.43359375`,21.3515625`},{73.02734375`,7.9609375`},{111.05859375`,24.0625`},{122.5859375`,60.4921875`},{109.78125`,92.59765625`},{73.875`,105.953125`},{98.421875`,60.88671875`},{73.5859375`,59.30078125`},{47.875`,58.140625`}},{1,1}200]/200;
g=With[{rim=Range[8]},UndirectedEdge@@@Graph[Range[12],Sort[Sort/@Join[{{3,10},{7,10},{5,10},{1,10},{2,11},{10,11},{9,10},{6,9},{1,11},{3,11},{7,9},{5,9},{8,10},{4,10}},Partition[rim,2,1,1],{#,12}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

Select[GraphData[12],Expand[ChromaticPolynomial[g,x]-GraphData[#,"ChromaticPolynomial"][x]]==0&]

QChromaticPolynomial[g,u]//TraditionalForm

13

13-1.1

v=Append[{{25.48046875`,85.83203125`},{28.25`,30.77734375`},{74.12109375`,7.3984375`},{117.01171875`,30.8046875`},{115.578125`,85.375`},{72.56640625`,108.02734375`},{85.98046875`,84.98046875`},{55.89453125`,83.26171875`},{72.78125`,57.55859375`},{89.81640625`,19.80078125`},{71.60546875`,32.53515625`},{51.72265625`,25}},{1,1}200]/200;
g=With[{rim=Range[6]},Graph[Range[13],UndirectedEdge@@@Sort[Sort/@Join[{{2,11},{4,11},{2,12},{3,12},{12,10},{3,10},{4,10},{11,9},{1,8},{8,7},{7,5},{9,8},{7,9},{6,8},{6,7},{10,11},{2,9},{5,9},{11,5},{1,9},{11,12}},Partition[rim,2,1,1],{#,13}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[13],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

13-1.2

v=Append[{{40.5234375`,100.0234375`},{18.39453125`,74.5390625`},{19.86328125`,39.0625`},{37.5390625`,12.51953125`},{92.7890625`,12.34765625`},{112.23828125`,40.765625`},{112.74609375`,74.0078125`},{90.91015625`,99.79296875`},{66.8828125`,88.3203125`},{67.26171875`,72.33203125`},{66.49609375`,54.0390625`},{67.359375`,22.19140625`}},{1,1}200]/200;
g=With[{rim=Range[8]},Graph[Range[13],UndirectedEdge@@@Sort[Sort/@Join[{{2,9},{8,9},{7,9},{1,9},{4,12},{5,12},{3,12},{12,11},{11,10},{9,10},{2,10},{10,7},{3,11},{6,10},{6,11},{6,12},{2,11}},Partition[rim,2,1,1],{#,13}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

QChromaticPolynomial[g,u]//TraditionalForm

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

13-1.3

v=Append[{{67.6796875`,109.12109375`},{24.41015625`,88.48046875`},{16.2578125`,53.734375`},{26.09765625`,27.92578125`},{67.53125`,9.55078125`},{111.25`,27.98828125`},{119.48046875`,56.59375`},{104.16015625`,91.70703125`},{106.78125`,59.5078125`},{91.7421875`,60.64453125`},{46.16796875`,60.16015625`},{27.30078125`,58.2421875`}},{1,1}200]/200;
n=Length[v];
rim=Range[8];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[3,12,11,10,9,7],e[4,12,2,11,1,10,8,9,6],e[12,5,11],e[9,5,10]
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

13-2.1

v=Append[{{29.51953125`,91.61328125`},{12.703125`,55.06640625`},{26.59375`,22.49609375`},{65.15625`,10.0078125`},{115.8359375`,54.89453125`},{64.93359375`,106.48046875`},{90.74609375`,34.55859375`},{39.25`,32.24609375`},{63.7421875`,57.24609375`},{88.14453125`,79.90625`},{63.6484375`,82.1796875`},{39.18359375`,79.296875`}},{.45,.7}200]/200;
g=With[{rim=Range[6]},UndirectedEdge@@@Graph[Range[13],Sort[Sort/@Join[{{1,12},{2,12},{6,12},{6,10},{5,10},{5,7},{4,7},{3,8},{4,8},{2,8},{9,8},{7,9},{12,9},{9,10},{9,11},{6,11},{12,11},{10,11},{7,8},{8,12},{7,10}},Partition[rim,2,1,1],{#,13}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

QChromaticPolynomial[g,u]//TraditionalForm

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

13-2.2

v=Append[{{20.1640625`,77.3671875`},{36.69140625`,11.91796875`},{89.484375`,11.51171875`},{113.59765625`,54.11328125`},{85.4921875`,99.76171875`},{63.54296875`,104.12890625`},{87.7109375`,71.05078125`},{63.08984375`,85.84765625`},{40.06640625`,67.9765625`},{87.41796875`,39.1171875`},{64.71875`,25.27734375`},{36.7265625`,39.87109375`}},{.75,1}200]/200;
g=With[{rim=Range[6]},UndirectedEdge@@@Graph[Range[13],Sort[Sort/@Join[{{5,7},{7,10},{10,3},{3,11},{2,11},{11,12},{1,12},{1,9},{1,8},{7,8},{4,7},{4,10} ,{11,9},{11,7},{7,9},{8,9},{9,12},{10,11},{6,8},{5,8},{2,12}},Partition[rim,2,1,1],{#,13}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

QChromaticPolynomial[g,u]//TraditionalForm

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

14

14-1.1

v=Append[{{22.18359375`,85.85546875`},{24.4140625`,24.62890625`},{106.08984375`,33.`},{115.73046875`,60.62890625`},{104.4453125`,84.734375`},{62.1796875`,107.02734375`},{103.26171875`,57.78515625`},{84.98046875`,46.29296875`},{65.65234375`,34.67578125`},{42.7578125`,43.40625`},{86.45703125`,70.6640625`},{64.30859375`,83.39453125`},{38.53125`,72.40625`}},{1,1}200]/200;
g=With[{rim=Range[6]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{{2,13},{6,13},{1,13},{13,12},{12,11},{11,7},{7,8},{8,11},{2,9},{3,9},{10,12},{12,8},{10,8},{9,10},{8,9},{10,13},{3,8},{6,12},{6,11},{5,11},{4,7},{5,7},{3,7},{2,10}},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

14-1.2

v=Append[{{24.4140625`,35.19140625`},{72.0859375`,7.80078125`},{95.83984375`,18.87890625`},{119.25390625`,58.52734375`},{70.9453125`,107.31640625`},{26.73046875`,82.87890625`},{71.765625`,30.7578125`},{92.23828125`,44.85546875`},{48.40625`,45.453125`},{71.20703125`,58.53125`},{94.63671875`,74.609375`},{70.828125`,82.58984375`},{48.05859375`,69.9296875`}},{1,1}200]/200;
g=With[{rim=Range[6]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{{6,13},{1,13},{13,5},{5,12},{12,10},{1,7},{2,7},{3,7},{13,12},{10,13},{10,11},{12,11},{11,8},{8,7},{8,9},{1,9},{7,9},{9,13},{9,10},{8,10},{4,8},{11,4},{3,8},{5,11}},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

14-2.1

v=Append[{{41.6953125`,164.5546875`},{30.6953125`,106.85546875`},{79.80078125`,22.9296875`},{176.02734375`,24.92578125`},{232.94921875`,118.6953125`},{217.41796875`,168.81640625`},{125.5625`,214.76953125`},{129.140625`,55.64453125`},{171.38671875`,86.7421875`},{174.3515625`,142.58984375`},{128.6484375`,164.66015625`},{81.2421875`,140.28125`},{84.14453125`,82.77734375`}},{1,1}200]/200;
g=With[{rim=Range[7]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{{13,11},{11,9},{13,9},{3,8},{4,8},{1,12},{2,13},{2,12},{7,11},{12,13},{3,13},{8,13},{8,9},{9,10},{7,12},{11,12},{11,10},{7,10},{4,9},{6,10},{5,9},{5,10}},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

14-2.2

v=Append[{{78.80078125`,171.0625`},{58.5234375`,113.40625`},{120.06640625`,25.64453125`},{203.3203125`,26.12890625`},{254.2421875`,61.66015625`},{268.40234375`,117.72265625`},{162.21875`,218.703125`},{209.1015625`,85.0703125`},{203.65234375`,148.91796875`},{166.2890625`,164.75390625`},{114.81640625`,140.34765625`},{115.984375`,84.859375`},{166.22265625`,59.265625`}},{1,1}220]/200;
g=With[{rim=Range[7]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{{3,13},{4,13},{2,12},{11,12},{1,11},{11,10},{10,9},{6,9},{2,11},{3,12},{12,13},{13,8},{8,9},{10,13},{10,12},{8,10},{5,8},{6,8},{7,10},{7,11},{4,8},{7,9}},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

14-3.1

v=Append[{{30.140625`,89.8125`},{23.41796875`,53.04296875`},{29.95703125`,23.0625`},{65.53125`,4.6484375`},{105.359375`,19.046875`},{123.6640625`,43.69921875`},{124.4375`,69.68359375`},{106.4453125`,97.82421875`},{63.65234375`,101.58203125`},{106.73046875`,54.8125`},{88.984375`,55.1015625`},{65.4296875`,55.62109375`},{43.9765625`,56.68359375`}},{1,1}200]/200;
g=With[{rim=Range[9]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{e[2,13,12,11,10,7],e[3,13,9,12,4,13,1],e[12,5,10,6],e[10,8,11,5],{9,11}},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

14-3.2

v=Append[{{33.2109375`,95.2109375`},{20,60},{26.78515625`,33.28125`},{51.3359375`,9.3359375`},{90.54296875`,8.39453125`},{116.08203125`,34.98046875`},{123.5546875`,58.47265625`},{112.59375`,89.4296875`},{73.6640625`,104.3359375`},{106.58984375`,56.765625`},{78.66015625`,55.91796875`},{60.98046875`,53.92578125`},{37.58203125`,59.28515625`}},{1,1}200]/200;
g=With[{rim=Range[9]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{e[2,13,12,11,10,7],e[1,13,4,12,9,11,5],e[3,13,9,10,6,11],{5,12},{8,10}},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

14-4.1

v=Append[{{49.92578125`,99.7265625`},{29.71875`,80.0859375`},{31.66015625`,28.44921875`},{48.796875`,7.8359375`},{100.33984375`,10.2421875`},{119.34765625`,30.6015625`},{119.73046875`,81.0390625`},{96.66015625`,102.4296875`},{72.10546875`,20.07421875`},{75.94921875`,54.42578125`},{105.53125`,76.421875`},{70.96875`,91.2421875`},{44.71875`,75.17578125`}},{1,1}200]/200;
g=With[{rim=Range[8]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{e[2,13,10,11,7],e[1,13,3,6,10],e[3,10,12,1],e[8,12,11,6],{12,13},{11,8},e[4,9,6],e[5,9,3]},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

14-4.2

VertexDelete[g,14]

v=Append[{{29.2421875`,24.0390625`},{48.203125`,6.91015625`},{99.01171875`,4.234375`},{113.96875`,29.38671875`},{119.1796875`,83.15625`},{74.62890625`,102.85546875`},{48.84765625`,99.94921875`},{24.8359375`,77.75390625`},{72.07421875`,19.3359375`},{101.34765625`,58.67578125`},{87.1640625`,76.76953125`},{57.30859375`,80.8125`},{45.4375`,54.8203125`}},{1,1}200]/200;
g=With[{rim=Range[8]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{e[9,1,4,10,11,6,12,13,1,10,5,11,12,8,13,10],e[2,9,4],e[3,9],e[13,11],{7,12}},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

15

Tuples

-14(u^5) in 15-3 should be +

15-1.1

v=Append[{{103.45703125000021`,225.37890625`},{115.13671875000021`,100.07421875`},{187.79687500000017`,70.21875`},{223.93750000000017`,78.4453125`},{278.30078125000017`,120.46484375`},{271.94531250000017`,226.6796875`},{188.32812500000017`,270.09765625`},{236.51562500000017`,186.76171875`},{157.26171875000023`,191.30859375`},{120.07031250000021`,193.92578125`},{251.83203125000017`,158.515625`},{206.82031250000017`,159.5390625`},{180.25390625000017`,156.34375`},{140.42187500000023`,158.72265625`}},1.5{1,1}200]/200;
g=With[{rim=Range[7]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{e[1,10,14,13,12,11,6,8,12,9,10],e[7,10,2,14,9,7,12,4,13,3,14],e[9,13],e[12,5,11,8,7]},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

15-1.2

VertexDelete[g,15]

v=Append[{{410.29296875`,166.23828125`},{422.61328125`,116.859375`},{513.640625`,63.765625`},{605.765625`,124.84765625`},{614.62109375`,167.09375`},{607.15234375`,217.34375`},{566.87890625`,257.95703125`},{514.1640625`,271.875`},{588.8203125`,193.01953125`},{575.83203125`,167.96484375`},{519.046875`,166.80859375`},{455.89453125`,166.67578125`},{542.2265625`,122.37109375`},{478.35546875`,119.08203125`}},2{1,1}200]/200;
g=With[{rim=Range[8]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{e[2,14,13,4,10,11,12,1],e[10,5,9,6],e[2,12,8,9],e[12,14,11,13,10,9,7],{3,13},{3,14},{11,8},{8,10}},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

15-1.3

VertexDelete[g,15]

v=Append[{{882.65234375`,75.07421875`},{924.7421875`,117.640625`},{938.4140625`,177.39453125`},{889.6015625`,256.328125`},{830.9921875`,270.703125`},{738.515625`,213.703125`},{742.1953125`,121.71875`},{782.203125`,75.41015625`},{831.44140625`,88.01171875`},{833.79296875`,115.09765625`},{879.16015625`,178.578125`},{860.48828125`,215.765625`},{797.5234375`,214.14453125`},{782.28515625`,177.125`}},{2,1}450]/200;
g=With[{rim=Range[8]},UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{e[6,13,12,3,11,14,7,10,2,9,8],e[9,1],e[10,14,6],e[14,13,5,12,11,13],e[3,10,11],e[12,4],e[7,9,10]},Partition[rim,2,1,1],{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"]]

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

QChromaticPolynomial[g,u]//TraditionalForm

15-2.1 [missing 9<->12]

Something is wrong with the degrees; perhaps edges don't pass through all these points

v=Append[{{72.0859375`,126.515625`},{82.5390625`,74.48828125`},{135.421875`,27.63671875`},{173.3984375`,24.37109375`},{214.96875`,37.703125`},{266.28515625`,80.38671875`},{275.484375`,125.2734375`},{171.49609375`,226.46484375`},{222.5859375`,75.171875`},{184.5546875`,74.53515625`},{233.65234375`,121.91796875`},{197.21484375`,123.1640625`},{151.1484375`,119.46875`},{107.5078125`,122.88671875`}},{1.3,1}200]/200;
n=Length[v];
rim=Range[8];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{e[1,14,13,12,11,7],e[5,10,13,2,14,8,11,6,9,10,4,13,3],e[5,9,11],e[10,12,8,13],e[9,12]},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

15-2.2

v=Append[{{749.23046875`,176.640625`},{733.734375`,119.62109375`},{777.91015625`,38.625`},{857.015625`,21.734375`},{899.38671875`,41.109375`},{936.7421875`,121.79296875`},{896.765625`,197.3984375`},{857.56640625`,216.48828125`},{813.44921875`,80.734375`},{895.21484375`,122.703125`},{857.2734375`,121.39453125`},{825.9375`,121.81640625`},{774.06640625`,118.171875`},{773.73828125`,154.984375`}},{1,1}200]/200;
n=Length[v];
rim=Range[8];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[2,13,12,11,10,6],e[2,14,8,11,4,9,13,14,12,9,3,13],{1,14},e[7,11,9],{8,12},e[7,10,5,11]
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

15-3.1

v=Append[{{151.5859375`,273.04296875`},{119.94140625`,239.234375`},{103.828125`,190.91015625`},{149.33984375`,105.32421875`},{208.83984375`,89.328125`},{270.11328125`,109.546875`},{305.31640625`,153.04296875`},{307.4765625`,220.92578125`},{269.01953125`,270.2890625`},{209.05859375`,293.2734375`},{269.94921875`,185.59375`},{244.75390625`,189.48828125`},{178.34765625`,185.7890625`},{159.88671875`,242.7734375`}},{1,1}200]/200;
n=Length[v];
rim=Range[10];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[14,3,13,14,1],e[2,14,10,13,4],e[10,5,12,9,11,6,12,10],e[8,11,7],{11,12},{13,5}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

Tally[Sort[VertexDegree[g]]]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

15-3.2

v=Append[{{814.5625`,269.32421875`},{775.484375`,218.203125`},{776.234375`,153.4921875`},{809.90625`,103.375`},{870.10546875`,88.33984375`},{935.5546875`,111.44140625`},{968.16015625`,156.46875`},{972.98828125`,212.31640625`},{937.0703125`,262.5859375`},{872.3515625`,288.26953125`},{935.61328125`,187.0390625`},{909.7578125`,185.5`},{836.34375`,187.49609375`},{809.81640625`,186.95703125`}},{1,1}200]/200;
n=Length[v];
rim=Range[10];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,14,4,13,10,12,6,11,9,12,5,13,1],e[3,14,2],e[7,11,8],{14,13},{12,11},{10,5}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

Tally[Sort[VertexDegree[g]]]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

15-4.1

Wrong degree list

v=Append[{{175.55859375`,267.7265625`},{124.15234375`,232.3125`},{102.09765625`,169.15625`},{147.9375`,88.421875`},{258.1875`,78.703125`},{304.03125`,139.78515625`},{307.41015625`,169.68359375`},{292.421875`,227.`},{246.12109375`,262.05078125`},{207.09375`,107.4921875`},{209.12109375`,138.5703125`},{206.484375`,166.03515625`},{210.52734375`,203.015625`},{213.03125`,228.54296875`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,14,13,12,11,10,4],e[9,14,2,13,8,12,3,10,5],{8,14},e[12,7,11,6,10],e[13,3,11]
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

EdgeCount[g]

Tally[Sort[VertexDegree[VertexDelete[g,n]]]]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

15-4.2 [drawing is a copy of 15-5.2]

but should be:

v=Append[{{834.5859375`,263.97265625`},{786.14453125`,228.65234375`},{771.42578125`,168.56640625`},{789.57421875`,106.0625`},{867.3046875`,66.421875`},{950.3828125`,110.`},{972.17578125`,170.1015625`},{952.984375`,227.7109375`},{903.56640625`,264.23828125`},{868.46875`,104.0390625`},{866.6953125`,133.546875`},{867.97265625`,168.2265625`},{866.23828125`,200.60546875`},{868.84765625`,234.44921875`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,14,13,12,11,10,5],e[2,14,8,13,3,12,7,11,4,10,6,11,3], {2,13},{8,12},{9,14}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

EdgeCount[g]

tallies[g]

g1=EdgeDelete[g,UndirectedEdge@@@({{9,14},{14,8},{13,8},{12,7},{11,7},{11,6},{10,6},{12,8}})]

g1=;

Length[poss=Subsets[Flatten[Outer[List,Range[10,14],Range[6,9]],1],{8}]]

(s=Select[poss,tallies[EdgeAdd[g1,UndirectedEdge@@@#]]==={4,7,3,0,0,1}&])//Timing

Length[s]

g2=VertexDelete[g1,15]

Length[s2=Select[s,PlanarGraphQ[EdgeAdd[g2,UndirectedEdge@@@#]]&]]

EdgeAdd[g1,UndirectedEdge@@@#]&/@s2

(s3=Select[s2,QChromaticPolynomial[EdgeAdd[g1,UndirectedEdge@@@#],u]===u^11 + 11*u^9 - 8*u^8 + 41*u^7 - 37*u^6 + 49*u^5 - 9*u^4 - 11*u^3 + 
  u^2&])//Timing

Length[s3]

EdgeAdd[g2,UndirectedEdge@@@s3[[1]]]

g2=Graph[Range[15],Sort[Sort/@Join[EdgeList[g1],UndirectedEdge@@@s3[[1]]]]]

g=g2

QChromaticPolynomial[g2,u]//TraditionalForm

IsomorphicGraphQ[g1,g2]

QChromaticPolynomial[#,u]&/@{g1,g2}

Equal@@%

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

15-5.1

v=Append[{{178.2421875`,256.08203125`},{123.64453125000001`,169.58593749999994`},{145.71484375`,109.16015624999994`},{227.53515625`,70.25390624999989`},{307.20703125`,109.39062499999994`},{328.0390625`,148.74609374999994`},{327.015625`,194.14062499999994`},{307.6015625`,232.2734375`},{280.5234375`,258.578125`},{228.37890625`,110.92578124999994`},{227.2265625`,134.62890624999994`},{226.49609375`,159.44531249999994`},{227.7734375`,183.53906249999994`},{226.765625`,209.60937499999994`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,14,13,12,11,10,4],e[9,14,8,13,7,12,6,11,5,10,3,11,2,14],e[13,2,12]
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

15-5.2

v=Append[{{834.5859375`,263.97265625`},{786.14453125`,228.65234375`},{771.42578125`,168.56640625`},{789.57421875`,106.0625`},{867.3046875`,66.421875`},{950.3828125`,110.`},{972.17578125`,170.1015625`},{952.984375`,227.7109375`},{903.56640625`,264.23828125`},{868.46875`,104.0390625`},{866.6953125`,133.546875`},{867.97265625`,168.2265625`},{866.23828125`,200.60546875`},{868.84765625`,234.44921875`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,14,13,12,11,10,5],e[2,14,8,13,3,12,7,11,4,10,6,11,3], {2,13},{8,12},{9,14}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

15-6.1

v=Append[{{135.984375`,267.32421875`},{100.84375`,218.93359375`},{104.03515625`,151.421875`},{134.2421875`,104.65234375`},{201.89453125`,85.1953125`},{265.99609375`,109.484375`},{292.83203125`,153.75390625`},{294.55859375`,217.7734375`},{259.05859375`,270.1796875`},{200.3046875`,126.6015625`},{235.6015625`,196.8046875`},{195.70703125`,186.7421875`},{198.3671875`,223.5546875`},{159.890625`,198.69140625`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[4,10,7,12,14,2],e[6,10,3,12,11,8],e[3,7,11,13,14,3],e[14,1,13,9,11],{12,13},{5,10}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

15-6.2

v=Append[{{796.21484375`,263.8125`},{759.91796875`,145.97265625`},{795.76953125`,98.18359375`},{859.35546875`,78.63671875`},{921.47265625`,100.71484375`},{953.74609375`,149.11328125`},{955.78125`,210.98046875`},{916.0390625`,260.09765625`},{879.93359375`,280.0703125`},{860.71875`,118.2578125`},{861.5234375`,178.90625`},{911.8671875`,225.48828125`},{877.52734375`,238.078125`},{818.71484375`,191.`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[2,14,13,8,12,11,7,12,13,1,14,11,6,2,10,5],{9,13},{12,14},e[3,10,4],{6,10},{2,11}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16

Graphs

16-1.1

v=Append[{{96.85501596566533`,204.5254089179574`},{67.23490801196051`,177.14950209735787`},{67.62393203212218`,140.77385331299524`},{83.42011666473324`,119.76768867426705`},{117.11819152745836`,106.95602592886002`},{149.26469384465497`,119.44739710563192`},{163.3894322511063`,141.8204398471271`},{148.50021640968612`,196.78202191003794`},{126.24216186078498`,208.68919931021472`},{97.79138773512423`,190.15965539234162`},{122.57583664751714`,177.85324131858442`},{99.20273069198983`,164.78669866292546`},{116.43513772461637`,158.49815716042633`},{116.15015501217235`,127.97797958857723`},{116.15015501217235`,116.84671979129132`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[3,7,14,4,15,6,14,3,13,8,11,12,3],e[9,10,2,12,13,7],e[1,10,12],e[9,11,13],{10,11},e[5,15,14]
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-1.2

v=Append[{{406.2137418894828`,187.36705470493865`},{393.08984091811544`,154.76843436104917`},{399.59353910183745`,131.4683769880023`},{411.93845830971713`,114.17483058384494`},{445.1993805278385`,104.90594630650119`},{476.44774282328376`,116.77742370605478`},{497.2221127856187`,154.8871491350447`},{486.8714782684272`,183.83529017857146`},{445.6585457315365`,206.6034140450614`},{422.5380928627448`,181.2189991978237`},{447.0291881306349`,171.429596296038`},{445.2359309918145`,141.79199637276793`},{458.3781071951697`,130.8268606131418`},{434.2022596790723`,132.26741873604917`},{447.77618823814356`,114.72731087820878`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,10,11,7,12,3],e[15,6,13,12,2,11,8],e[2,10,9,11],e[2,7,13,14,4,15,13],e[3,14,12],{14,15},{5,15}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-2.1

v=Append[{{109.16601757744854`,683.3293883574145`},{92.86326945338337`,662.3526133682866`},{94.38371447263458`,625.4505183716369`},{110.7132939793924`,601.8496341551661`},{140.22781494132735`,592.1223635496508`},{174.83135482063838`,604.010454841349`},{190.9266069185469`,626.9584420789649`},{189.45088087045016`,658.8180258882392`},{173.18390792330854`,681.9502552870114`},{139.85217558363001`,693.0995891752381`},{174.3519674498627`,642.6512234364834`},{159.22622264658258`,641.9858051457053`},{140.7179348651801`,642.3328243618638`},{123.40811551071678`,642.2684290434014`},{112.35179708249134`,642.0090590107056`}},{1,1}200]/200;
n=Length[v];
rim=Range[10];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[3,15,14,13,12,11,7],e[4,15,1,14,5,13,10,12,6,11,9,12,5],{2,15},{8,11},{4,14},{1,13}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-2.2

v=Append[{{444.0421675547009`,682.0136202216673`},{426.2096292247153`,659.0916534942583`},{427.3894089702241`,625.1460034665429`},{443.91004711001455`,601.9597958497611`},{475.30260910801684`,592.3131425363264`},{492.0856272858463`,594.0102389525788`},{508.09639216022754`,601.5485477050333`},{523.7461518758885`,626.3741653467256`},{524.0048102112603`,659.3354250189611`},{490.99889010701804`,690.3632601555759`},{506.3174182852963`,642.4016778831093`},{492.1563396365235`,642.3998170317757`},{474.9062477739579`,642.7254660151575`},{460.27623458911535`,642.5691545031342`},{443.7388487873224`,642.8966643378496`}},{1,1}200]/200;
n=Length[v];
rim=Range[10];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[3,15,14,13,12,11,8],e[1,15,4,14,10,13,6],e[12,10,11,7],e[1,14,5],e[7,12,6],{5,13},{2,15},{9,11}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-3.1

v=Append[{{97.43390336981065`,405.3059335806288`},{89.7379710848305`,378.3117766482003`},{97.40357258045839`,353.95514261700714`},{141.76134098182717`,330.65634944267447`},{163.12634900155925`,333.3201666673117`},{187.0108345901524`,355.12827396878356`},{186.5194758026458`,401.6712490303834`},{161.18113437776762`,427.7713989671478`},{140.5541755656072`,430.57882365036454`},{176.36877163275602`,377.9699504439758`},{160.5765406433459`,377.83847882696637`},{143.38504923848484`,378.75473486550896`},{126.11671983393137`,404.729481106049`},{126.11671983393137`,356.1112771359618`},{112.26363731044239`,379.3433231816589`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[3,15,13,9,12,4,11,8,10,6],e[1,15,14,4],{2,15},e[12,11,10,7],e[11,5,10],e[14,13,12,14],{12,8},{3,14},{1,13}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-3.2

v=Append[{{431.77172751514354`,405.5395070684632`},{423.6625413689021`,378.9557257089569`},{431.31623481251705`,355.3904685290323`},{477.9912564697397`,330.83634377190316`},{490.9385775402521`,331.21159423676124`},{504.9384879650205`,340.404050592876`},{519.3490498418978`,350.48389169607657`},{518.9737993770397`,404.78428600711356`},{476.952827510384`,432.07844717745184`},{503.45400656630517`,379.96347381269527`},{492.01004742104186`,378.62295642879974`},{480.83277571306763`,380.27736256631874`},{461.3929135807653`,355.90260281126007`},{462.26613793295076`,403.42016796505084`},{446.3734547231749`,381.745323504317`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[3,15,14,9,12,4,13,15,1,14,12,11,10,8],e[3,13,12],{2,15},{13,14},e[12,5,11,6,10,7],e[10,9,11]
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-4.1

v=Append[{{102.24142572317083`,146.4457694335049`},{91.96798504135528`,115.22611909868289`},{104.50154150530538`,79.52328827798743`},{143.62336350462147`,65.65589299179402`},{176.56383059159694`,76.08371316692478`},{194.20426069441388`,113.47854323435482`},{188.42840925118117`,139.49045866134406`},{167.97003879705076`,161.36706206073012`},{142.7403128028585`,166.44305980093392`},{167.78684179831671`,138.43656132031228`},{155.58674503992745`,126.38672726874981`},{141.16770036428767`,113.5382366384367`},{142.45419614191434`,132.36635964315857`},{116.51638287171642`,142.29604865319232`},{118.85060081064225`,114.76503901198149`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,14,13,11,6,10,9,14,2,15,12,11,10,8],{10,7},e[9,13,12,4,11,5],{11,9},e[14,15,3,12],{13,15}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-4.2

v=Append[{{448.494010082489`,157.90015991746387`},{426.08140143442444`,114.54611883408685`},{435.5527324316939`,84.94165681494803`},{478.3233760513934`,66.01590489182004`},{510.2665009466657`,75.28431503215819`},{526.2380633943019`,99.29154341427471`},{527.0666568934381`,130.59039458879008`},{510.18871461817537`,153.16872193668186`},{477.60638902356936`,165.86311254487717`},{509.6678844187183`,115.58270621157769`},{495.343362926508`,114.95534256223169`},{475.9458200110147`,132.524906758202`},{477.5488947807722`,114.43451236277463`},{459.3773320425722`,127.90338424159114`},{461.89016865423844`,111.84727143690026`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[2,15,13,11,10,6],e[12,1,14,15,4,13,12,9,11,5,10,8],{3,15},e[2,14,12,11,8],{7,10},{13,14},{4,11}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-5.1

v=Append[{{133.503464200715`,707.4960241502152`},{107.44957807897012`,691.1181443050843`},{95.31326283447905`,663.9036210289601`},{147.914708867592`,608.6927563935533`},{169.47112601611687`,613.6294942897849`},{188.69216389046525`,629.279960918369`},{196.19399049767765`,666.0354858021083`},{185.21226742238687`,692.0470570275997`},{163.2105363656713`,706.3777018920892`},{159.5996652187133`,628.3570931810327`},{137.13247030321017`,629.5419102761282`},{170.67004807663028`,652.1541848359288`},{147.51775484083376`,681.2144435867258`},{145.26902035422378`,691.3277037912917`},{117.82075765117591`,670.065475921481`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[13,2,14,8,13,15,11,4,10,12,7,13,14,9],{1,14},e[11,3,15,2],e[5,10,11,12,6,10],e[15,12,13]
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-5.2

v=Append[{{453.783371479143`,704.6700302673466`},{430.06401217938264`,679.6320155880201`},{430.03661629199553`,641.0184255121338`},{444.7993468086632`,618.8441942610065`},{480.49984085905334`,609.3085990577995`},{509.4098076224249`,618.7346107114581`},{522.8630147219887`,640.0851389484797`},{524.0574754120668`,679.10053537271`},{500.24862288017516`,706.227943063427`},{476.66441662485784`,694.9499694223998`},{474.88733672968056`,659.7499069149476`},{499.66417728258347`,640.8083903754994`},{491.1659730151017`,625.2256096297108`},{470.1003620069061`,626.409111964834`},{458.58678373434975`,639.9700762214537`}},{1,1}200]/200;
n=Length[v];
rim=Range[9];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,10,8,12,13,5,14,15,11,10,9],e[2,11,12,7,13,6],{2,10},e[3,15,12],e[4,14,12],{3,11},{11,8},{4,15},{14,13}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-6.1

v=Append[{{132.6293041588002`,443.64505134126875`},{108.61511921816086`,427.71106753763024`},{99.84702074372127`,378.67504904397265`},{124.34688194521566`,352.3102601362058`},{147.73884818867418`,346.03794999156923`},{194.00599347987725`,377.6120921029554`},{186.65517092679397`,427.83205450652645`},{164.54566655363584`,444.96035253169816`},{147.1581107379721`,427.36884725418076`},{147.82181068163163`,404.29317551512247`},{162.07580400288202`,395.8586553977826`},{146.03811708304664`,378.5143092138676`},{148.77760773591217`,365.5030249017089`},{147.75613204137366`,355.869005407026`},{132.41498438532682`,362.31933923446707`}},{1,1}200]/200;
n=Length[v];
rim=Range[8];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[2,9,7,10,3,12,11,7],e[1,9,10,12,13,14,5],e[4,15,12],e[3,15,14,6,11,10,2],{9,8},e[11,13,6],{4,14},{13,15}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-6.2

v=Append[{{456.41515260204636`,442.68338854887656`},{435.1263668332331`,424.5827391617822`},{443.9470806847572`,359.5662956908729`},{476.9663389402899`,344.94841606685435`},{512.8445569721631`,360.88097015803163`},{522.7828457184899`,374.06429000799443`},{520.0254836598587`,423.53831462373023`},{497.37528847374034`,443.58964019084385`},{475.66385619925626`,360.5192822829864`},{494.7174921784642`,389.75300957666934`},{476.923667898852`,383.7404566426311`},{463.5229289329912`,381.1111077083136`},{477.435720396107`,401.4672264285552`},{478.3074288140531`,423.0445497156629`},{478.3460359467826`,437.1930478838643`}},{1,1}200]/200;
n=Length[v];
rim=Range[8];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,15,7,14,2,13,10,6,14,15,8],e[14,13,11,9,4],e[3,9,5,11,10,14],e[15,2,12,9],e[3,12,13],{5,10},{12,11}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-7.1

v=Append[{{132.9042469742119`,181.3929263810149`},{99.30113022739641`,144.97816012139208`},{106.48401609214642`,108.25831036428585`},{149.0785536767937`,85.15982860282`},{192.20515688105206`,110.72338502395198`},{197.55021975696184`,143.92135088610945`},{160.34467707186198`,180.28974445411478`},{148.5733354049611`,170.80286801636987`},{172.61391500665582`,158.30176662348865`},{148.16818452030313`,157.45729550245449`},{123.29533713747364`,159.4464399060465`},{161.23796155249346`,144.43145049390176`},{136.13325071157658`,143.38196326255874`},{147.32615406724884`,125.87017050700956`},{147.91191438241702`,108.33641173964159`}},{1,1}200]/200;
n=Length[v];
rim=Range[7];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[14,2,13,12,6,9,8,1,11,13,14,15,4],e[9,7,8,10,12,14,5,15,3,14,6],e[8,11,10,9,12],{10,13},{2,11}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-7.2

v=Append[{{451.1209888098457`,176.18609291197242`},{435.1394231661531`,109.61948139396182`},{444.60428058017266`,96.84577138804923`},{461.3144671071092`,87.45545934492259`},{481.095441976958`,82.47053825263026`},{529.4104610731168`,133.1613904598286`},{512.2289554269862`,171.518590818321`},{480.64816975160034`,99.95743945048349`},{481.2036529992219`,118.87032145283715`},{467.3574515282045`,131.08854821112817`},{481.3695765666933`,135.55405639655356`},{502.61500727118084`,147.07973261235534`},{480.4509852221416`,147.5799080041531`},{445.92926443056007`,147.71937998840443`},{480.01333175431853`,161.4285141645542`}},{1,1}200]/200;
n=Length[v];
rim=Range[7];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,14,2,10,11,12,7,15,14,10,9,8,5],e[1,15,12,6,8,4,9,3],e[6,9,11,13,15],e[14,13,12],{6,11},{10,13},{2,9}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-8.1

v=Append[{{111.82655230435459`,452.0640251853249`},{82.93502495505595`,408.57813471013844`},{98.06898325139827`,372.79201438210225`},{135.39800851995295`,356.895034790039`},{171.7658798911355`,373.39273556795985`},{187.33615146983757`,408.2366721413352`},{160.45124366066676`,451.88697052001953`},{159.40577801791108`,423.0228444879705`},{135.61089567704636`,436.6349757801403`},{113.85424978082831`,424.3359999223189`},{136.86924847689545`,417.25381331010294`},{163.81106671420014`,408.9512141834606`},{109.48479357632725`,409.67207960648966`},{134.77831719138408`,387.0196214155717`},{134.3989143371582`,373.013332713734`}},{1,1}200]/200;
n=Length[v];
rim=Range[7];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,10,13,14,12,8,7,9,1],e[11,8,6,12,13,2,10],e[13,11,10,9],e[11,9,8],e[3,14,5,15,3],e[14,15,4],{5,12},{2,14},{11,12}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-8.2

v=Append[{{442.7116084773446`,451.07759747543804`},{416.27039300175545`,405.0762485987882`},{423.76376538616`,379.2915321197088`},{445.2646601304382`,359.66066482003424`},{467.41321213389944`,355.509469145134`},{509.2898905476293`,378.63503312319904`},{490.41278135505854`,449.377773474374`},{465.4039273263998`,367.31981977931497`},{466.0316906765977`,381.7672185711935`},{487.0087124842671`,392.8326528355974`},{441.86059125964675`,392.71992068468154`},{465.8880124450383`,406.17483446163453`},{488.0807731351332`,417.74645818799377`},{466.7655548747164`,434.8309051375698`},{442.2761529140031`,421.55503654148316`}},{1,1}200]/200;
n=Length[v];
rim=Range[7];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[3,9,6,10,12,15,1,14,13,6,8,4,9,11,15,14,7,13,12,14],e[15,2,11,12],e[3,11],e[11,10,9,8,5],{10,13}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-9.1

v=Append[{{97.88920171210106`,177.85928750545423`},{94.28368686107879`,114.27462541296131`},{137.47039843620138`,93.32040843557809`},{158.93093141596367`,100.74713329558682`},{182.04437044833568`,132.71315570587814`},{159.54395975965133`,189.52498983829582`},{134.47564145351978`,196.3727434848218`},{152.80064797908702`,160.01789222879614`},{135.86063141518449`,170.57333211695897`},{114.0845023621904`,161.30071079984629`},{158.94001331735166`,137.22686069569693`},{137.44542320738447`,144.0678029161819`},{108.48323968116273`,142.20147218095502`},{148.76601328748336`,119.75101194990447`},{119.58132317725648`,121.34942659418635`}},{1,1}200]/200;
n=Length[v];
rim=Range[7];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[7,9,6,8,5,14,3,15,2,13,1,9,8,11,14,15,13,10,9],{4,14},e[10,8,12,11,5],e[11,15,12,13],e[1,10,12]
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

16-9.2

v=Append[{{438.9239878227206`,186.51294820368508`},{416.9425022576445`,129.10262481798844`},{456.5854837834621`,93.27009566112235`},{490.66294024067537`,99.34761949764788`},{511.2216599987399`,118.25711245519722`},{504.4499839864751`,172.12529051859326`},{464.41561878710235`,194.61385178651443`},{463.68454362329186`,169.12714388720883`},{445.0901268306171`,157.44471046146958`},{485.2401840592797`,159.64778208305336`},{489.486327687472`,136.89337530101932`},{477.6512792443716`,118.19557414174511`},{466.9017666505656`,134.4835349462366`},{455.69194747213817`,118.9881876190077`},{442.0132111580141`,134.94137999831997`}},{1,1}200]/200;
n=Length[v];
rim=Range[7];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[7,8,6,11,5,12,3,14,2,9,1,8],e[9,8,10,11,12,14,15,9,10,13,14],e[2,15,13,11],e[15,10,6],e[4,12,13]
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

17

17-1.1

v=Append[{{92.90411907880626`,221.8245128228698`},{70.82384436663143`,195.39804983128818`},{66.71134802907743`,179.04684148742228`},{70.33477772543432`,166.57443753925764`},{99.4836313798373`,130.0245359944235`},{139.72442008877962`,130.38109689539482`},{165.8545520613108`,194.44400850166227`},{146.53762433166347`,219.35508766411596`},{140.1677120197169`,153.77679222872052`},{119.12820966713393`,143.60757896520823`},{98.61391188490057`,157.35203801954071`},{120.9712440539112`,167.17191796791224`},{140.0592982322594`,181.1934344790805`},{120.23162110392346`,212.69125352839575`},{118.11152926031039`,193.27795798767505`},{95.88911202680241`,169.4076511848133`}},{1,1}200]/200;
n=Length[v];
rim=Range[8];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[1,14,7,15,2,14,8],e[5,10,9,7,13,16,4,11,10,6,9,13,15,16,11,5],e[10,12,11],e[9,12,13],{3,15},{4,15},{12,16},{15,14}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

17-1.2

v=Append[{{426.240748719081`,220.5905443912651`},{407.1421243723074`,203.265848112853`},{400.9649708553716`,190.86838731189698`},{429.1813697046882`,126.29956331189044`},{470.3130745599734`,126.70644168725747`},{496.3008895805752`,190.26269336674835`},{489.94649737739996`,202.5306928664512`},{472.6572488362358`,218.70102587535607`},{447.6234403093923`,211.87964826408913`},{468.61004196610764`,178.34454762162244`},{449.2031764258742`,191.89020686821647`},{431.7336067865359`,176.7493994454676`},{470.393217270273`,153.4479064258686`},{450.17567739124`,165.75443607475398`},{429.3693968326987`,155.2079636405245`},{449.08758597832673`,139.8452225584845`}},{1,1}200]/200;
n=Length[v];
rim=Range[8];
rimedges=Partition[rim,2,1,1];
Show[Graphics[Circumcircle[v[[rim]]]],EdgeDelete[VertexDelete[g=UndirectedEdge@@@Graph[Range[Length[v]],Sort[Sort/@Join[{
e[12,15,4,16,13,6,11,3,15,16,5,13,10,11,12],e[11,2,9,7,11,9,8],{1,9},e[15,14,10,6],e[3,12,14,13],{12,10},{16,14}
},rimedges,{#,Length[v]}&/@rim]],VertexCoordinates->v,VertexLabels->"Name"],n],UndirectedEdge@@@rimedges]]

tallies[g]

QChromaticPolynomial[g,u]//TraditionalForm

HamiltonianGraphQ[g]

Graph[EdgeList[g]]

RecognizeGraph[g]

With[{poly=ChromaticPolynomial[g,x]},Select[GraphData[VertexCount[g]],Expand[poly-GraphData[#,"ChromaticPolynomial"][x]]==0&]]

Embeddings

Select[Cases[GraphData[All],{"ChromaticallyEquivalent",_}],FreeQ[GraphData[#,"EmbeddingClasses"],"Planar"]&]

Select[Cases[GraphData["Polyhedral"],{"ChromaticallyEquivalent",_}],FreeQ[GraphData[#,"EmbeddingClasses3D"],"Canonical"]&]

{"ChromaticallyEquivalent", {11, 1, 1}}

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{11,1,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{11,1,1}},"EdgeList"]]

Default embedding

GraphPlot[GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Edges"],GraphLayout->"HighDimensionalEmbedding"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,1,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,1,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

bilat

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

Planar

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Edges"],GraphLayout->"TutteEmbedding"]

a=1/6;y=1/10;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a},{0,y+a},{a,y+a},{-0,y+2a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{e[1,2,3,1,5],e[4,5,10,7,11,6,8,4],e[1,4,9,8,1,6,3,11,10,2,5,9,6,10,9],e[3,7,2]}],VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{11,1,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{11,1,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{11,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{11,1,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{11,1,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{11,1,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {11, 1, 2}}

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{11,1,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{11,1,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Edges"]

RotateGraph[GraphicsToGraph@,Pi]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,1,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,1,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Edges"],GraphLayout->"TutteEmbedding"]

a=1/7;y=1/6;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a},{0,y},{-a+2a/3,y+a},{-a+4a/3,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{e[5,1,2,3,1,6,7,2,5,9,4,1,8,10,11,5,7,3,6,8,4,10,9,11],e[10,6,11,7],e[1,9]}],VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{11,1,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{11,1,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{,}

RecognizeGraph/@gs

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[,-2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{11,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{11,1,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{11,1,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{11,1,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {11, 2, 1}}

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{11,2,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{11,2,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,2,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,2,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Edges"],GraphLayout->"TutteEmbedding"]

a=1/6;y=1/8;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y+a/2},{0,y+a},{0,y+3a/2},{-a/2,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{e[1,2,3,1,4,5,2,7,3,6,1,5,7,6,4,11,8,5,9,10,7],e[6,10,11,9,8,4],{11,6},{10,5}}],VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{11,2,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{11,2,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Medium}]&/@{,}

RecognizeGraph/@gs

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[],VertexSize->.5]

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

RecognizeGraph[g]

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[,2Pi/3],VertexSize->.5]

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

RecognizeGraph[g]

Tutte embedding construction 3 #

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{11,2,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{11,2,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{11,2,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{11,2,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {11, 2, 2}}

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{11,2,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{11,2,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,2,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,2,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{11,2,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{11,2,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{11,2,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{11,2,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Edges"],GraphLayout->"TutteEmbedding"]

a=1/6;y=1/10;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a},{a,y+a},{0,y+2a/3},{0,y+4a/3}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{e[1,2,3,1,6,3,7,2,5,4,1,8,6,7,9,5,10,9,11,7,8,4,2,9],e[8,10,11,8,5]}],VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{11,2,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{11,2,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {11, 3, 1}}

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{11,3,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph","All"]//StyleGraphs

Planar

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{11,3,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{11,3,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{,,,}

RecognizeGraph/@gs

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[,2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #4

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #5

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Halin

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{11,3,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph","Matchstick"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v},
a=1/6;y=1/10;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y+2a},{-a,y+2a/3},{-a,y+4a/3},{a,y+2a/3}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,9,1,10,6,1,3,6,8,3,7,10,9,11,7,2,5,4,2,1],e[7,8,10],e[7,9,5,11],e[3,2,11]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{11,3,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {11, 3, 2}}

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{11,3,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{11,3,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,3,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{11,3,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{11,3,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{11,3,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{11,3,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{11,3,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+s},{a,y+s},{a,y+a},{-a,y+s/4},{-a,y+s/2},{-a,y+3s/4}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[3,1,4,9,1,10,11,1,6,3,7,8,5,4,2,3],{1,2},e[5,9,10,7,11,6,7],e[8,10,5],{2,7},{2,8},{2,5}
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{11,3,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{11,3,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {12, 1, 1}}

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"StandardName"]

All

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph","All"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{12,1,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{12,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v},
a=1/6;y=1/8;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+s/3,y},{-a+2s/3,y},{-a,y+a},{-a+s/3,y+a},{a,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[10,1,3,2,1,4,8,9,5,12,7,6,10,4,11,7,8,11],e[3,6,1,5,2,12],e[11,10,7,3],e[2,7,9,12],e[8,1,9]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing Construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{12,1,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{12,1,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{12,1,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {12, 1, 2}}

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{12,1,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph","All"]//StyleGraphs

Planar

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{12,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{12,1,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{12,1,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{12,1,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

Tutte embedding construction #1

GraphPlot[RotateGraph[,2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction #2

GraphPlot[RotateGraph[,-2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction #3

GraphPlot[RotateGraph[,-4Pi/3]]

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

RecognizeGraph[g]

Halin

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph","LCF"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/8;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+s},{a,y+s},{-a,y+a},{-a+s/3,y},{-a+2s/3,y},{a-s/3,s+y},{-a+s/3,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[5,1,4,8,1,6,8,12,11,6,3,1,2,5,10,9,4,12,9,11,10],e[3,11,7,5,11,8],e[7,2,3,7],e[9,1,10]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

UnitDistance

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{12,1,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph","Matchstick"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Edges"]

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

RecognizeGraph[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{12,1,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{12,1,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {13, 1, 1}}

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{13,1,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{13,1,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,1,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,1,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

bilat

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

Planar

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{13,1,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{13,1,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{13,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{13,1,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{13,1,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{13,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,s,v},
a=1/6;y=1/10;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+s},{a,y+s},{-a,y+a},{a,y+a},{0,y+s},{0,y},{(1/18),(7/45)},{-(1/18),(17/45)}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,11,2,3,6,1,4,8,1,3],e[8,13,10,3,7,2,9,5,2,1],e[8,6,10,7,9,8,7],e[5,11,4,12,9],e[5,12],e[6,13],{11,12},{7,13},{4,9}
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{13,1,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{13,1,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {13, 1, 2}}

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{13,1,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{13,1,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,1,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,1,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

bilat

Length[bilat]

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

Planar

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{13,1,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{13,1,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{13,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{13,1,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{13,1,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{13,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,s,v},
a=1/6;y=1/10;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+s},{a,y+s},{-a,y+s/4},{-a,y+2s/4},{-a,y+3s/4},{a,y+s/3},{a,y+2s/3},{0,y+s/4}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[5,1,4,8,1,9,10,1,6,3,1,2,5,11,2,12,7,2,3,7,6,10,7],e[12,10],e[13,9,8,13,5,4,13,11,12],e[11,9,12]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{13,1,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{13,1,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {13, 1, 3}}

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{13,1,3}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{13,1,3}},"EdgeList"]]

Default embedding

GraphPlot[GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Edges"],GraphLayout->"SpringEmbedding"]

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

RecognizeGraph@g

GraphPlot[GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Edges"],GraphLayout->"SpringElectricalEmbedding"]

v[[8,2]]

RegionIntersection[Line[v[[{2,8}]]],Line[v[[{1,9}]]]][[1,1]]//FullSimplify

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,1,3}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,1,3}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/8;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a},{a,y+a},{0,y+2a},{-a+s,y},{-a+2s,y},{-a/2,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[12,1,4,8,1,6,3,1,2,5,9,2,7,3,2],e[1,11,4,13,8,6,10,7,9,12,5],e[3,10,11,12],e[7,11,13],{1,5},e[6,13,10],{11,9}
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{13,1,3}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{13,1,3}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{,}

RecognizeGraph/@gs

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[,2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #11

GraphPlot[RotateGraph[,2Pi/3]]

s=1;
v=Join[{{-1,0},{1,0},{0,Sqrt[3]}},Sequence@@Table[{i/2 s,-1/3+j/2 s},{i,-1,1},{j,2}]];
v=Join[v,Subdivide[v[[6]],v[[5]],3][[2;;-2]],Subdivide[v[[6]],v[[9]],3][[2;;-2]]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,6,2,8,6,4,1,5,3,9,2],e[4,5,7,9,8,13,7,11,4,10,7,12,8],e[6,7,3],e[5,11,10,6,12,13,9]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Tutte embedding construction 3 #

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{13,1,3}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{13,1,3}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{13,1,3}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{13,1,3}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {13, 2, 1}}

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{13,2,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{13,2,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,2,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,2,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{13,2,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{13,2,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{13,2,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{13,2,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{13,2,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{13,2,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,s,v},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a},{a,y+a},{-a+s,y+a},{-a+2s,y+a},{0,y+3a/2},{-(1/18),(19/90)}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,6,3,1,2,5,9,2,7,3,2],e[1,5,4,13,8,10,11,9,7,6,12,7,11,12,10,6,8],e[10,13,11],e[4,9,13]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{13,2,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{13,2,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {13, 2, 2}}

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{13,2,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{13,2,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,2,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{13,2,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

bilat

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

Planar

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a},{a,y+a},{-a+s,y+2a},{-a+2s,y+2a},{0,y+a},{0,y+a/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[2,1,4,8,1,6,3,10,11,3,7,2,5,4,13,12,10,6,8,12,9,5,1],{8,10},e[2,9,7,11,12],e[11,9,13,5],{4,12},e[1,3,2]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{13,2,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{13,2,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{13,2,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{13,2,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{13,2,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{13,2,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {14, 1, 1}}

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{14,1,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{14,1,1}},"EdgeList"]]

Default embedding

GraphPlot[GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Edges"],GraphLayout->"HighDimensionalEmbedding"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,1,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,1,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{14,1,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{14,1,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #6

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,1,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{14,1,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a},{a,y+a},{0,y},{-s/2,y+s},{s/2,y+s},{s/2,y+2s},{-s/2,y+2s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[2,10,1,4,8,1,6,3,7,6,14,13,6,8,14,11,12,13,9,5,12,10,11,4,10,5,2,1],e[7,9,2,7,13],{11,8},e[14,12,9],e[1,3],{2,3}
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,1,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{14,1,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {14, 1, 2}}

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{14,1,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{14,1,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,1,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,1,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

bilat

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

Planar

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/4;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a},{-a+s,y+2a},{-a+2s,y+2a},{-a+s,y+a/2},{-a+s,y+a},{-a+2s,y+a},{a-s,y+a/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,2,5,1,4,5,14,11,4,8,1,6,8,11,12,13,14,10,7,2,3,1],e[7,3,10,9,3,6,9,12,8,9],e[9,13,10],e[11,13],e[4,14,7,5]}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{14,1,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{14,1,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[,2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #4

GraphPlot[RotateGraph[,-2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #5

GraphPlot[RotateGraph[,-2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #6

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #8

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,1,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{14,1,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{14,1,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {14, 2, 1}}

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{14,2,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{14,2,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,2,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,2,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/4;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+2s},{-a,y+3s},{a,y+2s},{-a+2a/3,y+2s},{-a+2a/3,y+3s},{-a+4a/3,y+3s},{-a+2a/3,y+s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,2,3,1,5,2,7,3,6,1,4,8,9,6,7,10,5,4,11,8,12,9,1,8],
e[7,13,6,12,13,10,11],e[13,11,12],e[4,14,11],e[10,14,5],e[2,10]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{14,2,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{14,2,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[,2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #5

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #7

GraphPlot[RotateGraph[,-2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,2,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,2,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{14,2,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{14,2,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{14,2,1}}],-1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {14, 2, 2}}

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{14,2,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{14,2,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,2,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,2,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{14,2,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{14,2,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,2,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,2,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{14,2,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,2,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+2s},{0,y},{a,y+2s},{-a+s,y+2s},{-a+2s,y+2s},{-a+s,y+s},{-a+2s,y+s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[8,1,3,2,1,6,3,7,2,5,1,9,4,1],e[9,5,10,7,6,8,4,13,9,14,12,7],e[2,10,12,11,8,13,11,6,12],e[5,14,10],e[12,13,14]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,2,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{14,2,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{14,2,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {14, 3, 1}}

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{14,3,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{14,3,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,3,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,3,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/8;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+s},{-a,y+2s},{0,y+2s},{a/2,y+2s},{0,y},{a/2,y},{-a/2,y+s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
{1,12},{1,13},
e[1,2,3,1,6,3,7,2,5,1,4,8,1,9,6,7,5,13,12,4,14,8,9,10,11,7,13,11,12,14,10,6,11],e[9,14],e[10,12]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{14,3,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{14,3,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,3,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,3,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{14,3,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Matchstick"]//StyleGraphs

3D All

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{14,3,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {14, 3, 2}}

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{14,3,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{14,3,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,3,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,3,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/8;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a},{-a/2,y+a},{0,y+a},{a/2,y+a},{-a/2,y},{0,y},{a/2,y}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[2,1,3,6,1,4,12,1,13,14,1,5,2,3,7,2],e[7,6,8,4,9,12,10,13,11,14,7,5,14],e[1,8,9,6,10,11,6],{9,10},{11,7},{12,13}
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{14,3,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{14,3,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,3,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,3,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{14,3,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{14,3,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{14,3,2}}],-1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {14, 4, 1}}

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{14,4,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{14,4,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,4,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,4,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{14,4,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{14,4,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #6

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #7

GraphPlot[RotateGraph[,-2Pi/3],VertexSize->.2]

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

RecognizeGraph[g]

Tutte embedding construction 3 #8

GraphPlot[RotateGraph[,2Pi/3],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #13

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #14

GraphPlot[RotateGraph[,-2Pi/3],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,4,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,4,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{14,4,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,4,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,s,v},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+s},{-a,y+2s},{0,y},{-a+s,y+2a-s},{a-s,y+2a-s},{0,y+2a},{-(1/18),(37/270)}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[2,1,3,7,2,3,6,1,9,11,12,7,13,6,9,8,4,10,5,7],e[12,8,14,4,1,8,11,6],e[11,13,12,5,2],e[14,5,8],e[10,14],e[10,1,5],e[3,13]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,4,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{14,4,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {14, 4, 2}}

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{14,4,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{14,4,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,4,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{14,4,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/6;s=2a/4;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+s,y},{-a+2s,y},{-a+3s,y},{-a+s,y+2a},{-a+2s,y+2a},{-a+s/2,a+y},{-a+3/2s,a+y}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,9,10,1,5,2,1,3,6,1],e[6,4,13,6,11,13,8,14,11,12,14,9,8],e[3,10,5,7,3,2,7],
e[9,12,10,7],e[13,14],e[11,3,12]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{14,4,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{14,4,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{14,4,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{14,4,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{14,4,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{14,4,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 1, 1}}

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,1,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,1,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,1,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,1,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,1,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,1,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,1,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,1,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,s,v},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,2s+y},{0,2s+y},{a/2,2s+y},{a-s,y+s},{-a+s,y},{-a+2s,y},{-3a/4,s+y},{-a/2,y+2s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[4,1,12,13,1],e[2,1,8,6,1,3,6,7,2,3,7],
e[4,8],e[9,6,10,7,5,13,11,12,9],e[14,4,12],e[9,14,8],e[4,9,10,11,9],e[13,2,5],e[11,5,10],e[8,15,9],e[6,15,14]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,1,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,1,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 1, 2}}

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,1,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,1,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,1,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,1,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,1,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,1,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,1,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,1,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/8;s=a/4;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a/2,y},{0,y},{-a,y+a},{-a/2,y+a},{0,y+a},{a/2,y+a},{a,y+a},{a/2,y+3/2a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[8,1,2,5,14,2,3,7,6,3,1,6,10,4,1,10,11,12,13,14,7,2],e[4,8,9,5,13,9,12,8,11,4],e[11,6,15],
e[7,15,12],e[13,15,14],e[9,1,5],e[12,6]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,1,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,1,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 1, 3}}

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,1,3}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,1,3}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,1,3}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,1,3}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,1,3}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,1,3}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,1,3}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,1,3}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,1,3}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,1,3}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Edges"],GraphLayout->"TutteEmbedding"]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,1,3}}]]

<<IGraphM`

Tally[Length/@IGFaces[GraphData[{"ChromaticallyEquivalent",{15,1,3}}]]]

GraphPlot[IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,1,3}}]]]

Module[{a,y,v,s},
a=1/5;y=1/15;s=a/4;dy=1/15;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y+2a},{0,y},{0,y+dy},{0,y+2a-dy},{-1/50,a+y},{1/50,a+y},{1/2a,y+dy},{a/2,y+2a-dy}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{e[1,2,3,1,6,8,7,2,5,9,4,6,11,15,5,14,10,4,1,9,10,13,11,12,10],e[12,13,14,11],e[7,15,8,11],e[12,4,11],e[11,5,7],e[2,9,14],e[6,3,8],e[3,7]}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,1,3}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,1,3}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->1.5],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 2, 1}}

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,2,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,2,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,2,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,2,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,2,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,2,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction 3 #26

GraphPlot[RotateGraph[],VertexSize->.5]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,2,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,2,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,2,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,2,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+s,y},{-a+2s,y},{-a+s,y+s},{-a+2s,y+s},{-a,y+2s},{-a+s,y+2s},{-a+2s,y+2s},{a,y+2s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[12,1,4,8,1,9,5,1,2,15,7,2,3,6,1,3,7,6,12,4,13,12],e[13,6,14,15,6],
e[13,14,11,10,13],e[9,8,10,14],e[8,11,9,15,5,2],e[11,15],e[4,10]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,2,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,2,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 2, 2}}

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,2,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,2,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,2,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,2,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,2,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,2,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,2,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,2,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,2,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,2,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{a,y+a},{-a,y+a},{0,y},{0,y+a/2},{0,y+a},{-3/4a,y+a/2},{-a/2,y},{-a/2,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{e[9,1,2,3,1,6,3,7,2,5,10,14,4,9,6,7,8,5,11,8,12,15,9,13,14,15,13,4],e[15,6,12,7],e[10,11,12],e[11,15,10],e[4,1,14],e[10,1,5],e[2,8]}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,2,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,2,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 3, 1}}

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,3,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,3,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,3,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,3,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/8;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+s,y},{-a+2s,y},{-a+3s,y},{-a+4s,y},{-a,y+a/2},{-a+s,y+a/2},{-a+a/8,y+4a/3},{a-s,y+4a/3}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,9,10,1,11,5,1,2,3,7,2,5,7,6,3,1,12,4,13,8],e[8,9,13,12,6,14,12],e[13,14,9],e[1,6,15,7],
e[5,15,11],e[6,10,15],e[14,10,11]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,3,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,3,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[,-2Pi/3],VertexSize->2]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,3,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,3,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,3,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{15,3,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,3,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->4],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.1v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 3, 2}}

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,3,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,3,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,3,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,3,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

bilat

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

Planar

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,3,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,3,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[,-2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[],VertexSize->10]

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

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[,-2Pi/3],VertexSize->10]

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

RecognizeGraph[g]

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,3,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,3,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,3,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,3,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/8;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{-a+6a/5,y+2a},{a,y+2a},{-a,y+2s},{-a+2a/5,y},{-a+4a/5,y},{-a+6a/5,y},{-a+8a/5,y},{-a+2a/5-a/5,y+s},{-a+4a/5-a/5,y+s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[9,1,4,10,1,11,12,1,13,5,1,2,3,8,2,5,8,7,3,1,6,7,12,13,7],{8,13},e[3,6,9,4,14,15,11,14,9,15,12,6,15],
e[11,10,14]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,3,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,3,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

can=Polyhedron[];

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 4, 1}}

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,4,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,4,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,4,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,4,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,4,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,4,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,4,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,4,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,4,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,4,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+s},{-a,y+2s},{-a,y+4s},{a,y+4s},{0,y},{0,y+s},{0,y+2s},{0,y+3s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,12,1,5,2,1,3,6,1,10,6,7,3,2,11,7,10,9,8,4,13,5,12,13,14,15,11,5,14,9],e[13,8,14],
e[9,15,10,11],e[5,15],e[8,1,9],e[2,7]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,4,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,4,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 4, 2}}

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,4,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,4,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,4,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,4,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,4,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,4,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction 3 #4

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #6

GraphPlot[RotateGraph[,-2Pi/3]]

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

RecognizeGraph[g]

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,4,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,4,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,4,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,4,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+s,y},{-a+s,y+a/2},{-a+2s,y+a/2},{-a,y+a/2},{-a,y+a},{-a,y+3a/2},{a,y+3a/2},{-a+2s,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,5,2,1,3,2,14,7,3,6,1,13,12,11,4,9,10,5,14,15,10,8,9,11],
e[9,12,15,13,6,7,13,14],e[8,5,15],e[2,7],e[10,12,1,11]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,4,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,4,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 5, 1}}

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,5,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,5,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,5,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,5,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,5,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,5,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,5,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,5,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,5,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,5,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/8;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},Sequence@@Table[{-a,y+s i},{i,4}],Sequence@@Table[{a,y+s i},{i,{1,3,4}}],{0,y+s/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[5,1,4,5,2,1,3,2,7,3,6,1,8,4,15,12,5,15,8,9,10,11],e[7,14,13,12,8],e[12,9,13,10,14,11,7,6,11],
e[9,1,10],{1,11},e[14,2,12],{2,13}
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,5,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{15,5,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->100000,PrecisionGoal->20])//Timing

Graphics3D[Polyhedron[]]

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,5,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 5, 2}}

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,5,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,5,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,5,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,5,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,5,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,5,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,5,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,5,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,5,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,5,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y},{-a,y+a/2},{-a,y+a},{-a,y+3a/2},{a,y+3a/2},{0,y+a},{0,y+a/2},{-a/2,y+a/4}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[9,1,4,8,1,5,2,1,3,6,7,3,2,7,12,5,8,15,9,4,15,14,13,10,11,7],
e[1,6,11,12,13,5,14,9,10,14,8],e[13,11,1,10],e[2,12]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,5,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{15,5,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,5,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 6, 1}}

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,6,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,6,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,6,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,6,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+2a/3,y+2a-s},{-a+4a/3,y+2a-s},{-a+2a/3,y+s},{-a,y+s},{-a,y+2s},{-a,y+3s},{-a,y+4s},{0,y+2a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,5,1,2,5,7,2,3,1,6,15,7,9,15,8,6,14,13,12,11,4,10,5,9,8,14],
e[8,13,9],e[11,10,12],e[10,13,5],e[7,3,6],e[11,1,12],e[14,1,13],e[3,15]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,6,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,6,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,6,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,6,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,6,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,6,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {15, 6, 2}}

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{15,6,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{15,6,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,6,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{15,6,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Planar"]//StyleGraphs

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,6,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{15,6,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{15,6,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{15,6,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{15,6,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{15,6,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Matchstick"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s,h},
a=1/6;y=1/10;s=2a/5;h=1/20;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y-h},{a,y-h},{-a,y+2a},{a,y+2a},
{-a,y+s-h},{a,y+s-h},
{0,y+2s},{-a,y+3s},{a,y+3s},{-a,y+4s},{0,y+4s},{0,y+2a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[2,7,14,15,13,11,12,10,11,14,13,6,15,7],e[9,5,1,4,5,2,1,3,6,1,8,9,2,12,7,3,2],e[4,8,10,9,4],
e[14,12],e[11,1,13],e[3,15],e[1,10,2]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

3D All

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{15,6,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

can=Polyhedron[];

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 1, 1}}

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,1,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,1,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,1,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,1,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,1,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,1,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,1,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,1,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,s,v},
a=1/6;y=1/10;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+a/2},{-a,y+a},{-a,y+3a/2},{0,y+3a/2},{0,y+a},{a,y+a},{-a/2,y},{-a/2,y+a/2},{-(1/8),(17/120)}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[5,9,15,5,2,1,4,8,1,9,10,1,6,3,1,14],
e[4,16,15,8,16,14,4],
e[8,9,12,13,7,6,10,11,7,3,2,13,5,14,15],
e[6,11,12,5,1],
e[2,7],e[10,12],e[11,13]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,1,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,1,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

can=Polyhedron[];

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->100000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 1, 2}}

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,1,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,1,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,1,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,1,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,1,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,1,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,1,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,1,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,s,v},
a=1/10;b=1/15;y=1/3;y2=1/20;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},
{-a,y},{a,y},{-a,y+2b},{a,y+2b},
{-a,y2},{a,y2},{-a,y2+2b},{a,y2+2b},{-a,y2+b},{0,y2+2b},{-a+2a/3,y2+b},{-a+4a/3,y2+b},{0,(31/120)}
};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[13,16,1,4,6,1,3,6,7,3,2,5,7,2,16],e[4,5,6],e[1,2,9,8,12,10,13,11,9,15,11,16,5],e[4,16,10,14,12],
e[15,8,14,15,13,14],e[12,1,8],e[10,1,9],e[2,11]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,1,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

can=Polyhedron[];

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 2, 1}}

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,1,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,1,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,1,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,1,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,1,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,1,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,1,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,1,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,2,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,2,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+2s,y+2a},{-a+4s,y+2a},
Sequence@@Table[{-a+i s,y},{i,4}],{-a,y+a},{-a+2s,y+a},{-a+s,y+a/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,10,11,12,13,5,7,9,8,6,14,4,16,15,14,16,11,15,8,12,9,13,7,2,3,6,1,3,7],
e[5,1,2,5],e[8,3,9],e[6,15],e[16,10,1,11],e[15,12,1,13],e[1,14]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,2,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,2,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,2,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,Reverse/@faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 2, 2}}

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,2,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,2,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,2,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,2,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,2,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,2,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,2,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,2,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,2,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,2,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+s,y},{-a+2s,y},{-a+3s,y},{-a+4s,y},{-a+3s,y+2a},{-a,y+a},{-a+a/3,y+a},{-a+2a/3,y+a},{0,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,9,10,1,11,5,1,2,3,7,2,5,7,12,6,13,4,14,8,9,15,14,13,1,3,6,1],
e[3,12,16,6,14],e[6,15,16],e[8,15],e[9,16,10,11,7],e[10,12,11]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,2,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,2,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,2,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 3, 1}}

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,3,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,3,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,3,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,3,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+4a/3,y},{a-2a/3,y+a},{a-4a/3,y+a},{0,y+2a},{-a,y+2a/3},{-a,y+a/3},{-a,y+a},{-a+2a/3,y+a/2},{-a+a/3,y+a/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,5,2,1,3,6,1,14,6,11,3,2,7,3],e[11,7,5,8,9,11,10,6],e[14,10,9,5],e[4,13,12,14,16,15,8,10],e[4,16,13],e[10,15,4],e[16,12,1,13],e[7,9],e[15,14]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,3,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,3,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,3,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,3,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,3,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,3,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,3,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 3, 2}}

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,3,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,3,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,3,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,3,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,3,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,3,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,3,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,3,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,3,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,3,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Edges"]

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

RecognizeGraph[g]

Planar construction

Module[{a,y,v,s},
a=1/6;y=1/8;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+2s,y},{-a+3s,y},{-a+4s,y},{-a+s,y+a},{-a+2s,y+a},{-a+3s,y+a},{-a+4s,y+a},{-a+3s,y+2a},{-a,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,9,10,1,5,2,1,3,6,1,16,6,15,7,2,3,7,5,10,14,15,13,9,8,12,6,11,8],
e[11,16,4,11,12,13,14,7],e[6,13,10],e[15,3],e[9,12],e[5,14]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,3,2}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,3,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,3,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 4, 1}}

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,4,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,4,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,4,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,4,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Planar"]//StyleGraphs

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,4,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,4,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,4,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,4,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,4,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,4,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Edges"]

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

RecognizeGraph[g]

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a/2,y},{0,y},{a/2,y},{-a,y+s},{-a/2,y+s},{0,y+s},{a/2,y+s},{a,y+s},{a/2,y+2s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,9,10,1,5,2,1,3,6,1,11,6,7,15,5,10,14],e[7,3,2,7],e[4,11,12,13,14,15,2],e[4,12,8,13,9,8],
e[13,10],e[12,6,13,16,7],e[5,14,16,6],e[16,15]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,4,1}}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,4,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,4,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 4, 2}}

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,4,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,4,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,4,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,4,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a+s,y},{-a+2s,y},{-a,y+a},{-a+s,y+a},{-a+2s,y+a},{a,y+a},{-a,y+a/2},{-a+s/2,y+a/2},{-a+2s,y+2a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,9,5,1,2,7,3,2,13,7,16,3,1,6,3],e[16,6,10,14,4,15,11,12,13,5,2],e[9,8,11,10,15,8],e[6,11,16,12,7],e[11,9,12],e[9,13],e[10,1,14,15]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,4,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,4,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,4,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,4,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,4,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,4,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,4,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 5, 1}}

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,5,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,5,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,5,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,5,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},Sequence@@Table[{-a,y+i s},{i,4}],{a,y+3s},{a,y+2s},{0,y+2s},{-a+2a/3,y+s},{-a+4a/3,y+s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,5,1,2,5,13,12,7,3,2,7,6,11,10,9,8,1,3,6,1,9,14,13,16,15,8,4,15,14,16,5],e[15,9],e[12,14,10,12,11,7],e[13,2,12],e[4,16],e[11,1,10]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,5,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,5,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,5,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,5,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,5,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,5,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,5,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 5, 2}}

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,5,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,5,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,5,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,5,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a/2,y},{0,y},{-a,y+a/2},{-a/2,y+a/2},{0,y+a/2},{a/2,y+a/2},{0,y+a},{-a,y+3a/2},{a,y+3a/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[15,1,4,8,1,9,5,1,2,3,7,2,5,16,7,6,15,10,4,11,14,16,2],e[1,6,3,1,10,11,12,13,5],e[8,11],e[15,16],e[7,15,14,13,9,8,12],e[9,12,14,10],e[13,16]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,5,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,5,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,5,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,5,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,5,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,5,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,5,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 6, 1}}

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,6,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,6,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,6,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,6,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+s},{-a,y+2s},{a,y+2s},{s-a,y},{s-a,y+s/2},{s-a,y+s},{s-a,y+3/2s},{2s-a,y+s/2},{2s-a,y+3s/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[8,1,4,11,1,5,2,1,3,6,1,9,6,7,3,2,10,7,9,8,4,12,13,14,16,10,5,11,12],e[16,15,11],e[12,8,13],e[9,10],e[16,5,15,12],e[9,14,10],e[8,14],e[2,7],e[16,13,15]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,6,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,6,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,6,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,6,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,6,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,6,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,6,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 6, 2}}

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,6,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,6,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,6,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,6,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y},{-a,y+a/2},{-a,y+a},{-a,y+3a/2},{a,y+3/2a},{a,y+a},{0,y+a/4},{0,y+a/2},{0,y+3a/4}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1],e[5,2,1,3,6,1,9,10,11,6,7,3,2,13,12,7,11,12],e[15,5,14],e[9,4,14,15,16],e[13,5,8,14],e[12,2,7],
e[14,9,15,13,16],e[10,12,16,10],e[9,16],e[2,8],e[11,1,10]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,6,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,6,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,6,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,6,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,6,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,6,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,6,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 7, 1}}

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,7,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,7,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,7,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,7,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

bilat

g=;

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

Planar

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/4;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+s},{-a,y+2s},{a,y+s},{a,y+2s},{0,2a+y},{0,y+a},{-a+2a/3,y+3s},{-a+4a/3,y+3s},{0,y+a/4}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,5,1,3,6,1,8,9,6,12,3,7,2,3],e[1,2,5,10,11,7,12,14,9,10,2,11,15,7],e[12,15,14,13,9],e[15,13,11],e[4,8,10,13],e[4,16,8],e[10,16,5],e[1,9],e[6,14]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,7,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,7,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{,,,}

RecognizeGraph/@gs

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[],VertexSize->1]

((v[[15,2]]-v[[5,2]])/2)

Table[(1/4)+(5/16)(i/3),{i,3}]

(1/4)+(5/16)+(1/2)(5/16)

v=Join[{{-1,0},{1,0},{0,Sqrt[3]},{-1/3,1/4},{0,1/4},{1/3,1/4},{0,(17/48)},{0,(11/24)}},Subdivide[{-1/4,(9/16)},{1/4,(9/16)},3],{{0,(23/32)},{-1/3,7/8},{0,7/8},{1/3,7/8}}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,5,2,6,7,4,1,14,3,16,2],e[4,5,6,16,15,14,4,9,14],e[6,12,16],e[9,10,11,12,15,9,7,12,8,9,13,12],e[5,7,8],e[3,15,13,11,8,10,13]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[,2Pi/3],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #7

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #8

GraphPlot[RotateGraph[,-2Pi/3],VertexSize->.5]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,7,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,7,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,7,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,7,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,7,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 7, 2}}

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,7,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,7,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,7,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,7,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y},{0,y+a/2},{0,y+a},{-a,y+a},{a,y+a},{-a+s,y+3a/2},{-a+2s,y+3a/2},{0,y+2a},{a,y+a/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,5,2,1,6,3,1,11,6,15,3,7,2,3],e[15,7,12,16,5,8,9,11,4,9,16,8],e[11,10,12,14,13,11],e[10,13,15,14,10,16],e[6,13],e[7,14],e[11,16,2,12]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,7,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,7,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[,2Pi/3],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #7

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #9

GraphPlot[RotateGraph[,2Pi/3],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,7,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,7,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,7,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,7,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,7,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 8, 1}}

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,8,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,8,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,8,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,8,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y+a/4},{0,y+a},{-a,y+a},{a,y+a},{-a+s,y+3a/2},{-a+2s,y+3a/2},{0,y+2a},{a,y+a/2},{-a,y+a/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[5,1,4,5,2,1,6,3,1,16,10,1],e[2,3,7,2,11,15,2],e[16,4,8,15,5,8,16,9,15],e[10,9,11,7,14,6,10,12,14,13,9,12,6],e[7,13,11],e[12,13],e[15,16],e[3,14]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,8,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,8,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,8,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,8,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,8,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,8,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,8,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 8, 2}}

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,8,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,8,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,8,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,8,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y},{0,y+2a},{-a,y+a},{a,y+a},{s-a,y+a/2},{2s-a,y+a/2},{0,y+a},{s-a,y+3a/2},{2s-a,y+3a/2}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,8,1,5,2,1,10,6,1,3,7,2,3,6,9,7,11,5,8,13,11,16,9,15,14,16,15,10,4,12,13,5],e[10,14,11,2],e[14,13,10,12,8],e[7,16],e[3,9],e[6,15]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,8,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,8,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,8,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,8,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,8,2}}],Debug->True]//Timing

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,8,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,8,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 9, 1}}

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,9,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,9,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,9,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,9,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y+a/2},{0,y+a},{s-a,y+3a/2},{2s-a,y+3a/2},{-a,y+3a/2},{-a,y+a},{a,y+a},{s-a,2a+y},{2s-a,2a+y}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[5,1,2,5,14,7,3,2,7,16,15,6,3,15,12,6,1,3,16,11,9,8,4,1,13,12,10,11,7],e[2,14,11],e[16,10,13,4,5,8,13,9,14,8],e[9,10,15],e[1,12]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,9,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,9,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,9,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,9,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,9,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,9,1}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,9,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {16, 9, 2}}

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{16,9,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{16,9,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,9,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{16,9,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/3;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{0,y+2a},{0,y+a/2},{-a,y+a},{-a,y+3a/2},{a,y+a},{a,y+3a/2},{0,y+3a/2},{s-a,y+a},{2s-a,y+a}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[1,4,5,1,2,5,12,2,13,7,2,3,1,6,3,7,8],e[11,10,4,9,12,13,14,11,6,8,11],e[7,14,15,9,16,14,8,3],e[10,15,16,12],e[5,9,10],e[11,15],e[16,13],e[11,1,10]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{16,9,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{16,9,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{16,9,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{16,9,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{16,9,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"ChromaticallyEquivalent",{16,9,2}}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{16,9,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {17, 1, 1}}

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{17,1,1}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{17,1,1}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{17,1,1}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{17,1,1}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{a/2,y},
{-a/2,y+2s},{0,y+2s},{a/2,y+2s},{0,y+s},{-a,y+3s},{0,y+3s},{-a,y+4s},{a,y+4s},{a/2,y+3s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[13,1,4,8,1,5,2,1,6,3,1,15,6,7,16,2,3,7,15,13,4,12,8,5,16,15,17,10],
e[12,9,13,14,17,16],e[14,9,4],e[9,10,11,16,8],e[12,11,17],e[15,14],e[2,7],e[12,10,14],e[8,11]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{17,1,1}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{17,1,1}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{17,1,1}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{17,1,1}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{17,1,1}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{17,1,1}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"ChromaticallyEquivalent", {17, 1, 2}}

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"StandardName"]

Primary

GraphData[{"ChromaticallyEquivalent",{17,1,2}}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","All"]//StyleGraphs

Inexact

Select[GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"ChromaticallyEquivalent",{17,1,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Degenerate"]

Bilateral

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Circular"]//StyleGraphs

Circular construction

Length[hc=FindHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{17,1,2}}],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData[{"ChromaticallyEquivalent",{17,1,2}}],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

Planar

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Planar"]

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Planar"]//StyleGraphs

Planar construction

GraphPlot[GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Edges"],GraphLayout->"TutteEmbedding"]

Module[{a,y,v,s},
a=1/6;y=1/10;s=2a/5;
v={{-1/2,0},{1/2,0},{0,Sqrt[3]/2},{-a,y},{a,y},{-a,y+2a},{a,y+2a},{-a,y+s},{-a,y+3s},{-a,y+4s},{a,y+4s},{-a/2,y+s},{-a/2,y+2s},{0,y+s},{0,y+2s},{0,y+3s},{a/2,y+2s}};
g=Graph[Range[Length[v]],Sort[Sort/@UndirectedEdge@@@{
e[5,1,4,8,1,9,10,1,6,3,1,2,7,3,2,5,4,12,14,5,11,7,6,10,11,9,8,12],e[10,7],
e[8,13,12],e[9,16,11,17,5],e[16,17,15,14,17],e[15,16,13,9],e[12,15,13],e[4,14],e[2,11]
}],VertexCoordinates->v,VertexLabels->"Name"]
]

RecognizeGraph[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"ChromaticallyEquivalent",{17,1,2}}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"ChromaticallyEquivalent",{17,1,2}}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[],VertexSize->.5]

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

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[,-2Pi/3],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #4

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #5

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #7

GraphPlot[RotateGraph[,-2Pi/3],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #16

GraphPlot[RotateGraph[],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #17

GraphPlot[RotateGraph[,-2Pi/3],VertexSize->1]

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

RecognizeGraph[g]

Tutte embedding construction 3 #

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

GraphData[{"ChromaticallyEquivalent",{17,1,2}},{"RCN","CN"}]

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

MinimalCrossingGraph[GraphData[{"ChromaticallyEquivalent",{17,1,2}}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Circulant"]

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Halin"]

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Rigid"]

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Flexible"]

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"LCFSignature"]

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"ChromaticallyEquivalent",{17,1,2}}],Debug->True]//Timing

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Edges"]]

3D All

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Polyhedron"]}]

3D Canonical

GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"ChromaticallyEquivalent",{17,1,2}},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

Checks

Select[Transpose/@SplitBy[{#,GraphData[#,"ChromaticPolynomial"][x]}&/@Cases[GraphData[All],{"ChromaticallyEquivalent",_}],Most[#[[1,2]]]&],!SameQ@@Last[#]&]

GraphData

GraphDataString

file=OpenWrite["~/chromatically-equivalent.m"]

Module[{v,pair,id},
WriteString[file,GraphDataString[g,
"Embeddings"->None,
"StandardName"->{"ChromaticallyEquivalent",{v=13,pair=1,id=3}},
"Name"->"("<>ToString[v]<>","<>ToString[pair]<>")\[Hyphen]chromatically equivalent graph "<>ToString[id],
"Information"->"ChromaticallyEquivalentGraphs",
TimeConstraint->10
]]]

Close[file]