Apex Selector Graph

Author

Eric W. Weisstein
July 26, 2026

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/ApexSelectorGraph.nb.

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

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

Figure

GraphicsRow[
StyleGraphs[
GraphData/@{"FirstapexGraph","SecondapexGraph","ThirdapexGraph","FourthapexGraph"}
],
Dividers->All
]

Embeddings

"FirstapexGraph"

Primary

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

All

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

LCF

GraphData["FirstapexGraph","LCFSignature"]

GraphData["FirstapexGraph","LCFNotations"]

LCFGraph@@@%

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

MinimalCrossing

GraphData["FirstapexGraph","CN"]

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

UnitDistance

GraphData["FirstapexGraph","UnitDistance"]

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

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

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

Select[UnitDistanceEmbeddingRefine/@Complement@@(GraphData["FirstapexGraph","Graph",#]&/@{"All","UnitDistance"}),UnitDistanceGraphEmbeddingQ]

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

UnitDistance construction

Clear[g];

eqn={
(x-1/2)^2+y^2==1,
(a+1/2)^2+b^2==1,
(a-c)^2+(b-d)^2==1,
(x-c)^2+(y-d)^2==1,
(a-e)^2+(f-b)^2==1,
c^2+(z-d)^2==1,
(x-g)^2+(y+1-h)^2==1,
(e+g)^2+(h-f)^2==1,
g^2+(z+1-h)^2==1,
(e-x)^2+(y+1-f)^2==1}/.b->1/2//FullSimplify//Union

var=Variables[Subtract@@@eqn]

Length/@{eqn,var}

(soln=Solve[eqn,var,Reals])//Timing

(nsoln=NSolve[{
(x-1/2)^2+y^2==1,
(a+1/2)^2+b^2==1,
(a-c)^2+(b-d)^2==1,
(x-c)^2+(y-d)^2==1,
(a-e)^2+(f-b)^2==1,
c^2+(z-d)^2==1,
(x-g)^2+(y+1-h)^2==1,
(e+g)^2+(h-f)^2==1,
g^2+(z+1-h)^2==1,
(e-x)^2+(y+1-f)^2==1,
b==1/2},{z,a,b,c,d,e,f,g,h,x,y},Reals])//Timing

gs=Graph[Range[16],UndirectedEdge@@@{{1,2},{1,3},{1,6},{2,4},{2,7},{3,5},{3,8},{4,5},{4,11},{5,12},{6,9},{6,10},{7,8},{7,13},{8,14},{9,11},{9,12},{10,13},{10,14},{11,15},{12,16},{13,15},{14,16},{15,16}},VertexCoordinates->({{0,z+1},{-g,h},{g,h},{-x,y+1},{-e,f},{0,z},{e,f},{x,y+1},{-c,d},{c,d},{-x,y},{-a,b},{a,b},{x,y},{-1/2,0},{1/2,0}}/.#),VertexLabels->"Name"]&/@nsoln

RecognizeGraph[gs[[1]]]

DeleteDuplicatesBy[Select[gs,UnitDistanceGraphEmbeddingQ[#]&&!DegenerateEmbeddingQ[#]&],Sort[Round[10^8GraphEmbedding[#]]]&]

gs={,,,,,,,,,,,,,,,,,,,,,,};

Length[%]

gbeqn=Subtract@@@eqn;

(gb=GroebnerBasis[gbeqn,var])//Timing

(soln=Solve[gb==0,var,Reals])//Timing

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

gs={,}

Matchstick

GraphData["FirstapexGraph","Matchstick"]

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

MinimalCrossing

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

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

Default embedding

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

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

RecognizeGraph[g]

MinimalCrossing construction

CrossingNumber[GraphData["FirstapexGraph"],TimeConstraint->10]//AbsoluteTiming

CrossingNumber[GraphData["FirstapexGraph"],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData["FirstapexGraph"],"CrossingNumber"->-1]]

RecognizeGraph[g]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData["FirstapexGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["FirstapexGraph","Polyhedral"]

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

"SecondapexGraph"

GraphData["SecondapexGraph","StandardName"]

Primary

GraphData["SecondapexGraph"]//StyleGraphs

Default embedding

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

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

RecognizeGraph[g]

All

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

Construction from Robertson et al. 2019

v=Join[CirclePoints[5],CirclePoints[1/2,5],{{0,0}},Midpoint/@{v[[{5,10}]],v[[{1,6}]],v[[{2,7}]],v[[{4,9}]],v[[{12,13}]]}];
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{1,5},{1,2},{2,3},{3,4},{4,5},{12,16},{13,16},{6,10},{11,16},{3,8},{7,14},{2,14},{4,15},{9,15},{8,9},{7,8},{6,7},{9,10},{5,12},{10,12},{1,13},{6,13},{11,14},{11,15}}],VertexCoordinates->v,VertexLabels->"Name"]

CubicGraphQ[g]

r=RecognizeGraph[g]

Degenerate

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

Planar

GraphData["SecondapexGraph","Planar"]

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

MinimalCrossing

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

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

MinimalRectiinearCrossing crossing

CrossingNumber[GraphData["SecondapexGraph"],TimeConstraint->10]//AbsoluteTiming

CrossingNumber[GraphData["SecondapexGraph"],TimeConstraint->60]//AbsoluteTiming

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["SecondapexGraph"],"CrossingNumber"->2],4Pi/5]

e[l__]:=Sequence@@Partition[{l},2,1];
v={{-2,0},{10,0},{1,1},{4,1},{7,1},{1,2},{3,2},{4,2},{5,2},{7,2},{2,3},{3,3},{5,3},{6,3},{4,4},{4,6}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,14,15,11,1,3,4,5,10,9,8,7,6,3],e[6,16,10],{15,16},e[11,12,13,14],{7,12},{9,13},{4,8},{2,5}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

MinimalRectiinearCrossing crossing 2

mc2=VertexDelete[mc,Range[17,18]]

d=VertexDegree[mc2]

Length[sub=Select[Subsets[Subsets[{1,5,11,11,12,13,14,15},{2}],{4}],Intersection[EdgeList[mc2],#]==={}&]]

gs=SetProperty[EdgeAdd[mc2,UndirectedEdge@@@#],{VertexLabels->None,VertexCoordinates->Take[GraphEmbedding[mc],16]}]&/@sub;

SelectFirst[gs,IsomorphicGraphQ[#,GraphData["SecondapexGraph"]]&]

GraphPlot[%]

v={{0,0},{1,0},{1,3/7},{1,1},{0,1},{1/5,3/7},{2/5,3/2 1/7},{2/5,2/7},{2/5,4/7},{2/5,6/7},{3/5,2/7},{3/5,3/7},{3/5,4/7},{3/5,5/7},{4/5,3/2 1/7},{3/5,6/7}};
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[Sort/@{{1,2},{2,3},{3,4},{4,5},{1,5},{2,15},{1,11},{5,6},{6,10},{6,7},{7,8},{8,9},{9,10},{11,12},{12,13},{13,14},{8,11},{9,13},{10,16},{4,16},{3,12},{7,15},{14,16},{14,15}}],VertexLabels->"Name",VertexCoordinates->v]

r=RecognizeGraph[g]

rcn=RectilinearCrossingCount@g

vs=ToCommonEdges[g,GraphData[r]]

Circulant

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

Halin

GraphData["SecondapexGraph","Halin"]

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

LCF

GraphData["SecondapexGraph","LCF"]

GraphData["SecondapexGraph","LCFSignature"]

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

LCF compute

Length[FindHamiltonianCycle[GraphData["SecondapexGraph"],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData["SecondapexGraph"],All])[[All,2]]]

gs=LCFGraph@@@lcf

UnitDistance

GraphData["SecondapexGraph","UnitDistance"]

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

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

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

Select[UnitDistanceEmbeddingRefine/@Complement@@(GraphData["SecondapexGraph","Graph",#]&/@{"All","UnitDistance"}),UnitDistanceGraphEmbeddingQ]

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

UnitDistance exact construction

UnitDistanceEmbeddingRefine@GraphicsToGraph@

GraphData["SecondapexGraph","Graphics","All"][[2]]

soln=NSolve[{
a^2+(h+1-b)^2==1,
(x-a)^2+(y-b)^2==1,
x^2+(y-1)^2==1,
(x-c)^2+(y-d)^2==1,
c^2+(d-h)^2==1,
(c-1/2)^2+(d-e)^2==1,
(a-1/2)^2+(b-f)^2==1,
u^2+v^2==1,
(1/2+u)^2+(e-v)^2==1,
(u+1/2)^2+(v-f)^2==1},{h,x,y,a,b,c,d,e,f,u,v},Reals]

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs={,,}

Matchstick

GraphData["SecondapexGraph","Matchstick"]

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

3D default

Graph3D[GraphData["SecondapexGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["SecondapexGraph","Polyhedral"]

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

"ThirdapexGraph"

GraphData["ThirdapexGraph","StandardName"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["ThirdapexGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Robertson et al. 2019

v=Join[CirclePoints[5],CirclePoints[1/2,5],{{0,0}},Midpoint/@{v[[{5,10}]],v[[{1,6}]],v[[{8,9}]],v[[{2,3}]],v[[{12,13}]]}];
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{1,5},{1,2},{2,15},{3,15},{3,4},{4,5},{12,16},{13,16},{6,10},{11,16},{3,8},{8,14},{9,14},{7,8},{6,7},{9,10},{5,12},{10,12},{1,13},{6,13},{11,14},{11,15},{4,9},{2,7}}],VertexCoordinates->v,VertexLabels->"Name"]

CubicGraphQ[g]

RecognizeGraph[g]

Bilateral

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

Circular

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

Planar

GraphData["ThirdapexGraph","Planar"]

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

MinimalCrossing

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

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

MinimalRectilinearCrossing

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

CrossingNumber[GraphData["ThirdapexGraph"],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData["ThirdapexGraph"],"CrossingNumber"->cn]]

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

mc=MinimalCrossingGraph[GraphData["ThirdapexGraph"],"CrossingNumber"->3]

mc2=VertexDelete[mc,Range[17,18]]

d=VertexDegree[mc2]

Length[sub=Select[Subsets[Subsets[{6,7,8,10,11,11,15,16},{2}],{4}],Intersection[EdgeList[mc2],#]==={}&]]

gs=SetProperty[EdgeAdd[mc2,UndirectedEdge@@@#],{VertexLabels->None,VertexCoordinates->Take[GraphEmbedding[mc],16]}]&/@sub;

SelectFirst[gs,IsomorphicGraphQ[#,GraphData["ThirdapexGraph"]]&]

GraphPlot[%]

v={{0,0},{5/6,0},{1,0},{1,1},{1/2,1},{0,1},{1/6,1/8},{2/6,1/8},{5/6,1/8},{1/6,5/8},{2/6,5/8},Sequence@@Table[{i/6,3/4},{i,5}]};
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[Sort/@{{1,2},{2,3},{3,4},{4,5},{5,6},{1,6},{1,7},{7,8},{8,9},{7,10},{10,12},{12,13},{13,14},{14,15},{15,16},{10,15},{2,9},{9,16},{8,11},{11,13},{3,11},{6,12},{5,14},{4,16}}],VertexLabels->"Name",VertexCoordinates->v]

r=RecognizeGraph[g]

rcn=RectilinearCrossingCount@g

vs=ToCommonEdges[g,GraphData[r]]

Circulant

GraphData["ThirdapexGraph","Circulant"]

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

Halin

GraphData["ThirdapexGraph","Halin"]

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

LCF

GraphData["ThirdapexGraph","LCF"]

GraphData["ThirdapexGraph","LCFSignature"]

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

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

LCF compute

Length[FindHamiltonianCycle[GraphData["ThirdapexGraph"],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData["ThirdapexGraph"],All])[[All,2]]]//Timing

gs=LCFGraph@@@lcf//StyleGraphs

gs=Join[With[{g=BilateralLCFEmbedding[#]},If[MissingQ[g],#,g]]&/@LCFGraph@@@DeleteCases[lcf,{_,1}],DeleteMissing[BilateralLCFEmbedding/@LCFGraph@@@Cases[lcf,{_,1}]]]

UnitDistance

GraphData["ThirdapexGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["ThirdapexGraph","VertexList"],GraphData["ThirdapexGraph","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

UnitDistanceEmbeddingRefine/@Complement@@(GraphData["ThirdapexGraph","Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

FindUnitDistanceEmbedding[GraphData["ThirdapexGraph"],MaxIterations->50000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

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

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

gs={,,,,,,,,,,,,,,}

Matchstick

GraphData["ThirdapexGraph","Matchstick"]

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

3D default

Graph3D[GraphData["ThirdapexGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["ThirdapexGraph","Polyhedral"]

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

"FourthapexGraph"

GraphData["FourthapexGraph","StandardName"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["FourthapexGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["FourthapexGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

CrossingNumber[GraphData["FourthapexGraph"],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData["FourthapexGraph"],"CrossingNumber"->cn]]

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["FourthapexGraph","Circulant"]

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

Halin

GraphData["FourthapexGraph","Halin"]

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

LCF

GraphData["FourthapexGraph","LCF"]

GraphData["FourthapexGraph","LCFSignature"]

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

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

LCF compute

Length[FindHamiltonianCycle[GraphData["FourthapexGraph"],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData["FourthapexGraph"],All])[[All,2]]]//Timing

gs=LCFGraph@@@lcf//StyleGraphs

gs=Join[With[{g=BilateralLCFEmbedding[#]},If[MissingQ[g],#,g]]&/@LCFGraph@@@DeleteCases[lcf,{_,1}],DeleteMissing[BilateralLCFEmbedding/@LCFGraph@@@Cases[lcf,{_,1}]]]

UnitDistance

GraphData["FourthapexGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["FourthapexGraph","VertexList"],GraphData["FourthapexGraph","EdgeList"]]]

UnitDistanceGraphEmbeddingQ[%]

UnitDistanceEmbeddingRefine/@Complement@@(GraphData["FourthapexGraph","Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

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

FindUnitDistanceEmbedding[GraphData["FourthapexGraph"],MaxIterations->50000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

Print[{#,TimeConstrained[FindSubgraphUnitDistanceEmbedding[GraphData[#],"Results"->All,Debug->Full],86400]//Timing}]&/@todo;

gs={,,,,,,,,,,,,}

Matchstick

GraphData["FourthapexGraph","Matchstick"]

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

3D default

Graph3D[GraphData["FourthapexGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["FourthapexGraph","Polyhedral"]

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

Construction

"FirstapexGraph"

Robertson et al. 2019

v=GraphEmbedding[GraphData[{"Prism",6}]];
g=EdgeAdd[SetProperty[VertexAdd[g0=EdgeDelete[GraphData[{"Prism",6},"Graph","Labeled"],{1\[UndirectedEdge]7,3\[UndirectedEdge]9,5\[UndirectedEdge]11}],Range[13,16]],VertexCoordinates->Join[v,Mean/@{v[[{1,7}]],v[[{3,9}]],v[[{5,11}]]},{{0,0}}]],UndirectedEdge@@@{{5,15},{11,15},{3,14},{9,14},{7,13},{1,13},{15,16},{14,16},{13,16}}]

RecognizeGraph[g]

CubicGraphQ[g]

MinimalRectilinearCrossing by hand

GraphPlot[GraphData["FirstapexGraph","Edges"]]

v={{0,0},{1,0},{1,1},{4/5,1},{3/5,1},{0,1},{4/5,1/6},{4/5,2/6},{4/5,3/6},{4/5,4/6},{4/5,5/6},{3/5,4/6},{3/5,5/6},{2/5,2/6},{2/5,5/6},{1/5,5/6}};
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[Sort/@{Sequence@@Partition[Range[6],2,1,1],{5,13},{4,11},{7,8},{8,9},{9,10},{10,11},{15,16},{13,15},{10,13},{11,12},{8,14},{14,15},{1,14},{2,7},{12,16},{7,12},{3,9},{6,16}}],VertexLabels->"Name",VertexCoordinates->v]

VertexDegree[g]

r=RecognizeGraph[g]

rcn=RectilinearCrossingCount@g

GraphData[r,"CN"]

vs=ToCommonEdges[g,GraphData[r]]

MinimalRectilinearCrossing via Planarization

mc=MinimalCrossingGraph[GraphData["FirstapexGraph"],"CrossingNumber"->3]

mc2=VertexDelete[mc,Range[17,19]]

d=VertexDegree[mc2]

add=Flatten[MapIndexed[ConstantArray[#2[[1]],#]&,3-d]]

Length[sub=Select[Subsets[Subsets[add,{2}],{Length[add]/2}],Intersection[#,List@@@EdgeList[mc2]]==={}&]]

gs=SetProperty[EdgeAdd[mc2,UndirectedEdge@@@#],{VertexLabels->None,VertexCoordinates->Take[GraphEmbedding[mc],16]}]&/@sub

Select[gs,IsomorphicGraphQ[#,GraphData["SuperboxGraph"]]&]

GraphPlot[%[[1]]]

Rotate[,-.5]

v=Join[CirclePoints[6],Table[v[[5]]+(v[[2]]-v[[5]])i/3,{i,2}],Table[v[[7]]+{0,(v[[4,2]]-v[[7,2]])/3}+i(v[[8]]-v[[7]])/4,{i,0,4}],
Table[v[[7]]+{0,(v[[4,2]]-v[[7,2]])2/3}+i(v[[8]]-v[[7]])/2,{i,0,2}]];
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[Sort/@{{1,6},{1,2},{2,3},{3,4},{4,5},{5,7},{7,8},{2,8},{5,6},{6,10},{1,12},{7,9},{9,14},{14,15},{15,16},{13,16},{8,13},{11,15},{9,10},{10,11},{11,12},{12,13},{4,14},{3,16}}],VertexLabels->"Name",VertexCoordinates->v]

r=RecognizeGraph[g]

rcn=RectilinearCrossingCount@g

vs=ToCommonEdges[g,GraphData[r]]

"FourthapexGraph"

Robertson et al. 2019

v=Join[CirclePoints[5],CirclePoints[1/2,5],{{0,0}},Midpoint/@{v[[{5,10}]],v[[{1,6}]],v[[{9,10}]],v[[{8,3}]],v[[{12,13}]]}];
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[{{1,5},{1,2},{2,3},{3,15},{3,4},{4,5},{12,16},{13,16},{6,10},{11,16},{8,9},{9,14},{7,8},{6,7},{5,12},{10,12},{1,13},{6,13},{11,14},{4,9},{2,7},{10,14},{8,15},{11,15}}],VertexCoordinates->v,VertexLabels->"Name"]

CubicGraphQ[g]

RecognizeGraph[g]

MinimalRectilinearCrossing

mc=MinimalCrossingGraph[GraphData["FourthapexGraph"],"CrossingNumber"->3]

mc2=VertexDelete[mc,Range[17,18]]

d=VertexDegree[mc2]

add=Flatten[MapIndexed[Table[#2[[1]],#]&,3-d]]

Length[sub=Select[Subsets[Subsets[add,{2}],{Length[add]/2}],Intersection[EdgeList[mc2],#]==={}&]]

gs=SetProperty[EdgeAdd[mc2,UndirectedEdge@@@#],{VertexLabels->None,VertexCoordinates->Take[GraphEmbedding[mc],16]}]&/@sub;

SelectFirst[gs,IsomorphicGraphQ[#,GraphData["FourthapexGraph"]]&]

GraphPlot[%]

v={{0,0},{4/6,0},{1,0},{1,1},{2/6,1},{0,1},{1/6,1/5},{5/6,1/5},{2/6,2/5},{3/6,2/5},{4/6,2/5},{5/6,2/5},{2/6,3/5},{2/6,4/5},{3/6,4/5},{5/6,4/5}};
g=Graph[Range[Length[v]],UndirectedEdge@@@Sort[Sort/@{{1,2},{2,3},{3,4},{4,5},{5,6},{1,6},{1,7},{2,11},{8,12},{12,16},{14,15},{15,16},{5,14},{13,14},{9,13},{9,10},{10,11},{11,12},{7,13},{6,9},{7,8},{3,8},{10,15},{4,16}}],VertexLabels->"Name",VertexCoordinates->v]

VertexDegree[g]

r=RecognizeGraph[g]

rcn=RectilinearCrossingCount@g

vs=ToCommonEdges[g,GraphData[r]]