Chang Graphs

Author

Eric W. Weisstein
July 22, 2026

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

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

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

Figure

Chang graphs

Import["http://upload.wikimedia.org/wikipedia/commons/0/04/Chang_graphs.svg"]

ringCoordinates = Join[
	CirclePoints[{1, Pi/8}, 8],
	CirclePoints[{(1/(Sqrt[1+(1/(Sqrt[2]))])), 0}, 8],
	CirclePoints[{Sqrt[2]-1, Pi/8}, 8],
	ConstantArray[{0, 0}, 4]
];

svgOrder = {
	6, 14, 21, 25, 24, 16, 7, 5, 13, 20, 26, 23, 15, 4,
	12, 19, 27, 22, 3, 11, 18, 28, 2, 10, 17, 1, 9, 8
};

changVertexCoordinates = ringCoordinates[[svgOrder]];

vertices = Subsets[Range[8], {2}];

switchingSets = {
	Sort /@ Join[
		Partition[{1, 4, 6, 1}, 2, 1],
		Partition[{2, 3, 5, 7, 8, 2}, 2, 1]
	],
	Partition[Range[8], 2],
	Sort /@ Partition[Append[Range[8], 1], 2, 1]
};

makeChangGraph[s_] := Graph[
	vertices,
	UndirectedEdge @@@ Select[
		Subsets[vertices, {2}],
		Function[pair,
			Xor[
				Length[Intersection @@ pair] == 1,
				Xor[
					MemberQ[s, pair[[1]]],
					MemberQ[s, pair[[2]]]
				]
			]
		]
	],
	VertexCoordinates -> changVertexCoordinates
];

changGraphs = makeChangGraph /@ switchingSets

RecognizeGraph/@changGraphs

gs=RotateGraph@@@Transpose[{changGraphs,{0,Pi/8,0}}]

GraphicsRow[StyleGraphs@Table[GraphData[{"Chang",n},PlotLabel->Style["Chang graph "<>ToString@n,Directive[14,Italic,FontFamily->"Times"]]],{n,3}],Dividers->All]

Switching

triangularEdges = UndirectedEdge @@@ Select[
	Subsets[vertices, {2}],
	Length[Intersection @@ #] == 1 &
];

cutPairs[s_] := Select[
	Subsets[vertices, {2}],
	Xor[
		MemberQ[s, #[[1]]],
		MemberQ[s, #[[2]]]
	] &
];

deletedEdges[s_] := UndirectedEdge @@@ Select[
	cutPairs[s],
	Length[Intersection @@ #] == 1 &
];

addedEdges[s_] := UndirectedEdge @@@ Select[
	cutPairs[s],
	Intersection @@ # === {} &
];

switchingFigure[s_] := With[
	{
		deleted = deletedEdges[s],
		added = addedEdges[s]
	},
	Graph[
		vertices,
		Join[triangularEdges, added],
		VertexCoordinates -> changVertexCoordinates,
		VertexSize -> {"Scaled", .03},
		VertexStyle -> Join[
			Thread[Complement[vertices, s] -> StandardBlue],
			Thread[s -> StandardGreen]
		],
		EdgeStyle -> Join[
			Thread[
				Complement[triangularEdges, deleted] -> Directive[LightDarkSwitched@Black, Thick]
			],
			Thread[deleted -> StandardRed],
			Thread[added -> Directive[StandardBlue, Thick, Opacity[.6]]]
		],
		Background -> LightDarkSwitched@White
	]
];

GraphicsRow[ChangSwitchedGraphic = switchingFigure /@ switchingSets, Dividers->All]

The edges to highlight are exactly those changed by Seidel switching across the cut between the switching set \(S\) and its complement.

Green vertices: members of \(S\).
Red edges: \(T_8\) edges crossing between \(S\) and its complement; switching deletes them.
Phantom blue edges: \(T_8\) nonedges crossing the same cut; switching adds them.
Black/white edges: edges having both endpoints in \(S\), or both outside \(S\); switching leaves them unchanged.

changGraphFromSwitching[s_] := Graph[
	vertices,
	Join[
		Complement[triangularEdges, deletedEdges[s]],
		addedEdges[s]
	],
	VertexCoordinates -> changVertexCoordinates
]

changGraphFromSwitching/@switchingSets

Cycle matching

the cycle/matching description requires the additional identification
\[
T_8=L(K_8).
\]Thus every vertex {i,j} of \(T_8\) is simultaneously the edge \(i\mathbin{-}j\) of \(K_8\). Two vertices of \(T_8\) are adjacent precisely when their corresponding \(K_8\) edges share an endpoint. 
Your switching sets can therefore be written transparently as:

The switching itself is encoded exactly by the Xor in your construction. For a pair of \(T_8\) vertices:

switchedAdjacencyQ[s_, pair_] := Xor[
	Length[Intersection @@ pair] == 1,
	Xor[
		MemberQ[s, pair[[1]]],
		MemberQ[s, pair[[2]]]
	]
];

switchedEdges[s_] := UndirectedEdge @@@ Select[
	Subsets[vertices, {2}],
	switchedAdjacencyQ[s, #] &
];

Equivalently, this is the predicate already present inside your makeChangGraph definition.

Consequently:
Both endpoints inside \(S\): unchanged.
Both endpoints outside \(S\): unchanged.
Exactly one endpoint inside \(S\): adjacency is complemented.
That is precisely Seidel switching. In the overlay, the red edges are crossing adjacencies changed from present to absent, while the phantom-blue edges are crossing nonadjacencies changed from absent to present.

Switching therefore removes and adds the same number of incident edges at every vertex. The three resulting regular graphs are the three nonisomorphic Chang graphs.
So the green/red/blue \(T_8\) pictures illustrate the switching operation; the three small \(K_8\) edge-set pictures establish why the green vertex sets are described as \(C_3\sqcup C_5\), a perfect matching, and \(C_8\).

k8VertexCoordinates = Table[
	Sec[Pi/8] {
		Cos[-Pi/2 - (k - 1) Pi/4],
		Sin[-Pi/2 - (k - 1) Pi/4]
	},
	{k, 8}
];

FullSimplify[
	(Mean[k8VertexCoordinates[[#]]] & /@ vertices) ==
		changVertexCoordinates
]

t8 = Graph[
	vertices,
	triangularEdges,
	VertexCoordinates -> changVertexCoordinates
];

ChangSwitchingSetGraphic = Show[
	StyleGraphs @ Subgraph[t8, #],
	PlotRange -> commonPlotRange
] & /@ switchingSets

GraphicsGrid[
	{
		ChangSwitchedGraphic,
		ChangSwitchingSetGraphic
	},
	Dividers -> All
]

Enumeration

GraphData["Chang"]

Parameters

{m(m-1)/2,2(m-2),m-2,4}/.m->8

GraphData["Chang","RegularParameters"]//Column

Select[
GraphData["StronglyRegular"],
GraphData[#,"RegularParameters"]==={28,{12},{6},{4}}&
]

Embeddings

<<MathWorld`Graphs`

{"Chang", 1}

Names

GraphData[{"Chang",1},"StandardName"]

GraphData[{"Chang",1},"StandardNames"]

HouseOfGraphs

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

HouseOfGraphsLookup[hogid]

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

Wikidata

GraphData[{"Chang",1},"WikidataID"]

GraphData[{"Chang",1},"WikidataID","URL"]

Primary

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

All

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

CurvedEdge

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

Inexact

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

Degenerate

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

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

Embeddings

GraphDataEmbeddings[GraphData[{"Chang",1}]]

Default embedding

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

Configuration

GraphData[{"Chang",1},"Configuration"]

configurations=GraphData[{"Chang",1},"Graph","Configuration"]//StyleGraphs

GeneralizedPetersen

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

IGraph

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

CompleteKPartite

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

Bipartite

GraphData[{"Chang",1},"Bipartite"]

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

Circular

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

Circular construction All

GraphData[{"Chang",1},"Hamiltonian"]

GraphData[{"Chang",1},"HamiltonianCycles"]

GraphData[{"Chang",1},"HamiltonianCycleCount"]

GraphData[{"Chang",1},"LCF"]

GraphData[{"Chang",1},"LCFSignature"]

FindBilateralHamiltonianCycle[GraphData[{"Chang",1}]]

BilateralHamiltonianCycleQ[GraphData[{"Chang",1}]]

Planar

GraphData[{"Chang",1},"Planar"]

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

MinimalCrossingNumber crossings.uos.de

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

DateString[]

Quit

MinimalCrossingNumber: "EmbeddingScheme" -> 1

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

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

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

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

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

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

MinimalCrossingNumber: "EmbeddingScheme" -> 2

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

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

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

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

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

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

MinimalCrossingNumber: "EmbeddingScheme" -> 3

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

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

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

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

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

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

MinimalCrossing

GraphData[{"Chang",1},"CN"]

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

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"Chang",1},"RCN"]

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

MinimalCrossing construction Tutte

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

(g=MinimalCrossingGraph[GraphData[{"Chang",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[{"Chang",1},"V"]])]
}&/@TutteGraphs;

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

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

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

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

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

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

MinimalCrossing construction Random 1k [XXX s]

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

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

No crossing points on the boundary:

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

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

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

Take[diagrams1,UpTo[10]]

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[{"Chang",1}],TimeConstraint->1])//AbsoluteTiming

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

No crossing points on the boundary:

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

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

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

Take[diagrams1,UpTo[10]]

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[{"Chang",1}],TimeConstraint->1])//AbsoluteTiming

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

No crossing points on the boundary:

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

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

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

Take[diagrams1,UpTo[10]]

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[{"Chang",1}],TimeConstraint->1])//AbsoluteTiming

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

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Chang",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[{"Chang",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[{"Chang",1}],TimeConstraint->1])//AbsoluteTiming

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

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Chang",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[{"Chang",1},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

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

MinimalLocalCrossing

GraphData[{"Chang",1},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

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

MinimalRectilinearLocalCrossing

GraphData[{"Chang",1},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Chang",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[{"Chang",1}],TimeConstraint->10])//AbsoluteTiming

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Chang",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[{"Chang",1}],TimeConstraint->10])//AbsoluteTiming

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

Circulant

GraphData[{"Chang",1},"Circulant"]

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

Circulant construction

GraphData[{"Chang",1},"NotationRules","Circulant"]

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

CirculantGraph1@@@ci

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

CirculantGraph1@@@%

Complement graph

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

GraphData[compl,"Graph","All"]

gs=GraphComplement/@%

Select[%,!DegenerateGraphEmbeddingQ[#]&]

Line graph

GraphData[{"Chang",1},"Line"]

LineGraphQ[GraphData[{"Chang",1}]]//Timing

RootGraph

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

RootGraph[GraphData[{"Chang",1}]]

Halin

GraphData[{"Chang",1},"Halin"]

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

Rigid

GraphData[{"Chang",1},"Rigid"]

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

Flexible

GraphData[{"Chang",1},"Flexible"]

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

Voltage

GraphData[{"Chang",1},"Graph","Voltage"]//StyleGraphs

Voltage construction

gs=VoltageGraph[GraphData[{"Chang",1}],"MaxResults"->20,Debug->True]

LCF highly symmetric

(lcf=FindHighlySymmetricLCFNotation[GraphData[{"Chang",1}],"MinRepeat"->2,"MaxResults"->20,Debug->True])//AbsoluteTiming

LCF compute ssham_lcf

l1={
{{"Chang",1},{0,sig}}
};

PropertyReplace[l1,"LCFSignature"]

RenameGraphFiles[]

ReverseSort@Tally[(lcf=Import[FileNameJoin[{$GraphDataDirectory,"Properties","LCFNotations-Nice",GraphNameToFileName[{"Chang",1},".m.gz"]}]])[[All,2]]]

gs=NiceLCFGraphs[lcf,3,2]

Length[gs]

nicelcf=LCFNotation/@gs

l2={
{{"Chang",1},{0,Missing["External",nicelcf]}}
}

PropertyReplace[l2,"LCFNotations"]

RenameGraphFiles[]

Length[BilateralOrder1LCF=Get[FileNameJoin[{"/","Volumes","eww","mma","Graphs","Properties","LCFNotations-Nice",GraphNameToFileName[{"Chang",1},"_bilateral-order-1-reserve.log"]}]]]

BilateralLCFGraph@@@BilateralOrder1LCF//Length//Timing

BilateralLCFGraph@@@Take[BilateralOrder1LCF,10]

Length[bilat=SelectBilateralLCFs[BilateralOrder1LCF,"ProgressEvery"->500,Debug->True]]//Timing

LCF

GraphData[{"Chang",1},"LCF"]

GraphData[{"Chang",1},"HamiltonianCycleCount"]

GraphData[{"Chang",1},"LCFSignature"]

GraphData[{"Chang",1},"LCFNotations"]

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

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

LCF compute random

FindRandomLCFNotation[GraphData[{"Chang",1}],TimeConstraint->120]

LCF compute 10^4 [15 s; 5 GB]

Tally[(lcf=LCF[GraphData[{"Chang",1}],10^4])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

LCF compute 10^5 [XX GB]

Tally[(lcf=LCF[GraphData[{"Chang",1}],10^5])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

LCF compute 10^6 [XX GB]

Tally[(lcf=LCF[GraphData[{"Chang",1}],10^6])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

LCF compute all

FindBilateralHamiltonianCycle[GraphData[{"Chang",1}]]

BilateralHamiltonianCycleQ[GraphData[{"Chang",1}]]

Divisors[GraphData[{"Chang",1},"V"]]

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

Tally[(lcf=LCF[GraphData[{"Chang",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[{"Chang",1},"UnitDistance"]

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

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

UnitDistance by refinement of default embeddings

Graph[edge list]

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

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

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

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData[{"Chang",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[{"Chang",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[{"Chang",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[{"Chang",1}],"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Chang",1},"Matchstick"]

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

3D default

Graph3D[GraphData[{"Chang",1},"Edges"]]

3D construction

3D All

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

3D UnitDistance construction Random

GraphData[{"Chang",1},"Dimension"]

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

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

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

3D Polyhedron

GraphData[{"Chang",1},"Polyhedral"]

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

{"Chang", 2}

Names

GraphData[{"Chang",2},"StandardName"]

GraphData[{"Chang",2},"StandardNames"]

HouseOfGraphs

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

HouseOfGraphsLookup[hogid]

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

Wikidata

GraphData[{"Chang",2},"WikidataID"]

GraphData[{"Chang",2},"WikidataID","URL"]

Primary

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

All

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

CurvedEdge

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

Inexact

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

Degenerate

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

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

Embeddings

GraphDataEmbeddings[GraphData[{"Chang",2}]]

Default embedding

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

Configuration

GraphData[{"Chang",2},"Configuration"]

configurations=GraphData[{"Chang",2},"Graph","Configuration"]//StyleGraphs

GeneralizedPetersen

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

IGraph

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

CompleteKPartite

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

Bipartite

GraphData[{"Chang",2},"Bipartite"]

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

Bilateral

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

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

Circular

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

Circular construction All

GraphData[{"Chang",2},"Hamiltonian"]

GraphData[{"Chang",2},"HamiltonianCycles"]

GraphData[{"Chang",2},"HamiltonianCycleCount"]

GraphData[{"Chang",2},"LCF"]

GraphData[{"Chang",2},"LCFSignature"]

FindBilateralHamiltonianCycle[GraphData[{"Chang",2}]]

BilateralHamiltonianCycleQ[GraphData[{"Chang",2}]]

Planar

GraphData[{"Chang",2},"Planar"]

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

MinimalCrossingNumber crossings.uos.de

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

DateString[]

Quit

MinimalCrossingNumber: "EmbeddingScheme" -> 1

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

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

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

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

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

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

MinimalCrossingNumber: "EmbeddingScheme" -> 2

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

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

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

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

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

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

MinimalCrossingNumber: "EmbeddingScheme" -> 3

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

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

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

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

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

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

MinimalCrossing

GraphData[{"Chang",2},"CN"]

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

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"Chang",2},"RCN"]

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

MinimalCrossing construction Tutte

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

(g=MinimalCrossingGraph[GraphData[{"Chang",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[{"Chang",2},"V"]])]
}&/@TutteGraphs;

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

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

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

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

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

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

MinimalCrossing construction Random 1k [XXX s]

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

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

No crossing points on the boundary:

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

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

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

Take[diagrams1,UpTo[10]]

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[{"Chang",2}],TimeConstraint->1])//AbsoluteTiming

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

No crossing points on the boundary:

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

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

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

Take[diagrams1,UpTo[10]]

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[{"Chang",2}],TimeConstraint->1])//AbsoluteTiming

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

No crossing points on the boundary:

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

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

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

Take[diagrams1,UpTo[10]]

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[{"Chang",2}],TimeConstraint->1])//AbsoluteTiming

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

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Chang",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[{"Chang",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[{"Chang",2}],TimeConstraint->1])//AbsoluteTiming

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

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Chang",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[{"Chang",2},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

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

MinimalLocalCrossing

GraphData[{"Chang",2},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

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

MinimalRectilinearLocalCrossing

GraphData[{"Chang",2},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Chang",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[{"Chang",2}],TimeConstraint->10])//AbsoluteTiming

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Chang",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[{"Chang",2}],TimeConstraint->10])//AbsoluteTiming

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

Circulant

GraphData[{"Chang",2},"Circulant"]

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

Circulant construction

GraphData[{"Chang",2},"NotationRules","Circulant"]

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

CirculantGraph1@@@ci

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

CirculantGraph1@@@%

Complement graph

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

GraphData[compl,"Graph","All"]

gs=GraphComplement/@%

Select[%,!DegenerateGraphEmbeddingQ[#]&]

Line graph

GraphData[{"Chang",2},"Line"]

LineGraphQ[GraphData[{"Chang",2}]]//Timing

RootGraph

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

RootGraph[GraphData[{"Chang",2}]]

Halin

GraphData[{"Chang",2},"Halin"]

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

Rigid

GraphData[{"Chang",2},"Rigid"]

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

Flexible

GraphData[{"Chang",2},"Flexible"]

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

Voltage

GraphData[{"Chang",2},"Graph","Voltage"]//StyleGraphs

Voltage construction

gs=VoltageGraph[GraphData[{"Chang",2}],"MaxResults"->20,Debug->True]

Length[gs]

RecognizeGraph/@gs

VoltageGraphNotation/@gs//Column

EmbeddingClasses/@gs//Column

GraphSymmetryGroup/@gs//Column

LCF highly symmetric

(lcf=FindHighlySymmetricLCFNotation[GraphData[{"Chang",2}],"MinRepeat"->2,"MaxResults"->20,Debug->True])//AbsoluteTiming

lcf[[All,-1]]//Tally

nicelcf=Cases[lcf,{_,_}]

gs=BilateralLCFGraph@@@nicelcf

EmbeddingClasses/@gs//Column

l={
{{"Chang",2},{0,Missing["NotAvailable",nicelcf]}}
}

PropertyReplace[l,"LCFNotations"]

RenameGraphFiles[]

l2={
{{"Chang",2},{0,Missing["NotAvailable",Tally@nicelcf[[All,-1]]]}}
}

PropertyReplace[l2,"LCFSignature"]

RenameGraphFiles[]

LCF compute ssham_lcf

l1={
{{"Chang",2},{0,sig}}
};

PropertyReplace[l1,"LCFSignature"]

RenameGraphFiles[]

ReverseSort@Tally[(lcf=Import[FileNameJoin[{$GraphDataDirectory,"Properties","LCFNotations-Nice",GraphNameToFileName[{"Chang",2},".m.gz"]}]])[[All,2]]]

gs=NiceLCFGraphs[lcf,3,2]

Length[gs]

nicelcf=LCFNotation/@gs

l2={
{{"Chang",2},{0,Missing["External",nicelcf]}}
}

PropertyReplace[l2,"LCFNotations"]

RenameGraphFiles[]

Length[BilateralOrder1LCF=Get[FileNameJoin[{"/","Volumes","eww","mma","Graphs","Properties","LCFNotations-Nice",GraphNameToFileName[{"Chang",2},"_bilateral-order-1-reserve.log"]}]]]

BilateralLCFGraph@@@BilateralOrder1LCF//Length//Timing

BilateralLCFGraph@@@Take[BilateralOrder1LCF,10]

Length[bilat=SelectBilateralLCFs[BilateralOrder1LCF,"ProgressEvery"->500,Debug->True]]//Timing

LCF

GraphData[{"Chang",2},"LCF"]

GraphData[{"Chang",2},"HamiltonianCycleCount"]

GraphData[{"Chang",2},"LCFSignature"]

GraphData[{"Chang",2},"LCFNotations"]

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

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

LCF compute random

FindRandomLCFNotation[GraphData[{"Chang",2}],TimeConstraint->120]

LCF compute 10^5 [XX GB]

Tally[(lcf=LCF[GraphData[{"Chang",2}],10^5])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

LCF compute 10^6 [XX GB]

Tally[(lcf=LCF[GraphData[{"Chang",2}],10^6])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

LCF compute all

FindBilateralHamiltonianCycle[GraphData[{"Chang",2}]]

BilateralHamiltonianCycleQ[GraphData[{"Chang",2}]]

Divisors[GraphData[{"Chang",2},"V"]]

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

Tally[(lcf=LCF[GraphData[{"Chang",2}],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[{"Chang",2},"UnitDistance"]

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

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

UnitDistance by refinement of default embeddings

Graph[edge list]

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

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

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

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData[{"Chang",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[{"Chang",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[{"Chang",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[{"Chang",2}],"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Chang",2},"Matchstick"]

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

3D default

Graph3D[GraphData[{"Chang",2},"Edges"]]

3D construction

3D All

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

3D UnitDistance construction Random

GraphData[{"Chang",2},"Dimension"]

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

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

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

3D Polyhedron

GraphData[{"Chang",2},"Polyhedral"]

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

{"Chang", 3}

Names

GraphData[{"Chang",3},"StandardName"]

GraphData[{"Chang",3},"StandardNames"]

HouseOfGraphs

hogid=GraphData[{"Chang",3},"NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

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

Wikidata

GraphData[{"Chang",3},"WikidataID"]

GraphData[{"Chang",3},"WikidataID","URL"]

Primary

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

All

GraphData[{"Chang",3},"Graph","All"]//StyleGraphs

CurvedEdge

GraphData[{"Chang",3},"Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

GraphData[{"Chang",3},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Chang",3},"Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData[{"Chang",3}]]

Default embedding

g0=GraphPlot[Graph[GraphData[{"Chang",3},"VertexList"],GraphData[{"Chang",3},"Edges"]]]

Configuration

GraphData[{"Chang",3},"Configuration"]

configurations=GraphData[{"Chang",3},"Graph","Configuration"]//StyleGraphs

GeneralizedPetersen

GraphData[{"Chang",3},"Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData[{"Chang",3},"Graph","IGraph"]//StyleGraphs

CompleteKPartite

GraphData[{"Chang",3},"Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData[{"Chang",3},"Bipartite"]

GraphData[{"Chang",3},"Graph","Bipartite"]//StyleGraphs

Bilateral

GraphData[{"Chang",3},"Graph","Bilateral"]//StyleGraphs

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

Circular

GraphData[{"Chang",3},"Graph","Circular"]//StyleGraphs

Circular construction All

GraphData[{"Chang",3},"Hamiltonian"]

GraphData[{"Chang",3},"HamiltonianCycles"]

GraphData[{"Chang",3},"HamiltonianCycleCount"]

GraphData[{"Chang",3},"LCF"]

GraphData[{"Chang",3},"LCFSignature"]

FindBilateralHamiltonianCycle[GraphData[{"Chang",3}]]

BilateralHamiltonianCycleQ[GraphData[{"Chang",3}]]

Planar

GraphData[{"Chang",3},"Planar"]

GraphData[{"Chang",3},"Graph","Planar"]//StyleGraphs

MinimalCrossingNumber crossings.uos.de

CrossingNumber[GraphData[{"Chang",3}],Method->"WebCompute"]//AbsoluteTiming

DateString[]

Quit

MinimalCrossingNumber: "EmbeddingScheme" -> 1

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

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

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

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

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

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

MinimalCrossingNumber: "EmbeddingScheme" -> 2

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

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

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

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

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

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

MinimalCrossingNumber: "EmbeddingScheme" -> 3

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

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

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

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

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

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

Quit

MinimalCrossing

GraphData[{"Chang",3},"CN"]

(gs=GraphData[{"Chang",3},"Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"Chang",3},"RCN"]

GraphData[{"Chang",3},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalCrossing construction Tutte

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

(g=MinimalCrossingGraph[GraphData[{"Chang",3}],"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[{"Chang",3},"V"]])]
}&/@TutteGraphs;

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

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

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

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

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

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

MinimalCrossing construction Random 1k [XXX s]

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

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

No crossing points on the boundary:

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

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

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

Take[diagrams1,UpTo[10]]

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[{"Chang",3}],TimeConstraint->1])//AbsoluteTiming

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

No crossing points on the boundary:

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

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

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

Take[diagrams1,UpTo[10]]

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[{"Chang",3}],TimeConstraint->1])//AbsoluteTiming

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

No crossing points on the boundary:

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

Take[diagrams0,UpTo[10]]

One crossing point on the boundary:

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

Take[diagrams1,UpTo[10]]

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[{"Chang",3}],TimeConstraint->1])//AbsoluteTiming

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

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Chang",3},"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[{"Chang",3},"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[{"Chang",3}],TimeConstraint->1])//AbsoluteTiming

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

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Chang",3},"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[{"Chang",3},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

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

MinimalLocalCrossing

GraphData[{"Chang",3},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Chang",3},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData[{"Chang",3},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Chang",3},"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[{"Chang",3}],TimeConstraint->10])//AbsoluteTiming

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Chang",3}],"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[{"Chang",3}],TimeConstraint->10])//AbsoluteTiming

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

Circulant

GraphData[{"Chang",3},"Circulant"]

GraphData[{"Chang",3},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"Chang",3},"NotationRules","Circulant"]

(ci=CirculantIndices[GraphData[{"Chang",3}]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData[{"Chang",3},"StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

compl=GraphData[{"Chang",3},"ComplementGraph","Name"]

GraphData[compl,"Graph","All"]

gs=GraphComplement/@%

Select[%,!DegenerateGraphEmbeddingQ[#]&]

Line graph

GraphData[{"Chang",3},"Line"]

LineGraphQ[GraphData[{"Chang",3}]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]==={"Chang",3}&]

RootGraph[GraphData[{"Chang",3}]]

Halin

GraphData[{"Chang",3},"Halin"]

GraphData[{"Chang",3},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Chang",3},"Rigid"]

GraphData[{"Chang",3},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Chang",3},"Flexible"]

GraphData[{"Chang",3},"Graph","Flexible"]//StyleGraphs

Voltage

GraphData[{"Chang",3},"Graph","Voltage"]//StyleGraphs

Voltage construction

gs=VoltageGraph[GraphData[{"Chang",3}],"MaxResults"->20,Debug->True]

Length[gs]

RecognizeGraph/@gs

VoltageGraphNotation/@gs//Column

EmbeddingClasses/@gs//Column

GraphSymmetryGroup/@gs//Column

LCF highly symmetric

(lcf=FindHighlySymmetricLCFNotation[GraphData[{"Chang",3}],"MinRepeat"->2,"MaxResults"->20,Debug->True])//AbsoluteTiming

lcf[[All,-1]]//Tally

nicelcf=Cases[lcf,{_,_}]

gs=BilateralLCFGraph@@@nicelcf

EmbeddingClasses/@gs//Column

l={
{{"Chang",3},{0,Missing["NotAvailable",nicelcf]}}
}

PropertyReplace[l,"LCFNotations"]

RenameGraphFiles[]

l2={
{{"Chang",3},{0,Missing["NotAvailable",Tally@nicelcf[[All,-1]]]}}
}

PropertyReplace[l2,"LCFSignature"]

RenameGraphFiles[]

LCF compute ssham_lcf

l1={
{{"Chang",3},{0,sig}}
};

PropertyReplace[l1,"LCFSignature"]

RenameGraphFiles[]

ReverseSort@Tally[(lcf=Import[FileNameJoin[{$GraphDataDirectory,"Properties","LCFNotations-Nice",GraphNameToFileName[{"Chang",3},".m.gz"]}]])[[All,2]]]

gs=NiceLCFGraphs[lcf,3,2]

Length[gs]

nicelcf=LCFNotation/@gs

l2={
{{"Chang",3},{0,Missing["External",nicelcf]}}
}

PropertyReplace[l2,"LCFNotations"]

RenameGraphFiles[]

Length[BilateralOrder1LCF=Get[FileNameJoin[{"/","Volumes","eww","mma","Graphs","Properties","LCFNotations-Nice",GraphNameToFileName[{"Chang",3},"_bilateral-order-1-reserve.log"]}]]]

BilateralLCFGraph@@@BilateralOrder1LCF//Length//Timing

BilateralLCFGraph@@@Take[BilateralOrder1LCF,10]

Length[bilat=SelectBilateralLCFs[BilateralOrder1LCF,"ProgressEvery"->500,Debug->True]]//Timing

LCF

GraphData[{"Chang",3},"LCF"]

GraphData[{"Chang",3},"HamiltonianCycleCount"]

GraphData[{"Chang",3},"LCFSignature"]

GraphData[{"Chang",3},"LCFNotations"]

GraphData[{"Chang",3},"Graph","LCF"]//StyleGraphs

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

LCF compute random

FindRandomLCFNotation[GraphData[{"Chang",3}],TimeConstraint->120]

LCF compute 10^5 [XX GB]

Tally[(lcf=LCF[GraphData[{"Chang",3}],10^5])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

LCF compute 10^6 [XX GB]

Tally[(lcf=LCF[GraphData[{"Chang",3}],10^6])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

LCF compute all

FindBilateralHamiltonianCycle[GraphData[{"Chang",3}]]

BilateralHamiltonianCycleQ[GraphData[{"Chang",3}]]

Divisors[GraphData[{"Chang",3},"V"]]

Length[FindHamiltonianCycle[GraphData[{"Chang",3}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"Chang",3}],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[{"Chang",3},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Chang",3}],Debug->True]//Timing

GraphData[{"Chang",3},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement of default embeddings

Graph[edge list]

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

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

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

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData[{"Chang",3},"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[{"Chang",3},".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[{"Chang",3}],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[{"Chang",3}],"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Chang",3},"Matchstick"]

GraphData[{"Chang",3},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Chang",3},"Edges"]]

3D construction

3D All

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

3D UnitDistance construction Random

GraphData[{"Chang",3},"Dimension"]

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

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

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

3D Polyhedron

GraphData[{"Chang",3},"Polyhedral"]

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

Construction

Wikipedia

distanceregular.org

gs=DistanceRegularGraph["http://www.distanceregular.org/graphdata/chang.am"]

ToEntity/@gs

GraphData

GraphDataClassString

GraphDataClassString["Chang"]