Transmission-Minimal Regular Graph

Author

Eric W. Weisstein
May 20, 2026

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/Transmission-MinimalRegularGraph.nb.

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

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

Cubic graphs

Some quartic graphs with minimum transmission appear to be smallest crossing number graphs.  As observed by Thomas Rokicki and communicated by Ed Pegg, Jr., on May 8, 2026.

SmallestCubicCrossingGraphs

SmallestCubicCrossingGraphs=Select[
GraphData[All],
MatchQ[GraphData[#,"StandardNames"],{___,{"SmallestCubicCrossing",_},___}]&
];

TextGrid[
Union[GraphData[#,{"CrossingNumber","V"}]&/@SmallestCubicCrossingGraphs],
Dividers->All,Alignment->Decimal
]

SmallestTransmissionCubicGraphs[n_]:=Module[
{
data=GraphData[#,{"#","Transmission"}]&/@GraphData["Cubic",n],
min
},
min=Min[data[[All,2]]];
Cases[data,{gn_,min}:>gn]
]

TextGrid[
DeleteCases[
Table[
{
n,
GraphData["SmallestCubicCrossing",n],
SmallestTransmissionCubicGraphs[n]
},{n,16}],
{_,{},{}}
],
Dividers->All]

Compute

ssh byblis65
cd ~/mma/Graphs/Nodes/TransmissionMinimalRegular
nice +10 ~/codex/bin/smallest_regular_mean_distance --degree 3 --jobs 16 --g6-dir Cubic/ 28

Would need ~ 3 CPU months to complete

Values

TransmissionMinimalGraphFiles3=FileNames["*.g6",FileNameJoin[{$GraphDataDirectory,"Nodes","TransmissionMinimalRegular","Cubic"}]]

TransmissionMinimalGraphData3={
ToExpression[StringTake[FileBaseName[file=#],-2]],
gs=Import[#,{"Graph6","GraphList"}],
Transmission/@gs
}&/@TransmissionMinimalGraphFiles3;//AbsoluteTiming

Knor, M.; \v Skrekovski, R.; and Tepeh, A.  ``Chemical Graphs with the Minimum Value of Wiener Index.'' {\it MATCH Commun.\ Math.\ Comput.\ Chem.} {\bf 81}, 119--132, 2019.  \url{https://match.pmf.kg.ac.rs/electronic_versions/Match81/n1/match81n1_119-132.pdf

TransmissionMinimalGraphTable3={#,Length[#2],#3[[1]],RecognizeGraph/@#2,#2}&@@@TransmissionMinimalGraphData3;

TextGrid[
Prepend[
Most/@TransmissionMinimalGraphTable3,
Thread[Style[{"V","count","T","graphs"},Italic]]
],
Dividers->{All,{True,Thick,{True}}},
Alignment->{{Decimal,Decimal,Decimal,{Left}}}
]

Minimal transmission for cubic graphs on 2n vertices :

A395986

TransmissionMinimalGraphTable3[[All,3]]

Number of transmission-minimal cubic graphs on 2n vertices:

A395987

TransmissionMinimalGraphTable3[[All,2]]

TextGrid[
With[{gs=Import[#,{"Graph6","GraphList"}]},
{
VertexCount[gs[[1]]],
r=RecognizeGraph/@gs,
cn=GraphData[#,"CrossingNumber"]&/@r
}
]&/@files,
Dividers->All]

AddIndexedClass

graphrules=DeleteCases[
Flatten[
Function[line,Thread[line[[-1]]->({line[[1]],#}&/@Range[Length[line[[-1]]]])]]/@TransmissionMinimalGraphTable3,
1],
HoldPattern[{}->_]
]

rules=graphrules/.g_Graph:>RecognizeGraph[g]

AddIndexedClass["TransmissionMinimalCubic",rules,"15.1"]

RenameGraphFiles[]

Quartic graphs

Some quartic graphs with minimum transmission appear to be smallest crossing number graphs.  As observed by Thomas Rokicki and communicated by Ed Pegg, Jr., on May 8, 2026.

SmallestQuarticCrossingGraphs

SmallestQuarticCrossingGraphs=Select[
GraphData[All],
MatchQ[GraphData[#,"StandardNames"],{___,{"SmallestQuarticCrossing",_},___}]&
];

TextGrid[
Union[GraphData[#,{"CrossingNumber","V"}]&/@SmallestQuarticCrossingGraphs],
Dividers->All,Alignment->Decimal
]

SmallestTransmissionQuarticGraphs[n_]:=Module[
{
data=GraphData[#,{"#","Transmission"}]&/@GraphData["Quartic",n],
min
},
min=Min[data[[All,2]]];
Cases[data,{gn_,min}:>gn]
]

TextGrid[
DeleteCases[
Table[
{
n,
GraphData["SmallestQuarticCrossing",n],
SmallestTransmissionQuarticGraphs[n]
},{n,16}],
{_,{},{}}
],
Dividers->All]

Compute

ssh byblis65
cd ~/mma/Graphs/Nodes/TransmissionMinimalRegular
nice +15 ~/codex/bin/smallest_regular_mean_distance --degree 4 --jobs 12 --g6-dir Quartic/ 20 &

(would take 200+ CPU-days)

Values

TransmissionMinimalGraphFiles4=FileNames["*.g6",FileNameJoin[{$GraphDataDirectory,"Nodes","TransmissionMinimalRegular","Quartic"}]]

TransmissionMinimalGraphData4={
ToExpression[StringTake[FileBaseName[file=#],-2]],
gs=Import[#,{"Graph6","GraphList"}],
Transmission/@gs
}&/@TransmissionMinimalGraphFiles4;//AbsoluteTiming

Knor, M.; \v Skrekovski, R.; and Tepeh, A.  ``Chemical Graphs with the Minimum Value of Wiener Index.'' {\it MATCH Commun.\ Math.\ Comput.\ Chem.} {\bf 81}, 119--132, 2019.  \url{https://match.pmf.kg.ac.rs/electronic_versions/Match81/n1/match81n1_119-132.pdf

TransmissionMinimalGraphTable4={#,Length[#2],#3[[1]],RecognizeGraph/@#2,#2}&@@@TransmissionMinimalGraphData4;

TextGrid[
Prepend[
Most/@TransmissionMinimalGraphTable4,
Thread[Style[{"V","count","T","graphs"},Italic]]
],
Dividers->{All,{True,Thick,{True}}},
Alignment->{{Decimal,Decimal,Decimal,{Left}}}
]

Minimal transmission for quartic graphs on n vertices :

A395988

TransmissionMinimalGraphTable4[[All,3]]

Number of transmission-minimal quartic graphs on n vertices:

A395989

TransmissionMinimalGraphTable4[[All,2]]

TextGrid[
With[{gs=Import[#,{"Graph6","GraphList"}]},
{
VertexCount[gs[[1]]],
r=RecognizeGraph/@gs,
cn=If[#==={},Missing["NotAvailable"],GraphData[#,"CrossingNumber"]]&/@r
}
]&/@files,
Dividers->All]

AddIndexedClass

rules=DeleteCases[
Flatten[
Function[line,Thread[line[[-1]]->({line[[1]],#}&/@Range[Length[line[[-1]]]])]]/@TransmissionMinimalGraphTable4,
1],
HoldPattern[{}->_]
]

AddIndexedClass["TransmissionMinimalQuartic",rules,"15.1"]

RenameGraphFiles[]

n=17

Slightly wrong n=17 (almost but not quite) minimum transmission from Ed Pegg, May 8, 2026

These have transmission 250; actual minimum is 247

gs17=ImportString[#,"Graph6"]&/@{"Ps`aaOaG?gAIB?AM?QOAP?Hc","Ps`aa?gG_gAKB?AU?WO@P?Dc","Ps`aa?gGOgAGB@AE?SgCc?YC","Ps`aa?gGOgAKAcAQ?_oCB?MC","Ps`aa?hG_aAGAEAD?`GGK?gK","Ps`aa?aGOgAGBCA`@L?@K?ES","Ps`aa?`G?gAGB@Ag@J?Dc?FO"}

QuarticGraphQ/@gs17

Transmission/@gs17

VertexCount/@gs17

Print[{#,CrossingNumber[#,Method->"WebCompute"]//AbsoluteTiming}]&/@gs17;

Correct n=17 minimum transmission computed by Eric Weisstein, May 12, 2026

Import["/Users/eww/codex/bin/outfiles/smallest_regular_mean_distance_d4_17.g6",{"Graph6","GraphList"}]

Print[{#,CrossingNumber[#,Method->"WebCompute"]//AbsoluteTiming}]&/@Import[files[[-1]],{"Graph6","GraphList"}];

Embeddings

<<MathWorld`Graphs`

GraphData["TransmissionMinimal*"]

{"TransmissionMinimalCubic", {26, 1}} == {"SmallestCubicCrossing", {9, 1}}

Names

GraphData[{"TransmissionMinimalCubic",{26,1}},"StandardName"]

GraphData[{"TransmissionMinimalCubic",{26,1}},"StandardNames"]

{"TransmissionMinimalCubic", {26, 2}} == {"GeneralizedPetersen", {13, 5}}

Names

GraphData[{"TransmissionMinimalCubic",{26,2}},"StandardName"]

GraphData[{"TransmissionMinimalCubic",{26,2}},"StandardNames"]

{"TransmissionMinimalQuartic", {17, 1}}

Names

GraphData[{"TransmissionMinimalQuartic",{17,1}},"StandardName"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"StandardNames"]

HouseOfGraphs

hogid=GraphData[{"TransmissionMinimalQuartic",{17,1}},"NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData[{"TransmissionMinimalQuartic",{17,1}},"WikidataID"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"WikidataID","URL"]

Primary

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

All

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","All"]//StyleGraphs

CurvedEdge

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData[{"TransmissionMinimalQuartic",{17,1}}]]

Default embedding

g0=GraphPlot[Graph[GraphData[{"TransmissionMinimalQuartic",{17,1}},"VertexList"],GraphData[{"TransmissionMinimalQuartic",{17,1}},"Edges"]]]

GeneralizedPetersen

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","IGraph"]//StyleGraphs

CompleteKPartite

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Bipartite"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Bipartite"]//StyleGraphs

Bilateral

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Bilateral"]//StyleGraphs

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingTypes[#],GraphSymmetryGroup[#]}&/@GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]//Quiet

Circular

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Circular"]//StyleGraphs

Circular construction All

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Hamiltonian"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"LCF"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"LCFSignature"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"HamiltonianCycleCount"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"HamiltonianCycles"]

Planar

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Planar"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Planar"]//StyleGraphs

MinimalCrossingNumber crossings.uos.de [verified 13]

CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],Method->"WebCompute"]//AbsoluteTiming

DateString[]

MinimalCrossingNumber: "EmbeddingScheme" -> 1

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->1,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->1,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->1,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->1,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->1,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->1,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 2

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->2,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->2,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->2,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->2,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->2,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->3,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->3,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->3,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->3,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->3,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData[{"TransmissionMinimalQuartic",{17,1}},"CN"]

(gs=GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"TransmissionMinimalQuartic",{17,1}},"RCN"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalCrossing construction Tutte

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],TimeConstraint->1])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"CrossingNumber"->cn])//PolyhedralGraphQ//AbsoluteTiming

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

TutteGraphs=BilateralGraph[CenterGraph@IGLayoutTutte[g,"OuterFace"->#],"ReturnNonbilateralGraph"->True]&/@faces

TutteGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]])]
}&/@TutteGraphs;

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

LocalCrossingNumberWithEmbeddings=
{1+Max[Length/@DeleteCases[
Drop[AdjacencyList[#],GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]],
_Integer?(LessEqualThan[GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]]),
{2}
]],#}&/@TutteGraphs

TutteGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@TutteGraphs;

SymmetricEmbeddingsWithOrientations=DeleteCases[
TutteGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]

Select[SymmetricEmbeddingsWithOrientations[[All,1]],Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]])]==0&]

MinimalCrossing construction Random 1k [156 s]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],TimeConstraint->1])//AbsoluteTiming

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"TransmissionMinimalQuartic",{17,1}}],
1000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 5k [XXX s]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],TimeConstraint->1])//AbsoluteTiming

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"TransmissionMinimalQuartic",{17,1}}],
5000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 20k [XXX s]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],TimeConstraint->1])//AbsoluteTiming

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"TransmissionMinimalQuartic",{17,1}}],
20*^3,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 1k [old]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k [old]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData[{"TransmissionMinimalQuartic",{17,1}},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData[{"TransmissionMinimalQuartic",{17,1}},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],TimeConstraint->10])//AbsoluteTiming

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,1}}],TimeConstraint->10])//AbsoluteTiming

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Circulant"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"TransmissionMinimalQuartic",{17,1}},"NotationRules","Circulant"]

(ci=CirculantIndices[GraphData[{"TransmissionMinimalQuartic",{17,1}}]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData[{"TransmissionMinimalQuartic",{17,1}},"StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

compl=GraphData[{"TransmissionMinimalQuartic",{17,1}},"ComplementGraph","Name"]

Line graph

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Line"]

LineGraphQ[GraphData[{"TransmissionMinimalQuartic",{17,1}}]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]==={"TransmissionMinimalQuartic",{17,1}}&]

RootGraph[GraphData[{"TransmissionMinimalQuartic",{17,1}}]]

Halin

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Halin"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Rigid"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Flexible"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"TransmissionMinimalQuartic",{17,1}},"LCF"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"HamiltonianCycleCount"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"LCFSignature"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"LCFNotations"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Divisors[GraphData[{"TransmissionMinimalQuartic",{17,1}},"V"]]

Length[FindHamiltonianCycle[GraphData[{"TransmissionMinimalQuartic",{17,1}}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"TransmissionMinimalQuartic",{17,1}}],All])[[All,2]]]//Timing

g=LCFGraph@@lcf[[1]]

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(nicelcfgs=NiceLCFGraphs[lcf,2,1])]//Timing

Length[gs=nicelcfgs]

gs

NiceLCFEmbeddingsWithSymmetryGroups={#,GraphSymmetryGroup[#]}&/@gs;

DeleteCases[NiceLCFEmbeddingsWithSymmetryGroups,{_,TransformationGroup[{Reflection[InfiniteLine[{0,0},{0,-1}]]}]}]

UnitDistance

GraphData[{"TransmissionMinimalQuartic",{17,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"TransmissionMinimalQuartic",{17,1}}],Debug->True]//Timing

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement of default embeddings

Graph[edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"TransmissionMinimalQuartic",{17,1}},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"TransmissionMinimalQuartic",{17,1}},"VertexList"],GraphData[{"TransmissionMinimalQuartic",{17,1}},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph",#]&/@{"All","UnitDistance"})

TextGrid[
gdata=SortBy[
{#,DegenerateGraphEmbeddingQ[#],GraphSymmetryGroup[#],Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
],
Dividers->All
]

Cases[gdata,{__,0.}]

Symmetric:

gs=Cases[
gdata,
{g_,_,sym:Except[TransformationGroup[{}]],diff_}:>{
HighlightGraph[g1=BilateralGraph[CenterGraph[g],"ReturnNonbilateralGraph"->True],Flatten[FindCoincidentVertices[g1]]],
sym,
diff
}]

UnitDistance by refinement of stored LCF embeddings

FileByteCount[file=FileNameJoin[{$PropertiesDir,"LCFNotations-Nice",GraphNameToFileName[{"TransmissionMinimalQuartic",{17,1}},".m.gz"]}]]

Tally[(lcf=Import[file])[[All,-1]]]//Timing//AbsoluteTiming

lcf=LCFNotation/@nicelcfgs;

gs=UnitDistanceEmbeddingRefine[LCFGraph@@#,MaxIterations->500]&/@lcf;//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

NondegenerateSymmetricGraphs=Select[
gdata,
And[
DegenerateGraphEmbeddingQ[#[[1]]]===False,
GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]
]&
]/.g_Graph:>CenterGraph[g]

UnitDistance by FindUnitDistanceEmbedding  (random embeddings returning on messages)

gs=FindUnitDistanceEmbedding[GraphData[{"TransmissionMinimalQuartic",{17,1}}],50,"ReturnWithMessage"->True];//Quiet//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

SymmetricEmebddings=Select[gdata,GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]&]

UnitDistance by FindUnitDistanceEmbedding  (random embedding waiting until UD is found)

FindUnitDistanceEmbedding[GraphData[{"TransmissionMinimalQuartic",{17,1}}],"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{$Version,DateString[]}

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

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

Select[IndexGraph/@gs,!DegenerateGraphEmbeddingQ[#]&&GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]//Timing

Matchstick

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Matchstick"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"TransmissionMinimalQuartic",{17,1}},"Edges"]]

3D construction

3D All

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph",{"3D","All"}]

3D UnitDistance construction Random

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Dimension"]

(g=UnitDistanceEmbeddingRefine[
Graph3D[
GraphData[{"TransmissionMinimalQuartic",{17,1}},"VertexList"],
GraphData[{"TransmissionMinimalQuartic",{17,1}},"EdgeList"]
],
WorkingPrecision->25])//Timing

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Polyhedral"]

GraphData[{"TransmissionMinimalQuartic",{17,1}},"Graph",{"3D","Polyhedron"}]

{"TransmissionMinimalQuartic", {17, 2}}

Names

GraphData[{"TransmissionMinimalQuartic",{17,2}},"StandardName"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"StandardNames"]

HouseOfGraphs

hogid=GraphData[{"TransmissionMinimalQuartic",{17,2}},"NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData[{"TransmissionMinimalQuartic",{17,2}},"WikidataID"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"WikidataID","URL"]

Primary

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

All

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","All"]//StyleGraphs

CurvedEdge

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData[{"TransmissionMinimalQuartic",{17,2}}]]

Default embedding

g0=GraphPlot[Graph[GraphData[{"TransmissionMinimalQuartic",{17,2}},"VertexList"],GraphData[{"TransmissionMinimalQuartic",{17,2}},"Edges"]]]

GeneralizedPetersen

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","IGraph"]//StyleGraphs

CompleteKPartite

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Bipartite"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Bipartite"]//StyleGraphs

Bilateral

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Bilateral"]//StyleGraphs

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingTypes[#],GraphSymmetryGroup[#]}&/@GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]//Quiet

Circular

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Circular"]//StyleGraphs

Circular construction All

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Hamiltonian"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"LCF"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"LCFSignature"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"HamiltonianCycleCount"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"HamiltonianCycles"]

Planar

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Planar"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Planar"]//StyleGraphs

MinimalCrossingNumber crossings.uos.de [verified 13]

CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],Method->"WebCompute"]//AbsoluteTiming

DateString[]

MinimalCrossingNumber: "EmbeddingScheme" -> 1

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->1,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->1,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->1,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->1,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->1,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->1,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 2

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->2,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->2,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->2,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->2,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->2,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->3,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->3,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->3,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->3,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->3,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData[{"TransmissionMinimalQuartic",{17,2}},"CN"]

(gs=GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"TransmissionMinimalQuartic",{17,2}},"RCN"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalCrossing construction Tutte

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],TimeConstraint->1])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"CrossingNumber"->cn])//PolyhedralGraphQ//AbsoluteTiming

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

TutteGraphs=BilateralGraph[CenterGraph@IGLayoutTutte[g,"OuterFace"->#],"ReturnNonbilateralGraph"->True]&/@faces

TutteGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]])]
}&/@TutteGraphs;

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

LocalCrossingNumberWithEmbeddings=
{1+Max[Length/@DeleteCases[
Drop[AdjacencyList[#],GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]],
_Integer?(LessEqualThan[GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]]),
{2}
]],#}&/@TutteGraphs

TutteGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@TutteGraphs;

SymmetricEmbeddingsWithOrientations=DeleteCases[
TutteGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]

Select[SymmetricEmbeddingsWithOrientations[[All,1]],Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]])]==0&]

MinimalCrossing construction Random 1k [XXX s]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],TimeConstraint->1])//AbsoluteTiming

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"TransmissionMinimalQuartic",{17,2}}],
1000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 5k [XXX s]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],TimeConstraint->1])//AbsoluteTiming

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"TransmissionMinimalQuartic",{17,2}}],
5000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 20k [XXX s]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],TimeConstraint->1])//AbsoluteTiming

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"TransmissionMinimalQuartic",{17,2}}],
20*^3,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 1k [old]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k [old]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData[{"TransmissionMinimalQuartic",{17,2}},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData[{"TransmissionMinimalQuartic",{17,2}},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],TimeConstraint->10])//AbsoluteTiming

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{17,2}}],TimeConstraint->10])//AbsoluteTiming

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Circulant"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"TransmissionMinimalQuartic",{17,2}},"NotationRules","Circulant"]

(ci=CirculantIndices[GraphData[{"TransmissionMinimalQuartic",{17,2}}]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData[{"TransmissionMinimalQuartic",{17,2}},"StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

compl=GraphData[{"TransmissionMinimalQuartic",{17,2}},"ComplementGraph","Name"]

Line graph

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Line"]

LineGraphQ[GraphData[{"TransmissionMinimalQuartic",{17,2}}]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]==={"TransmissionMinimalQuartic",{17,2}}&]

RootGraph[GraphData[{"TransmissionMinimalQuartic",{17,2}}]]

Halin

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Halin"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Rigid"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Flexible"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"TransmissionMinimalQuartic",{17,2}},"LCF"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"HamiltonianCycleCount"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"LCFSignature"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"LCFNotations"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Divisors[GraphData[{"TransmissionMinimalQuartic",{17,2}},"V"]]

Length[FindHamiltonianCycle[GraphData[{"TransmissionMinimalQuartic",{17,2}}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"TransmissionMinimalQuartic",{17,2}}],All])[[All,2]]]//Timing

g=LCFGraph@@lcf[[1]]

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(nicelcfgs=NiceLCFGraphs[lcf,2,1])]//Timing

Length[gs=nicelcfgs]

gs

NiceLCFEmbeddingsWithSymmetryGroups={#,GraphSymmetryGroup[#]}&/@gs;

DeleteCases[NiceLCFEmbeddingsWithSymmetryGroups,{_,TransformationGroup[{Reflection[InfiniteLine[{0,0},{0,-1}]]}]}]

UnitDistance

GraphData[{"TransmissionMinimalQuartic",{17,2}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"TransmissionMinimalQuartic",{17,2}}],Debug->True]//Timing

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement of default embeddings

Graph[edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"TransmissionMinimalQuartic",{17,2}},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"TransmissionMinimalQuartic",{17,2}},"VertexList"],GraphData[{"TransmissionMinimalQuartic",{17,2}},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph",#]&/@{"All","UnitDistance"})

TextGrid[
gdata=SortBy[
{#,DegenerateGraphEmbeddingQ[#],GraphSymmetryGroup[#],Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
],
Dividers->All
]

Cases[gdata,{__,0.}]

Symmetric:

gs=Cases[
gdata,
{g_,_,sym:Except[TransformationGroup[{}]],diff_}:>{
HighlightGraph[g1=BilateralGraph[CenterGraph[g],"ReturnNonbilateralGraph"->True],Flatten[FindCoincidentVertices[g1]]],
sym,
diff
}]

UnitDistance by refinement of stored LCF embeddings

FileByteCount[file=FileNameJoin[{$PropertiesDir,"LCFNotations-Nice",GraphNameToFileName[{"TransmissionMinimalQuartic",{17,2}},".m.gz"]}]]

Tally[(lcf=Import[file])[[All,-1]]]//Timing//AbsoluteTiming

lcf=LCFNotation/@nicelcfgs;

gs=UnitDistanceEmbeddingRefine[LCFGraph@@#,MaxIterations->500]&/@lcf;//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

NondegenerateSymmetricGraphs=Select[
gdata,
And[
DegenerateGraphEmbeddingQ[#[[1]]]===False,
GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]
]&
]/.g_Graph:>CenterGraph[g]

UnitDistance by FindUnitDistanceEmbedding  (random embeddings returning on messages)

gs=FindUnitDistanceEmbedding[GraphData[{"TransmissionMinimalQuartic",{17,2}}],50,"ReturnWithMessage"->True];//Quiet//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

SymmetricEmebddings=Select[gdata,GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]&]

UnitDistance by FindUnitDistanceEmbedding  (random embedding waiting until UD is found)

FindUnitDistanceEmbedding[GraphData[{"TransmissionMinimalQuartic",{17,2}}],"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{$Version,DateString[]}

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

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

Select[IndexGraph/@gs,!DegenerateGraphEmbeddingQ[#]&&GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]//Timing

Matchstick

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Matchstick"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"TransmissionMinimalQuartic",{17,2}},"Edges"]]

3D construction

3D All

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph",{"3D","All"}]

3D UnitDistance construction Random

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Dimension"]

(g=UnitDistanceEmbeddingRefine[
Graph3D[
GraphData[{"TransmissionMinimalQuartic",{17,2}},"VertexList"],
GraphData[{"TransmissionMinimalQuartic",{17,2}},"EdgeList"]
],
WorkingPrecision->25])//Timing

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Polyhedral"]

GraphData[{"TransmissionMinimalQuartic",{17,2}},"Graph",{"3D","Polyhedron"}]

{"TransmissionMinimalQuartic", {18, 1}}

Names

GraphData[{"TransmissionMinimalQuartic",{18,1}},"StandardName"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"StandardNames"]

HouseOfGraphs

hogid=GraphData[{"TransmissionMinimalQuartic",{18,1}},"NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData[{"TransmissionMinimalQuartic",{18,1}},"WikidataID"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"WikidataID","URL"]

Primary

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

All

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","All"]//StyleGraphs

CurvedEdge

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData[{"TransmissionMinimalQuartic",{18,1}}]]

Default embedding

g0=GraphPlot[Graph[GraphData[{"TransmissionMinimalQuartic",{18,1}},"VertexList"],GraphData[{"TransmissionMinimalQuartic",{18,1}},"Edges"]]]

GeneralizedPetersen

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","IGraph"]//StyleGraphs

CompleteKPartite

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Bipartite"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Bipartite"]//StyleGraphs

Bilateral

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Bilateral"]//StyleGraphs

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingTypes[#],GraphSymmetryGroup[#]}&/@GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]//Quiet

Circular

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Circular"]//StyleGraphs

Circular construction All

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Hamiltonian"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"LCF"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"LCFSignature"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"HamiltonianCycleCount"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"HamiltonianCycles"]

Planar

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Planar"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Planar"]//StyleGraphs

MinimalCrossingNumber crossings.uos.de [verified 15]

CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],Method->"WebCompute"]//AbsoluteTiming

DateString[]

MinimalCrossingNumber: "EmbeddingScheme" -> 1

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->1,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->1,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->1,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->1,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->1,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->1,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 2

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->2,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->2,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->2,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->2,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->2,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->3,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->3,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->3,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->3,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->3,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData[{"TransmissionMinimalQuartic",{18,1}},"CN"]

(gs=GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"TransmissionMinimalQuartic",{18,1}},"RCN"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalCrossing construction Tutte

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],TimeConstraint->1])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"CrossingNumber"->cn])//PolyhedralGraphQ//AbsoluteTiming

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

TutteGraphs=BilateralGraph[CenterGraph@IGLayoutTutte[g,"OuterFace"->#],"ReturnNonbilateralGraph"->True]&/@faces

TutteGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]])]
}&/@TutteGraphs;

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

LocalCrossingNumberWithEmbeddings=
{1+Max[Length/@DeleteCases[
Drop[AdjacencyList[#],GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]],
_Integer?(LessEqualThan[GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]]),
{2}
]],#}&/@TutteGraphs

TutteGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@TutteGraphs;

SymmetricEmbeddingsWithOrientations=DeleteCases[
TutteGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]

Select[SymmetricEmbeddingsWithOrientations[[All,1]],Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]])]==0&]

MinimalCrossing construction Random 1k [164 s]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],TimeConstraint->1])//AbsoluteTiming

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"TransmissionMinimalQuartic",{18,1}}],
1000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

diagrams1

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 5k [914 s]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],TimeConstraint->1])//AbsoluteTiming

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"TransmissionMinimalQuartic",{18,1}}],
5000,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 20k [XXX s]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],TimeConstraint->1])//AbsoluteTiming

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"TransmissionMinimalQuartic",{18,1}}],
20*^3,
"CrossingNumber"->cn,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

Take[Lookup[diagrams,"Graph"],10]

g=;

GraphCrossingCount@g

GraphCrossingDiagram@g

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph",{}]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph",{}]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 1k [old]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k [old]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData[{"TransmissionMinimalQuartic",{18,1}},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData[{"TransmissionMinimalQuartic",{18,1}},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],TimeConstraint->10])//AbsoluteTiming

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

(cn=CrossingNumber[GraphData[{"TransmissionMinimalQuartic",{18,1}}],TimeConstraint->10])//AbsoluteTiming

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Circulant"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"TransmissionMinimalQuartic",{18,1}},"NotationRules","Circulant"]

(ci=CirculantIndices[GraphData[{"TransmissionMinimalQuartic",{18,1}}]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData[{"TransmissionMinimalQuartic",{18,1}},"StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

compl=GraphData[{"TransmissionMinimalQuartic",{18,1}},"ComplementGraph","Name"]

Line graph

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Line"]

LineGraphQ[GraphData[{"TransmissionMinimalQuartic",{18,1}}]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]==={"TransmissionMinimalQuartic",{18,1}}&]

RootGraph[GraphData[{"TransmissionMinimalQuartic",{18,1}}]]

Halin

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Halin"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Rigid"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Flexible"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"TransmissionMinimalQuartic",{18,1}},"LCF"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"HamiltonianCycleCount"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"LCFSignature"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"LCFNotations"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","LCF"]//StyleGraphs

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

LCF compute all

Divisors[GraphData[{"TransmissionMinimalQuartic",{18,1}},"V"]]

Length[FindHamiltonianCycle[GraphData[{"TransmissionMinimalQuartic",{18,1}}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"TransmissionMinimalQuartic",{18,1}}],All])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(nicelcfgs=NiceLCFGraphs[lcf,2,1])]//Timing

Length[gs=nicelcfgs]

gs

NiceLCFEmbeddingsWithSymmetryGroups={#,GraphSymmetryGroup[#]}&/@gs;

DeleteCases[NiceLCFEmbeddingsWithSymmetryGroups,{_,TransformationGroup[{Reflection[InfiniteLine[{0,0},{0,-1}]]}]}]

UnitDistance

GraphData[{"TransmissionMinimalQuartic",{18,1}},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"TransmissionMinimalQuartic",{18,1}}],Debug->True]//Timing

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement of default embeddings

Graph[edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"TransmissionMinimalQuartic",{18,1}},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"TransmissionMinimalQuartic",{18,1}},"VertexList"],GraphData[{"TransmissionMinimalQuartic",{18,1}},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph",#]&/@{"All","UnitDistance"})

TextGrid[
gdata=SortBy[
{#,DegenerateGraphEmbeddingQ[#],GraphSymmetryGroup[#],Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
],
Dividers->All
]

Cases[gdata,{__,0.}]

Symmetric:

gs=Cases[
gdata,
{g_,_,sym:Except[TransformationGroup[{}]],diff_}:>{
HighlightGraph[g1=BilateralGraph[CenterGraph[g],"ReturnNonbilateralGraph"->True],Flatten[FindCoincidentVertices[g1]]],
sym,
diff
}]

UnitDistance by refinement of stored LCF embeddings

FileByteCount[file=FileNameJoin[{$PropertiesDir,"LCFNotations-Nice",GraphNameToFileName[{"TransmissionMinimalQuartic",{18,1}},".m.gz"]}]]

Tally[(lcf=Import[file])[[All,-1]]]//Timing//AbsoluteTiming

lcf=LCFNotation/@nicelcfgs;

gs=UnitDistanceEmbeddingRefine[LCFGraph@@#,MaxIterations->500]&/@lcf;//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

NondegenerateSymmetricGraphs=Select[
gdata,
And[
DegenerateGraphEmbeddingQ[#[[1]]]===False,
GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]
]&
]/.g_Graph:>CenterGraph[g]

UnitDistance by FindUnitDistanceEmbedding  (random embeddings returning on messages)

gs=FindUnitDistanceEmbedding[GraphData[{"TransmissionMinimalQuartic",{18,1}}],50,"ReturnWithMessage"->True];//Quiet//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

SymmetricEmebddings=Select[gdata,GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]&]

UnitDistance by FindUnitDistanceEmbedding  (random embedding waiting until UD is found)

FindUnitDistanceEmbedding[GraphData[{"TransmissionMinimalQuartic",{18,1}}],"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{$Version,DateString[]}

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

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

Select[IndexGraph/@gs,!DegenerateGraphEmbeddingQ[#]&&GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]//Timing

Matchstick

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Matchstick"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"TransmissionMinimalQuartic",{18,1}},"Edges"]]

3D construction

3D All

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph",{"3D","All"}]

3D UnitDistance construction Random

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Dimension"]

(g=UnitDistanceEmbeddingRefine[
Graph3D[
GraphData[{"TransmissionMinimalQuartic",{18,1}},"VertexList"],
GraphData[{"TransmissionMinimalQuartic",{18,1}},"EdgeList"]
],
WorkingPrecision->25])//Timing

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Polyhedral"]

GraphData[{"TransmissionMinimalQuartic",{18,1}},"Graph",{"3D","Polyhedron"}]

GraphData

GraphDataString

<<MathWorld`Graphs`

data=Flatten[
Function[line,Thread[Transpose[{line[[-2]],line[[-1]]}]->({line[[1]],#}&/@Range[Length[line[[-2]]]])]]/@TransmissionMinimalGraphTable4,
1]

new=Cases[data,HoldPattern[{{},g_}->i_]:>{g,i}]

new={{,{17,1}},{,{17,2}},{,{18,1}}};

outfile=OpenWrite["~/TransmissionMinimalQuartic.m"]

WriteString[
outfile,
GraphDataString[
#,
"StandardName"->{"TransmissionMinimalQuartic",#2},
"Name"->StringJoin[ToString/@{#2[[1]],"\[Hyphen]transmission\[Hyphen]minimal graph ",#2[[2]]}],
"Classes"->{"TransmissionMinimalQuartic"},
"NotationRules"->{"TransmissionMinimalQuartic"->#2},
"Information"->"Transmission-MinimalRegularGraph"
]
]&@@@new;

Close[file]