Uniquely Colorable Graph

Author

Eric W. Weisstein
February 29, 2024

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

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

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

Code

ColorPartitions[col_]:=Sort[SplitBy[SortBy[MapIndexed[{#,#2[[1]]}&,col],First],First][[All,All,2]]]

ColoringPartitions[g_Graph]:=Module[{n=VertexCount[g],k=VertexChromaticNumber[g],tup,col},
tup=Tuples[Range[k],n];
col=Select[tup,VertexColoringQ[g,#]&];
part=ColorPartitions/@col//Union
]

ColoringPartitionGraphs[g_Graph,opts___?OptionQ]:=Module[{n=VertexCount[g],k=VertexChromaticNumber[g]},
tup=Tuples[Range[k],n];
col=Select[tup,VertexColoringQ[g,#]&];SplitBy[SortBy[{ColorPartitions[#],Annotate[VertexColoredGraph[g,#],{opts}]}&/@col,First],First][[All,All,2]]
]

Classes

Intersection@@(GraphData[#,"Classes"]&/@GraphData["UniquelyColorable"])

GraphClassesThatAreClass["UniquelyColorable"]

Non-uniquely colorable graphs (errata)

data={#,ColoringPartitionGraphs[GraphData[#],VertexSize->Medium,EdgeStyle->Black,ImageSize->Small][[All,1]]}&/@{"NonuniquelyThreeColorableGraph2","NonuniquelyThreeColorableGraph1","NonuniquelyThreeColorableGraph3"};//Timing

rules={
"NonuniquelyThreeColorableGraph1"->"Harary (1994)",
"NonuniquelyThreeColorableGraph2"->"Harary (1969)",
"NonuniquelyThreeColorableGraph3"->"Harary (1970) incorrectly transcribed"
};

With[{max=4},TextGrid[{Style[#/.rules,Directive[FontFamily->"Times",18]],GraphicsRow[Append[Take[#2,UpTo[max]],If[Length[#2]>max,Style["⋯",18],""]]]}&@@@Most@data,
Dividers->All,Alignment->Left]]

Harary 1994 [wrong]

Cover of Graph Theory

VertexColoredGraph[GraphData["NonuniquelyThreeColorableGraph1"],VertexSize->Medium,ImageSize->Small]

Annotate[#,VertexSize->Medium]&/@ColoringPartitionGraphs[GraphData["NonuniquelyThreeColorableGraph1"]][[All,1]]

Harary 1969 [wrong]

Harary, F.; Hedetniemi, S.; and Robinson, R.  ``Uniquely Colorable Graphs.''  {\it J.\ Combin.\ Th.} {\bf 6}, 264--270, 1969.

https://core.ac.uk/download/pdf/82552892.pdf

VertexColoredGraph[GraphData["NonuniquelyThreeColorableGraph2"],VertexSize->Medium,ImageSize->Small]

ColoringPartitionGraphs[GraphData["NonuniquelyThreeColorableGraph2"]][[All,1]]

Harary 1970 [wrong]; missing an edge (GraphData's "UniquelyThreeColorableGraph" prior to V14.1; "NonuniquelyThreeColorableGraph3" thereafter)

https://pdf.sciencedirectassets.com/276643/1-s2.0-S0021980070X80168/1-s2.0-S0021980070800278/main.pdf

Harary, F.; Hedetniemi, S.; and Robinson, R.  ``Erratum to `Uniquely Colorable Graphs'.''  {\it J.\ Combin.\ Th.} {\bf 9}, 221, 1970.\par
(but when I made it into "UniquelyThreeColorableGraph" I missed the top edge)

VertexColoredGraph[GraphData["NonuniquelyThreeColorableGraph3"],VertexSize->Medium,ImageSize->Small]

Annotate[#,VertexSize->Medium]&/@ColoringPartitionGraphs[GraphData["NonuniquelyThreeColorableGraph3"]][[All,1]]

Harary 1970 [correct]

Harary, F.; Hedetniemi, S.; and Robinson, R.  ``Erratum to `Uniquely Colorable Graphs'.''  {\it J.\ Combin.\ Th.} {\bf 9}, 221, 1970.

https://pdf.sciencedirectassets.com/276643/1-s2.0-S0021980070X80168/1-s2.0-S0021980070800278/main.pdf

g=EdgeAdd[GraphData["NonuniquelyThreeColorableGraph3","Graph","Labeled"],UndirectedEdge[11,12]]

r=RecognizeGraph@g

GraphData[r,"UniquelyColorable"]

UniquelyColorableGraphQ[g,Debug->True]//Timing

UniquelyColorableGraphQ[g,Debug->True,Method->"AllTrueReduced"]//Timing

TriangleFreeGraphQ[g]

VertexColoredGraph[g,VertexSize->Medium,ImageSize->Small]

Annotate[#,VertexSize->Medium]&/@ColoringPartitionGraphs[g][[All,1]]

Graph contains no triangles:

IsomorphicSubgraphQ[CycleGraph[3],GraphData["UniquelyThreeColorableTriangleFreeGraph"]]

GraphData["UniquelyThreeColorableTriangleFreeGraph","TriangleFree"]

Theorems

Uniquely 4-colorable planar graphs are the 3-trees

Brešar, B.; Dravec, T.; Kleszcz, E.  "Uniquely Colorable Graphs Up to Automorphisms."  Appl. Math. Comput. 450, 128007, 2023.

g1=Select[GraphData[{"Planar","UniquelyColorable"}],GraphData[#,"ChromaticNumber"]==4&]

g2=Select[GraphData[{"Planar","KTree"}],GraphData[#,"Treewidth"]==3&]

g1==g2

There are no uniquely 5-colorable planar graphs

Brešar, B.; Dravec, T.; Kleszcz, E.  "Uniquely Colorable Graphs Up to Automorphisms."  Appl. Math. Comput. 450, 128007, 2023.

Cases[GraphData[#,{"#","ChromaticNumber"}]&/@GraphData[{"Planar","UniquelyColorable"}],{_,_Integer?(GreaterThan[4])}]

Inequalities

Uniquely k-colorable graphs are not k-1 connected

Brešar, B.; Dravec, T.; Kleszcz, E.  "Uniquely Colorable Graphs Up to Automorphisms."  Appl. Math. Comput. 450, 128007, 2023.

data={#,#2≥#3-1,#4}&@@@(GraphData[#,{"#","VertexConnectivity","ChromaticNumber","UniquelyColorable"}]&/@GraphData["ChromaticNumber","Defined"])

new=Cases[data,{_,False,True|_Missing}]

l={#,{0,False}}&@@@new

δ(G)≥k-1

Brešar, B.; Dravec, T.; Kleszcz, E.  "Uniquely Colorable Graphs Up to Automorphisms."  Appl. Math. Comput. 450, 128007, 2023.

data={#,#2≥#3-1,#4}&@@@(GraphData[#,{"#","MinimumVertexDegree","ChromaticNumber","UniquelyColorable"}]&/@GraphData["ChromaticNumber","Defined"])

new=Cases[data,{_,False,True|_Missing}]

Bollobas

https://doi.org/10.1016/S0095-8956(78)80010-0

In the inequality holds, the graph is uniquely colorable:

DeleteCases[
Function[{name,n,delta,k,uniq},{name,delta>((3k-5)/(3k-2))n,uniq}]@@@(GraphData[#,{"#","V","MinimumVertexDegree","ChromaticNumber","UniquelyColorable"}]&/@GraphData["ChromaticNumber","Defined"]),
{_,x_,x_}|{_,False,_}]

However, if the inequality does not hold, the graph may or may not be uniquely colorable:

Cases[
Function[{name,n,delta,k,uniq},{name,delta>((3k-5)/(3k-2))n,uniq}]@@@(GraphData[#,{"#","V","MinimumVertexDegree","ChromaticNumber","UniquelyColorable"}]&/@GraphData["ChromaticNumber","Defined"]),
{gn_,True,True}:>gn]

DeleteCases[
Function[{name,n,delta,k,uniq},{name,delta>((3k-5)/(3k-2))n,uniq}]@@@(GraphData[#,{"#","V","MinimumVertexDegree","ChromaticNumber","UniquelyColorable"}]&/@GraphData["ChromaticNumber","Defined"]),
{_,x_,x_}|{_,_,_Missing}]

SortBy[Cases[%194,{s_String,__}:>s],GraphData[#,"V"]&]

E.g., the inequality may be false but the graph uniquely colorable:

Show[ColoringPartitionGraphs[GraphData[{6,32}],VertexSize->Small],ImageSize->200]

ColoringPartitions[GraphData[{6,32}]]//Column

GraphData[{6,32},{"#","V","MinimumVertexDegree","ChromaticNumber","UniquelyColorable"}]

With[{k=2,n=6},1>((3k-5)/(3k-2))n]

Xu

https://doi.org/10.1016/0095-8956(90)90086-F

m ≥ (k - 1) n - k(k-1)/2

If the inequality does not hold, the graph is not uniquely colorable; if it does hold, the graph may or may not be uniquely colorable:

new=
Function[{name,n,m,k,uniq},{name,m≥(k-1) n-k(k-1)/2,uniq}]@@@(GraphData[#,{"#","V","M","ChromaticNumber","UniquelyColorable"}]&/@GraphData["ChromaticNumber","Defined"])

Tally[Rest/@new]

new=DeleteCases[
Function[{name,n,m,k,uniq},{name,m≥(k-1) n-k(k-1)/2,uniq}]@@@(GraphData[#,{"#","V","M","ChromaticNumber","UniquelyColorable"}]&/@GraphData["ChromaticNumber","Defined"]),
{x_,x_}]

Tally[Rest/@DeleteCases[new,{_,_,_Missing}]]

If the inequality holds, graph may or may not be uniquely colorable:

false=SortBy[DeleteCases[
Function[{name,n,m,k,uniq},{name,m≥(k-1) n-k(k-1)/2,uniq}]@@@(GraphData[#,{"#","V","M","ChromaticNumber","UniquelyColorable"}]&/@GraphData["ChromaticNumber","Defined"]),
{_,x_,x_}|{_,True,_}],
GraphData[#[[1]],"V"]&]

Table[GraphData["K"<>ToString[n]<>"+K1","UniquelyColorable"],{n,2,10}]

Table[GraphData[{"Barbell",n},"UniquelyColorable"],{n,3,20}]

Counts

Compute

Do[Print[{n,(Put[res=UniquelyColorableGraphQ[#,Method->"IndependentVertexSets"]&/@Graphs[n],"UniquelyColorable_"<>If[n<10,"0",""]<>ToString[n]<>".m"];
Count[res,True])//Timing}],{n,10}]

Disconnected

Table[GraphData[{"Disconnected","UniquelyColorable"},n],{n,7}]

All

A369223

Length/@(all=Table[SortBy[GraphData/@GraphData[{"UniquelyColorable"},n],EdgeCount],{n,7}])

files=FileNames["*.m",FileNameJoin[{$GraphDataDirectory,"Nodes","UniquelyColorable"}]]

allcounts=Count[Get[#],True]&/@files

FindGeneratingFunction[allcounts,x]//Head//Timing

FindSequenceFunction[allcounts,n]//Head//Timing

Chromatic number triangle

A369227

GraphData

(triangle=Table[Sort@Tally[GraphData[#,"ChromaticNumber"]&/@GraphData["UniquelyColorable",n]],{n,7}])//Column

n-node files

uniq=Get/@FileNames["*.m",FileNameJoin[{$GraphDataDirectory,"Nodes","UniquelyColorable"}]];

chromatic=Get/@FileNames["*.m",FileNameJoin[{$GraphDataDirectory,"Nodes","ChromaticNumber"}]];

(tri=Sort[Tally[Cases[#,{True,n_}:>n]]][[All,2]]&/@Map[Transpose,Transpose[{uniq,chromatic}],{1}])//Column

Flatten[tri]

a(n, 1) = 1:

tri[[All,1]]

a(n, 2)  = A005142(n) (connected bipartite graphs):

tri[[2;;,2]]

a(n, 3) = A348222(n) (uniquely 3-colorable graphs):

tri[[3;;,3]]

a(n, 4) [not in OEIS]

tri[[4;;,4]]

a(n, n) = 1:

tri[[All,-1]]

Theorems

No subgraph isomorphic to (Subscript[K, n])

Harary, F.; Hedetniemi, S.; and Robinson, R.  ``Uniquely Colorable Graphs.''  {\it J.\ Combin.\ Th.} {\bf 6}, 264--270, 1969.

https://core.ac.uk/download/pdf/82552892.pdf

Figure

all=Table[Pick[Graphs[n],Get[files[[n]]],True],{n,5}];

GraphicsGrid[Flatten[Partition[#,UpTo[7]]&/@Map[VertexColoredGraph[g=GraphData[RecognizeGraph[#]],EdgeStyle->Black,VertexSize->If[VertexCount[g]==1,.01,{"Scaled",.05}]]&,Take[all,5],{2}],1],Dividers->{{Thick,{True},Thick},{Thick,Thick,Thick,Thick,Thick,True,Thick}},ImageSize->700]

GraphDataCountTable

GraphDataCountTable["UniquelyColorable"]

Parametrized families

<<MathWorld`Graphs`

Alkane

seq=Table[GraphData[{"Alkane",n},"UniquelyColorable"],{n,10}]

AlternatingGroupGraph

seq=Table[GraphData[{"AlternatingGroupGraph",n},"UniquelyColorable"],{n,2,6}]

Andrasfai

Inferred for n > 6:

seq=Table[GraphData[{"Andrasfai",n},"UniquelyColorable"],{n,20}]

Table[GraphData[{"Andrasfai",n},"IndependentVertexSetCount"],{n,20}]

Do[Print[{gn={"Andrasfai",n}},{0,UniquelyColorableGraphQ[GraphData[gn],Method->"IndependentVertexSets"]//Timing,MaxMemoryUsed[]/10^9.}],{n,20}]

Do[Print[{gn={"Andrasfai",n}},{0,UniquelyColorableGraphQ[GraphData[gn],Method->"AllTrueReduced"]//Timing,MaxMemoryUsed[]/10^9.}],{n,20}]

Antelope n×n

seq=Table[GraphData[{"Antelope",{n,n}},"UniquelyColorable"],{n,20}]

Antiprism

Entity["Graph",{"Antiprism",n}]["UniquelyColorable"]

Inferred for n > 7 with mod(n, 3) = 0:

seq=Table[GraphData[{"Antiprism",n},"UniquelyColorable"],{n,3,25}]

Table[Piecewise[{{True,Mod[n,3]==0}},False],{n,3,20}]

Table[GraphData[{"Antiprism",n},"ChromaticNumber"],{n,3,25}]

Table[GraphData[{"Antiprism",n},"IndependentVertexSetCount"],{n,3,25}]

<<MathWorld`Graphs`

Annotate[VertexColoredGraph[g=GraphData[{"Antiprism",6}]],{VertexSize->Medium,ImageSize->Small,VertexLabels->Automatic}]

Length[tup=Tuples[Range[3],VertexCount[g]]]

(col=Select[tup,VertexColoringQ[g,#]&])//Timing

ColorPartitions/@col//Union//Column

Annotate[VertexColoredGraph[g=GraphData[{"Antiprism",5}]],{VertexSize->Medium,ImageSize->Small,VertexLabels->Automatic}]

UniquelyColorableGraphQ[g,Debug->True,Method->"AllTrueReduced"]

Length[tup=Tuples[Range[4],VertexCount[g]]]

(col=Select[tup,VertexColoringQ[g,#]&])//Timing

Length[ColorPartitions/@col//Union]

ColorPartitions/@col//Union//Column

DeleteDuplicatesBy[col,IGBlissCanonicalGraph[{g,"VertexColors"->#}]&]

Grid[{#[[1,1]],GraphicsRow@#[[All,2]]}&/@SplitBy[SortBy[{ColorPartitions[#],Annotate[VertexColoredGraph[g,#],{VertexSize->Large,ImageSize->Small,VertexLabels->Automatic}]}&/@col,First],First],Dividers->All]

Do[Print[{gn={"Antiprism",n}},{0,UniquelyColorableGraphQ[GraphData[gn],Method->"AllTrueReduced"]//Timing,MaxMemoryUsed[]/10^9.}],{n,3,25}]

Do[Print[{gn={"Antiprism",n}},{0,UniquelyColorableGraphQ[GraphData[gn],Method->"IndependentVertexSets"]//Timing,MaxMemoryUsed[]/10^9.}],{n,3,25}]

Apollonian

seq=Table[GraphData[{"Apollonian",n},"UniquelyColorable"],{n,5}]

Barbell

seq=Table[GraphData[{"Barbell",n},"UniquelyColorable"],{n,3,20}]

BlackBishop n×n

seq=Table[GraphData[{"BlackBishop",{n,n}},"UniquelyColorable"],{n,20}]

Bishop n×n

seq=Table[GraphData[{"Bishop",{n,n}},"UniquelyColorable"],{n,20}]

Book

seq=Table[GraphData[{"Book",n},"UniquelyColorable"],{n,20}]

Bruhat

seq=Table[GraphData[{"Bruhat",n},"UniquelyColorable"],{n,6}]

Camel n×n

seq=Table[GraphData[{"Camel",{n,n}},"UniquelyColorable"],{n,20}]

Centipede

seq=Table[GraphData[{"Centipede",n},"UniquelyColorable"],{n,10}]

CocktailParty

seq=Table[GraphData[{"CocktailParty",n},"UniquelyColorable"],{n,20}]

Complete

Entity["Graph",{"Complete",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Complete",n},"UniquelyColorable"],{n,30}]

CompleteBipartite m×n

Entity["Graph",{"CompleteBipartite",{m,n}}]["UniquelyColorable"]

DeleteCases[Flatten[Table[{
{m,n},
GraphData[{"CompleteBipartite",{m,n}},"UniquelyColorable"],
True
},{n,10},{m,n}],1],{_,x_,x_}]

CompleteBipartite n×n

Entity["Graph",{"CompleteBipartite",{n,n}}]["UniquelyColorable"]

seq=Table[GraphData[{"CompleteBipartite",{n,n}},"UniquelyColorable"],{n,20}]

CompleteTripartite k×m×n

Entity["Graph",{"CompleteTripartite",{k,m,n}}]["UniquelyColorable"]

DeleteCases[Flatten[Table[{
{k,m,n},
GraphData[{"CompleteTripartite",{k,m,n}},"UniquelyColorable"],
True
},{n,10},{m,n},{k,m}],2],{_,x_,x_}]

CompleteTripartite n×n×n

Entity["Graph",{"CompleteTripartite",{n,n,n}}]["UniquelyColorable"]

seq=Table[GraphData[{"CompleteTripartite",{n,n,n}},"UniquelyColorable"],{n,10}]

CrossedPrism

seq=Table[GraphData[{"CrossedPrism",2n},"UniquelyColorable"],{n,2,12}]

Crown

seq=Table[GraphData[{"Crown",n},"UniquelyColorable"],{n,20}]

CubeConnectedCycle

Entity["Graph",{"CubeConnectedCycle",n}]["UniquelyColorable"]

seq=Table[GraphData[{"CubeConnectedCycle",n},"UniquelyColorable"],{n,3,8}]

Table[Piecewise[{{True,Mod[n,2]==0},{False,Mod[n,2]==1}}],{n,3,8}]==seq

Cycle

Entity["Graph",{"Cycle",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Cycle",n},"UniquelyColorable"],{n,3,30}]

Table[Piecewise[{{True,n==3||Mod[n,2]==0}},False],{n,3,30}]==seq

CycleComplement

seq=Table[GraphData[{"CycleComplement",n},"UniquelyColorable"],{n,3,20}]

DiagonalIntersection

seq=Table[GraphData[{"DiagonalIntersection",n},"UniquelyColorable"],{n,3,14}]

Dipyramid

Inferred for n > 12:

seq=Table[GraphData[{"Dipyramid",n},"UniquelyColorable"],{n,3,20}]

Table[Piecewise[{{True,Mod[n,2]==0||n==3},{False,Mod[n,2]==1}}],{n,3,20}]==seq

DorogovtsevGoltsevMendes

seq=Table[GraphData[{"DorogovtsevGoltsevMendes",n},"UniquelyColorable"],{n,0,7}]

DoubleCone

seq=Table[GraphData[{"DoubleCone",n},"UniquelyColorable"],{n,3,20}]

Table[Print[n];UniquelyColorableGraphQ[GraphData[{"DoubleCone",n}],Debug->True],{n,3,20}]

Empty

Entity["Graph",{"Empty",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Empty",n},"UniquelyColorable"],{n,30}]

FibonacciCube

seq=Table[GraphData[{"FibonacciCube",n},"UniquelyColorable"],{n,15}]

Fiveleaper n×n

seq=Table[GraphData[{"Fiveleaper",{n,n}},"UniquelyColorable"],{n,20}]

Flower

seq=Table[GraphData[{"Flower",n},"UniquelyColorable"],{n,5,20}]

FoldedCube

seq=Table[GraphData[{"FoldedCube",n},"UniquelyColorable"],{n,2,10}]

Gear

seq=Table[GraphData[{"Gear",n},"UniquelyColorable"],{n,3,20}]

Giraffe n×n

seq=Table[GraphData[{"Giraffe",{n,n}},"UniquelyColorable"],{n,20}]

Goldberg

seq=Table[GraphData[{"Goldberg",n},"UniquelyColorable"],{n,3,20}]

Grid m×n

Entity["Graph",{"Grid",{m,n}}]["UniquelyColorable"]

DeleteCases[Flatten[Table[{
{m,n},
GraphData[{"Grid",{m,n}},"UniquelyColorable"],
True
},{n,10},{m,n}],1],{_,x_,x_}]

Grid n×n

Entity["Graph",{"Grid",{n,n}}]["UniquelyColorable"]

seq=Table[GraphData[{"Grid",{n,n}},"UniquelyColorable"],{n,20}]

Grid k×m×n

Entity["Graph",{"Grid",{k,m,n}}]["UniquelyColorable"]

DeleteCases[Sort@Flatten[Table[{
{k,m,n},
GraphData[{"Grid",{k,m,n}},"UniquelyColorable"],
True
},{n,5},{m,n},{k,m}],2],{_,x_,x_}]

Tally[GraphData[{"Grid",{2,3,4}},"DistanceMatrix"]//Normal//Flatten]

Grid n×n×n

Entity["Graph",{"Grid",{n,n,n}}]["UniquelyColorable"]

seq=Table[GraphData[{"Grid",{n,n,n}},"UniquelyColorable"],{n,10}]

HalvedCube

seq=Table[GraphData[{"HalvedCube",n},"UniquelyColorable"],{n,10}]

Hanoi

seq=Table[GraphData[{"Hanoi",n},"UniquelyColorable"],{n,5}]

Helm

seq=Table[GraphData[{"Helm",n},"UniquelyColorable"],{n,3,20}]

Hypercube

Entity["Graph",{"Hypercube",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Hypercube",n},"UniquelyColorable"],{n,0,10}]

Keller

Entity["Graph",{"Keller",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Keller",n},"UniquelyColorable"],{n,5}]

King m×n

DeleteCases[Flatten[Table[{
{m,n},
GraphData[{"King",{m,n}},"UniquelyColorable"],
True
},{n,10},{m,n}],1],{_,x_,x_}]

King n×n

Inferred for n > 14:

seq=Table[GraphData[{"King",{n,n}},"UniquelyColorable"],{n,20}]

Knight m×n

Entity["Graph",{"Knight",{m,n}}]["UniquelyColorable"]

DeleteCases[Flatten[Table[{
{m,n},
GraphData[{"Knight",{m,n}},"UniquelyColorable"],
Piecewise[{{False,(Min[m,n]==2&&Max[m,n]>2)||m==n==3}},True]
},{n,10},{m,n}],1],{_,x_,x_}]

Knight n×n

Entity["Graph",{"Knight",{n,n}}]["UniquelyColorable"]

seq=Table[GraphData[{"Knight",{n,n}},"UniquelyColorable"],{n,20}]

Ladder

Entity["Graph",{"Ladder",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Ladder",n},"UniquelyColorable"],{n,20}]

LadderRung

Inferred for n > 13:

seq=Table[GraphData[{"LadderRung",n},"UniquelyColorable"],{n,20}]

LucasCube

seq=Table[GraphData[{"LucasCube",n},"UniquelyColorable"],{n,15}]

MengerSponge

seq=Table[GraphData[{"MengerSponge",n},"UniquelyColorable"],{n,3}]

MoebiusLadder

Entity["Graph",{"MoebiusLadder",n}]["UniquelyColorable"]

seq=Table[GraphData[{"MoebiusLadder",n},"UniquelyColorable"],{n,3,25}]

Table[Piecewise[{{False,Mod[n,2]==0},{True,Mod[n,2]==1}}],{n,3,25}]==seq

Inferred for these Missing:

Mycielski

Entity["Graph",{"Mycielski",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Mycielski",n},"UniquelyColorable"],{n,11}]

Odd

Entity["Graph",{"Odd",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Odd",n},"UniquelyColorable"],{n,7}]

Pan

seq=Table[GraphData[{"Pan",n},"UniquelyColorable"],{n,3,20}]

Path

Entity["Graph",{"Path",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Path",n},"UniquelyColorable"],{n,20}]

PathComplement

seq=Table[GraphData[{"PathComplement",n},"UniquelyColorable"],{n,20}]

Pell

seq=Table[GraphData[{"Pell",n},"UniquelyColorable"],{n,9}]

Prism

Entity["Graph",{"Prism",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Prism",n},"UniquelyColorable"],{n,3,25}]

Table[Piecewise[{{True,Mod[n,2]==0},{False,Mod[n,2]==1}}],{n,3,25}]==seq

Inferred for these Missing:

Queen n×n

seq=Table[GraphData[{"Queen",{n,n}},"UniquelyColorable"],{n,20}]

Rook n×n

seq=Table[GraphData[{"Rook",{n,n}},"UniquelyColorable"],{n,20}]

RookComplement n×n

seq=Table[GraphData[{"RookComplement",{n,n}},"UniquelyColorable"],{n,10}]

SierpinskiCarpet

seq=Table[GraphData[{"SierpinskiCarpet",n},"UniquelyColorable"],{n,4}]

SierpinskiGasket

Inferred for n > 3:

seq=Table[GraphData[{"SierpinskiGasket",n},"UniquelyColorable"],{n,5}]

SierpinskiTetrahedron

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"UniquelyColorable"],{n,6}]

Spoke n×n

seq=Table[GraphData[{"Spoke",{n,n}},"UniquelyColorable"],{n,5}]

StackedBook

seq=Table[GraphData[{"StackedBook",{n,n}},"UniquelyColorable"],{n,10}]

StackedPrism

seq=Table[GraphData[{"StackedPrism",{n,n}},"UniquelyColorable"],{n,3,5}]

Star

Entity["Graph",{"Star",n}]["UniquelyColorable"]

Star

seq=Table[GraphData[{"Star",n},"UniquelyColorable"],{n,25}]

Sun

seq=Table[GraphData[{"Sun",n},"UniquelyColorable"],{n,3,20}]

Sunlet

seq=Table[GraphData[{"Sunlet",n},"UniquelyColorable"],{n,3,20}]

TorusGrid n×n

seq=Table[GraphData[{"TorusGrid",{n,n}},"UniquelyColorable"],{n,3,20}]

Transposition

Entity["Graph",{"Transposition",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Transposition",n},"UniquelyColorable"],{n,6}]

Trapezohedron

Entity["Graph",{"Trapezohedron",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Trapezohedron",n},"UniquelyColorable"],{n,3,20}]

Triangular

seq=Table[GraphData[{"Triangular",n},"UniquelyColorable"],{n,2,20}]

TriangularGrid

seq=Table[GraphData[{"TriangularGrid",n},"UniquelyColorable"],{n,0,10}]

TriangularHoneycombAcuteKnight

seq=Table[GraphData[{"TriangularHoneycombAcuteKnight",n},"UniquelyColorable"],{n,20}]

TriangularHoneycombBishop

seq=Table[GraphData[{"TriangularHoneycombBishop",n},"UniquelyColorable"],{n,9}]

TriangularHoneycombObtuseKnight

seq=Table[GraphData[{"TriangularHoneycombObtuseKnight",n},"UniquelyColorable"],{n,20}]

TriangularHoneycombQueen

seq=Table[GraphData[{"TriangularHoneycombQueen",n},"UniquelyColorable"],{n,10}]

TriangularHoneycombRook

seq=Table[GraphData[{"TriangularHoneycombRook",n},"UniquelyColorable"],{n,20}]

TriangularSnake

Inferred for n==19:

seq=Table[GraphData[{"TriangularSnake",n},"UniquelyColorable"],{n,1,20,2}]

Web

seq=Table[GraphData[{"Web",n},"UniquelyColorable"],{n,3,20}]

Wheel

Entity["Graph",{"Wheel",n}]["UniquelyColorable"]

seq=Table[GraphData[{"Wheel",n},"UniquelyColorable"],{n,4,20}]

Table[Piecewise[{{True,Mod[n,2]==1||n==4},{False,Mod[n,2]==0}}],{n,4,20}]==seq

Inferred for these Missing:

WheelComplement

seq=Table[GraphData[{"WheelComplement",n},"UniquelyColorable"],{n,4,20}]

WhiteBishop n×n

seq=Table[GraphData[{"WhiteBishop",{n,n}},"UniquelyColorable"],{n,2,20}]

Zebra n×n

seq=Table[GraphData[{"Zebra",{n,n}},"UniquelyColorable"],{n,20}]

Uniquely colorable under the action of the automorphism group (iso-uniquely colorable)

<<MathWorld`Graphs`

"AGraph"

col=UniqueColorings[g=GraphData["AGraph"],Debug->True]

UniquelyColorableGraphQ[g]

VertexColoredGraph[g,#,VertexSize->.2]&/@col

"BannerGraph"

g=GraphData["BannerGraph"]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute[#1,#2]&][[All,1]]]//Timing

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

"ClawGraph"

UniqueColorings[GraphData["ClawGraph"]]

g=GraphData["ClawGraph"]

chi=VertexChromaticNumber[g]

n=VertexCount[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute][[All,1]]]

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"CocktailParty", 5}

g=GraphData[{"CocktailParty",5}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

All colorings

(col=Select[tuples,VertexColoringQ[g,#]&])//Timing

Length[col]

chi!

VertexColoredGraph[g,#,VertexSize->.2]&/@col

Using automorphism group

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute[#1,#2]&][[All,1]]]//Timing

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

Length[col]

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"Complete", 6}

g=GraphData[{"Complete", 6}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute[#1,#2]&][[All,1]]]//Timing

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"Cycle", 6}

g=GraphData[{"Cycle", 6}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute[#1,#2]&][[All,1]]]//Timing

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"Empty", 6}

g=GraphData[{"Empty", 6}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute[#1,#2]&][[All,1]]]//Timing

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"Ladder", 6}

g=GraphData[{"Ladder", 6}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute[#1,#2]&][[All,1]]]//Timing

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"Pan", 6}

g=GraphData[{"Pan", 6}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute[#1,#2]&][[All,1]]]//Timing

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

"NonuniquelyThreeColorableGraph1"

col=UniqueColorings[g=GraphData["NonuniquelyThreeColorableGraph1"],Debug->True]

UniquelyColorableGraphQ[g]

VertexColoredGraph[g,#,VertexSize->.2]&/@col

"NonuniquelyThreeColorableGraph2"

col=UniqueColorings[g=GraphData["NonuniquelyThreeColorableGraph2"],Debug->True]

VertexColoredGraph[g,#,VertexSize->.2]&/@col

"OctahedralGraph"

g=GraphData["OctahedralGraph"]

chi=VertexChromaticNumber[g]

n=VertexCount[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute][[All,1]]]

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"Path", 6}

g=GraphData[{"Path", 6}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute[#1,#2]&][[All,1]]]//Timing

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

Length[orbits2=Union[Sort[PermutationReplace[#,Permutations[Range[chi]]]][[1]]&/@orbits]]//Timing

(col=Select[orbits2,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"SierpinskiGasket", 2}

g=SierpinskiGasketGraph[2]

UniqueColorings[SierpinskiGasketGraph[2]]//Timing

Length[tuples=Tuples[Range[3],6]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute][[All,1]]]

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

Length[col=Select[Tuples[Range[3],6],VertexColoringQ[g,#]&]]//Timing

gr1=GraphicsGrid[Partition[VertexColoredGraph[g,#,VertexSize->.1]&/@col,UpTo[3]]]

{"SierpinskiGasket", 3}

g=SierpinskiGasketGraph[3]

UniqueColorings[SierpinskiGasketGraph[3]]//Timing

VertexCount[g]

Length[tuples=Tuples[Range[3],15]]

grp=GraphAutomorphismGroup[g]

Length[orbits=GroupOrbits[grp,tuples,Permute][[All,1]]]//Timing

(col=Select[orbits,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

Length[col=With[{},Select[Tuples[Range[3],VertexCount[g]],VertexColoringQ[g,#]&]]]//Timing

col

MaxMemoryUsed[]/10^9.GB

gr2=GraphicsGrid[Partition[VertexColoredGraph[SierpinskiGasketGraph[3],#,VertexSize->.2]&/@colorings3,UpTo[3]]]

"SixteenCellGraph" == {"CocktailParty", 4}

col=UniqueColorings[g=GraphData[{"CocktailParty",4}],Debug->True]

VertexColoredGraph[g,#,VertexSize->.2]&/@col

"UniquelyThreeColorableGraph"

<<MathWorld`Graphs`

g=GraphData["UniquelyThreeColorableGraph"]

chi=GraphData["UniquelyThreeColorableGraph","ChromaticNumber"]

n=VertexCount[g]

(col=UniqueColorings[g,Debug->True])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

GroupOrbits -> VertexColoring -> SymmetricGroup [2]

Length[orbits=GroupOrbits[grp,tuples,Permute][[All,1]]]//Timing

col=Select[orbits,VertexColoringQ[g,#]&]

col2=GroupOrbits[SymmetricGroup[chi],col,PermutationReplace][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col2

VertexColoring -> SymmetricGroup -> GroupOrbits [1]

(col=Select[tuples,VertexColoringQ[g,#]&])//Timing

col2=GroupOrbits[SymmetricGroup[chi],col,PermutationReplace][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col2

Length[col3=GroupOrbits[grp,col2,Permute][[All,1]]]//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col3

VertexColoring -> GroupOrbits -> SymmetricGroup [2]

(col=Select[tuples,VertexColoringQ[g,#]&])//Timing

col2=GroupOrbits[grp,col,Permute][[All,1]]

col3=GroupOrbits[SymmetricGroup[chi],col2,PermutationReplace][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col3

{"Wheel", 5}

<<MathWorld`Graphs`

g=GraphData[{"Wheel", 6}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

(col=Select[tuples,VertexColoringQ[g,#]&])//Timing

col2=GroupOrbits[SymmetricGroup[chi],col,PermutationReplace][[All,1]]

col3=GroupOrbits[grp,col2,Permute][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col3

Examples

<<IGraphM`

<<MathWorld`Graphs`

S5

g=VertexColoredGraph[GraphData[{"Star",5}]]

UniquelyColorableGraphQ[g,Debug->True]

Length[tup=Tuples[Range[2],VertexCount[g]]]

col=Select[tup,VertexColoringQ[g,#]&]

ColorPartitions/@col

DeleteDuplicatesBy[col,IGBlissCanonicalGraph[{g,"VertexColors"->#}]&]

VertexColoredGraph[g,#,VertexSize->Small]&/@col

Harary 5-vertex (color identity and uniquely colorable)

Harary, pp. 137–138

v=CirclePoints[5];
g=VertexColoredGraph[Graph[Range[5],UndirectedEdge@@@{e[1,2,3,4,5,1,3,5]},VertexCoordinates->v,VertexLabels->Automatic]]

ColorIdentityGraphQ[g]

UniquelyColorableGraphQ[g,Debug->True]

Length[tup=Tuples[Range[2],VertexCount[g]]]

col=Select[tup,VertexColoringQ[g,#]&]

ColorPartitions/@col

DeleteDuplicatesBy[col,IGBlissCanonicalGraph[{g,"VertexColors"->#}]&]

VertexColoredGraph[g,#,VertexSize->Small]&/@col

Pentagon (color identity but not uniquely colorable)

Harary, p. 137

g=VertexColoredGraph[CycleGraph[5]]

ColorIdentityGraphQ[CycleGraph[5],Debug->True]

UniquelyColorableGraphQ[CycleGraph[5],Debug->True]

Length[tup=Tuples[Range[3],VertexCount[g]]]

col=Select[tup,VertexColoringQ[g,#]&]

DeleteDuplicatesBy[col,IGBlissCanonicalGraph[{g,"VertexColors"->#}]&]

(ColorPartitions/@col//Union)//Column

Grid[{#[[1,1]],GraphicsRow@#[[All,2]]}&/@SplitBy[SortBy[{ColorPartitions[#],Annotate[VertexColoredGraph[g,#],{VertexSize->Medium,ImageSize->Small,VertexLabels->Automatic}]}&/@col,First],First],Dividers->All]

Harary 5-vertex (color identity and uniquely colorable)

Harary, pp. 137–138

v=CirclePoints[5];
g=VertexColoredGraph[Graph[Range[5],UndirectedEdge@@@{e[1,2,3,4,5,1,3,5]},VertexCoordinates->v,VertexLabels->Automatic]]

ColorIdentityGraphQ[g]

UniquelyColorableGraphQ[g,Debug->True]

Length[tup=Tuples[Range[3],VertexCount[g]]]

col=Select[tup,VertexColoringQ[g,#]&]

ColorPartitions/@col//Union

DeleteDuplicatesBy[col,IGBlissCanonicalGraph[{g,"VertexColors"->#}]&]

VertexColoredGraph[g,#,VertexSize->Small]&/@col

Bipartite Connected

AllTrue[GraphData[{"Connected","Bipartite"},;;12],UniquelyColorableGraphQ[GraphData[#]]&]//Timing

Chao G6

g6=IndexGraph@Graph[Range[0,5],UndirectedEdge@@@{e[4,2,5,3,0,2],e[0,4,1,3],e[1,5,0]},VertexCoordinates->{{1/2,1},{5/2,1},{1,0},{3,0},{0,0},{2,0}},VertexLabels->Automatic]

RecognizeGraph@g6

ColorIdentityGraphQ[g6]

UniquelyColorableGraphQ[g6,Debug->True]//Timing

g=VertexColoredGraph[Annotate[g6,VertexSize->Small]]

Length[tup=Tuples[Range[3],VertexCount[g6]]]

(col=Select[tup,VertexColoringQ[g6,#]&])//Timing

DeleteDuplicatesBy[col,IGBlissCanonicalGraph[{g6,"VertexColors"->#}]&]

ColorPartitions/@col//Union//Column

Annotate[VertexColoredGraph[g6,#],{VertexSize->Medium,ImageSize->Small,VertexLabels->Automatic}]&/@col

Chao H7

h7=IndexGraph@Graph[Range[0,6],UndirectedEdge@@@{e[0,4,6,3,1,4,2,5,3,0,2,6],e[1,5,0]},VertexCoordinates->{{1/2,1},{5/2,1},{1,0},{3,0},{0,0},{2,0},{3/2,-1}},VertexLabels->Automatic]

RecognizeGraph@h7

ColorIdentityGraphQ[h7]

UniquelyColorableGraphQ[h7,Debug->True]//Timing

VertexColoredGraph[h7]

Length[tup=Tuples[Range[3],VertexCount[h7]]]

(col=Select[tup,VertexColoringQ[h7,#]&])//Timing

ColorPartitions/@col//Union//Column

Annotate[VertexColoredGraph[g6,#],{VertexSize->Medium,ImageSize->Small,VertexLabels->Automatic}]&/@col

SierpinskiGasket

VertexColoredGraph[Annotate[GraphData[#],VertexSize->{"Scaled",.02}]]&/@SortBy[GraphData["SierpinskiGasket"],GraphData[#,"V"]&]

UniquelyColorableGraphQ/@%

VertexColoredGraph[sg2=GraphData[{"SierpinskiGasket",2}]]

Length[tup=Tuples[Range[3],VertexCount[sg2]]]

(col=Select[tup,VertexColoringQ[sg2,#]&])//Timing

ColorPartitions/@col//Union//Column

Annotate[VertexColoredGraph[sg2,#],{VertexSize->Medium,ImageSize->Small,VertexLabels->Automatic}]&/@col

VertexColoredGraph[sg3=GraphData[{"SierpinskiGasket",3}]]

Length[tup=Tuples[Range[3],VertexCount[sg3]]]

(col=Select[tup,VertexColoringQ[sg3,#]&])//Timing

ColorPartitions/@col//Union//Column

Annotate[VertexColoredGraph[sg3,#],{VertexSize->Medium,ImageSize->Small,VertexLabels->Automatic}]&/@col

Wheel

wheels=Take[VertexColoredGraph[Annotate[GraphData[#],VertexSize->{"Scaled",.02}]]&/@SortBy[GraphData["Wheel"],GraphData[#,"V"]&],5]

UniquelyColorableGraphQ/@wheels

ColorIdentityGraphQ/@wheels

{"Wheel", 5}

ColorIdentityGraphQ[WheelGraph[5],Debug->True]

UniquelyColorableGraphQ[WheelGraph[5],Debug->True]

Length[tup=Tuples[Range[3],5]]

col=Select[tup,VertexColoringQ[WheelGraph[5],#]&]

ColorPartitions/@col//Union//Column

Grid[{#[[1,1]],GraphicsRow@#[[All,2]]}&/@SplitBy[SortBy[{ColorPartitions[#],Annotate[VertexColoredGraph[WheelGraph[5],#],{VertexSize->Medium,ImageSize->Small,VertexLabels->Automatic}]}&/@col,First],First],Dividers->All]

{"Wheel", 5}

<<MathWorld`Graphs`

g=GraphData[{"Wheel", 5}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

UniqueColorings == VertexColoringQ -> SymmetricGroup -> GroupOrbits

col=UniqueColorings[g,Debug->True]

VertexColoredGraph[g,#]&/@col

VertexColoringQ -> SymmetricGroup -> GroupOrbits

(col=Select[tuples,VertexColoringQ[g,#]&])//Timing

col=GroupOrbits[SymmetricGroup[chi],col,PermutationReplace][[All,1]]

col=GroupOrbits[grp,col,Permute][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col

VertexColoring -> GroupOrbits -> SymmetricGroup

col=Select[tuples,VertexColoringQ[g,#]&]

col2=GroupOrbits[grp,col,Permute][[All,1]]

col3=GroupOrbits[SymmetricGroup[3],col2,PermutationReplace][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col3

GraphAutomorphismGroup ->VertexColoring ->  SymmetricGroup

Length[orbits=GroupOrbits[grp,tuples,Permute][[All,1]]]//Timing

orbits2=GroupOrbits[SymmetricGroup[3],orbits,PermutationReplace][[All,1]]

(col=Select[orbits2,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"Wheel", 6}

ColorIdentityGraphQ[WheelGraph[6],Debug->True]

UniquelyColorableGraphQ[WheelGraph[6],Debug->True]

Length[tup=Tuples[Range[4],6]]

col=Select[tup,VertexColoringQ[WheelGraph[6],#]&]

ColorPartitions/@col//Union//Column

Grid[{#[[1,1]],GraphicsRow@#[[All,2]]}&/@SplitBy[SortBy[{ColorPartitions[#],Annotate[VertexColoredGraph[WheelGraph[6],#],{VertexSize->Large,ImageSize->Medium,VertexLabels->None}]}&/@col,First],First],Dividers->All]

{"Wheel", 6}

<<MathWorld`Graphs`

g=GraphData[{"Wheel", 6}]

n=VertexCount[g]

chi=VertexChromaticNumber[g]

Length[tuples=Tuples[Range[chi],n]]

grp=GraphAutomorphismGroup[g]

UniqueColorings == VertexColoringQ -> SymmetricGroup -> GroupOrbits

UniquelyColorableGraphQ[GraphData[{"Wheel", 6}]]

col=UniqueColorings[g,Debug->True]

VertexColoredGraph[g,#,VertexSize->.1]&/@col

VertexColoringQ -> SymmetricGroup -> GroupOrbits

(col=Select[tuples,VertexColoringQ[g,#]&])//Timing

col=GroupOrbits[SymmetricGroup[chi],col,PermutationReplace][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col

col=GroupOrbits[grp,col,Permute][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col

col=GroupOrbits[SymmetricGroup[chi],col,PermutationReplace][[All,1]]

VertexColoring -> GroupOrbits -> SymmetricGroup

col=Select[tuples,VertexColoringQ[g,#]&]

col2=GroupOrbits[grp,col,Permute][[All,1]]

col3=GroupOrbits[SymmetricGroup[3],col2,PermutationReplace][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col3

GraphAutomorphismGroup ->VertexColoring ->  SymmetricGroup

Length[orbits=GroupOrbits[grp,tuples,Permute][[All,1]]]//Timing

orbits2=GroupOrbits[SymmetricGroup[3],orbits,PermutationReplace][[All,1]]

(col=Select[orbits2,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

{"Dipyramid", 5}

{#,GraphData[#,"UniquelyColorable"]}&/@GraphData["Dipyramid"]

col=UniqueColorings[GraphData[{"Dipyramid",5}]]

VertexColoredGraph[GraphData[{"Dipyramid",5}],#,VertexSize->.3]&/@col

But the 2nd and third are the same flipping the graph horizontally and exchanging red <-> green

VertexColoringQ -> SymmetricGroup -> GroupOrbits

g=GraphData[{"Dipyramid",5}];

n=VertexCount[g]

grp=GraphAutomorphismGroup[g]

chi=VertexChromaticNumber[g]

tuples=Tuples[Range[chi],n];

Length[col=Select[tuples,VertexColoringQ[g,#]&]]//Timing

Length[col=GroupOrbits[SymmetricGroup[chi],col,PermutationReplace][[All,1]]]

col=GroupOrbits[grp,col,Permute][[All,1]]

VertexColoredGraph[g,#,VertexSize->.2]&/@col

GraphAutomorphismGroup ->VertexColoring ->  SymmetricGroup

Length[orbits=GroupOrbits[grp,tuples,Permute][[All,1]]]//Timing

orbits2=GroupOrbits[SymmetricGroup[chi],orbits,PermutationReplace][[All,1]];

(col=Select[orbits2,VertexColoringQ[g,#]&])//Timing

VertexColoredGraph[g,#,VertexSize->.2]&/@col

Algorithms

<<MathWorld`Graphs`

Automatic

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->Automatic]}&/@GraphData[;;7],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->Automatic]}&/@GraphData[;;8],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->Automatic]}&/@GraphData[;;9],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->Automatic]}&/@GraphData[;;10],gn],
{_,x_,x_}]//Timing

"AllTrue"

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"AllTrue"]}&/@GraphData[;;7],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"AllTrue"]}&/@GraphData[;;8],gn],
{_,x_,x_}]//Timing

"AllTrueReduced"

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"AllTrueReduced"]}&/@GraphData[;;7],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"AllTrueReduced"]}&/@GraphData[;;8],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"AllTrueReduced"]}&/@GraphData[;;9],gn],
{_,x_,x_}]//Timing

"CanonicalizeColoring"

Length[col=FindProperColorings[GraphData["IcosidodecahedralGraph"]]]

<<IGraphM`

canonicalizeColoring[vertexList_?ListQ][colors_]:=Sort[Sort/@IGMembershipToPartitions[vertexList,colors]]

canonicalizeColoring[graph_?GraphQ]:=canonicalizeColoring[VertexList[graph]]

DeleteDuplicatesBy[col,canonicalizeColoring[GraphData[{"Apollonian",2}]]]

DeleteDuplicatesBy[col,canonicalizeColoring[GraphData["IcosidodecahedralGraph"]]]

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],GraphData[#,"MinimumVertexColorings"],Method->"CanonicalizeColoring"]}&/@GraphData[;;8],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],GraphData[#,"MinimumVertexColorings"],Method->"CanonicalizeColoring"]}&/@GraphData[;;9],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],GraphData[#,"MinimumVertexColorings"],Method->"CanonicalizeColoring"]}&/@GraphData[10],gn],
{_,x_,x_}]//Timing

"IndependentVertexSets" [older preprocessing]

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"IndependentVertexSets"]}&/@GraphData[;;7],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"IndependentVertexSets"]}&/@GraphData[;;8],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"IndependentVertexSets"]}&/@GraphData[;;9],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"IndependentVertexSets"]}&/@GraphData[;;10],gn],
{_,x_,x_}]//Timing

"IndependentVertexSets"

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"IndependentVertexSets"]}&/@GraphData[;;8],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"IndependentVertexSets"]}&/@GraphData[;;9],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"IndependentVertexSets"]}&/@GraphData[;;10],gn],
{_,x_,x_}]//Timing

"UnionLength"

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"UnionLength"]}&/@GraphData[;;7],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"UniquelyColorable"],UniquelyColorableGraphQ[GraphData[#],Method->"UnionLength"]}&/@GraphData[;;8],gn],
{_,x_,x_}]//Timing

Embeddings

<<MathWorld`Graphs`

"NonuniquelyThreeColorableGraph1"

Names

GraphData["NonuniquelyThreeColorableGraph1","StandardName"]

GraphData["NonuniquelyThreeColorableGraph1","StandardNames"]

Primary

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

All

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

Configuration

GraphData["NonuniquelyThreeColorableGraph1","Configuration"]

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["NonuniquelyThreeColorableGraph1","EdgeList"]]

Default embedding

GraphPlot[GraphData["NonuniquelyThreeColorableGraph1","Edges"],GraphLayout->"SpringEmbedding"]

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

RecognizeGraph[g]

Degenerate

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

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

Perspective

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

Perspective construction

GraphData["NonuniquelyThreeColorableGraph1","Polyhedron"]

PolyhedronGraph[GraphData["NonuniquelyThreeColorableGraph1","Polyhedron"]]

Bilateral

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

Circular

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

Circular construction

GraphData["NonuniquelyThreeColorableGraph1","Hamiltonian"]

GraphData["NonuniquelyThreeColorableGraph1","LCF"]

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

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

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

gs=bilat

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

quad

Planar

GraphData["NonuniquelyThreeColorableGraph1","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["NonuniquelyThreeColorableGraph1","Circulant"]

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

Complement graph

GraphData["NonuniquelyThreeColorableGraph1","ComplementGraph","Name"]

Line graph

GraphData["NonuniquelyThreeColorableGraph1","Line"]

LineGraphQ[GraphData["NonuniquelyThreeColorableGraph1"]]//Timing

RootGraph

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

RootGraph[GraphData["NonuniquelyThreeColorableGraph1"]]

Halin

GraphData["NonuniquelyThreeColorableGraph1","Halin"]

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

Rigid

GraphData["NonuniquelyThreeColorableGraph1","Rigid"]

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

Flexible

GraphData["NonuniquelyThreeColorableGraph1","Flexible"]

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

LCF

GraphData["NonuniquelyThreeColorableGraph1","LCF"]

GraphData["NonuniquelyThreeColorableGraph1","HamiltonianCycleCount"]

GraphData["NonuniquelyThreeColorableGraph1","LCFSignature"]

GraphData["NonuniquelyThreeColorableGraph1","LCFNotations"]

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

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

UnitDistance

GraphData["NonuniquelyThreeColorableGraph1","UnitDistance"]

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

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

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

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

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

Matchstick

GraphData["NonuniquelyThreeColorableGraph1","Matchstick"]

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

3D default

Graph3D[GraphData["NonuniquelyThreeColorableGraph1","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["NonuniquelyThreeColorableGraph1","Polyhedral"]

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

"NonuniquelyThreeColorableGraph2"

Names

GraphData["NonuniquelyThreeColorableGraph2","StandardName"]

GraphData["NonuniquelyThreeColorableGraph2","StandardNames"]

Primary

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

All

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

Configuration

GraphData["NonuniquelyThreeColorableGraph2","Configuration"]

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["NonuniquelyThreeColorableGraph2","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

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

RecognizeGraph[g]

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

gs=UnlabelGraph/@{,,,,,}

Degenerate

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

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

Perspective

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

Perspective construction

GraphData["NonuniquelyThreeColorableGraph2","Polyhedron"]

PolyhedronGraph[GraphData["NonuniquelyThreeColorableGraph2","Polyhedron"]]

Bilateral

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

Circular

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

Circular construction

GraphData["NonuniquelyThreeColorableGraph2","Hamiltonian"]

GraphData["NonuniquelyThreeColorableGraph2","LCF"]

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

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

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

gs=bilat

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

quad

Planar

GraphData["NonuniquelyThreeColorableGraph2","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

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

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

GraphPlot@RotateGraph[,Pi/6]

EuclideanDistance@@v[[{7,8}]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

GraphPlot@

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

RecognizeGraph@g

RectilinearCrossingCount@g

Circulant

GraphData["NonuniquelyThreeColorableGraph2","Circulant"]

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

Complement graph

GraphData["NonuniquelyThreeColorableGraph2","ComplementGraph","Name"]

Line graph

GraphData["NonuniquelyThreeColorableGraph2","Line"]

LineGraphQ[GraphData["NonuniquelyThreeColorableGraph2"]]//Timing

RootGraph

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

RootGraph[GraphData["NonuniquelyThreeColorableGraph2"]]

Halin

GraphData["NonuniquelyThreeColorableGraph2","Halin"]

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

Rigid

GraphData["NonuniquelyThreeColorableGraph2","Rigid"]

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

Flexible

GraphData["NonuniquelyThreeColorableGraph2","Flexible"]

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

LCF

GraphData["NonuniquelyThreeColorableGraph2","LCF"]

GraphData["NonuniquelyThreeColorableGraph2","HamiltonianCycleCount"]

GraphData["NonuniquelyThreeColorableGraph2","LCFSignature"]

GraphData["NonuniquelyThreeColorableGraph2","LCFNotations"]

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

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

UnitDistance

GraphData["NonuniquelyThreeColorableGraph2","UnitDistance"]

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

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

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

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

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

Matchstick

GraphData["NonuniquelyThreeColorableGraph2","Matchstick"]

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

3D default

Graph3D[GraphData["NonuniquelyThreeColorableGraph2","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["NonuniquelyThreeColorableGraph2","Polyhedral"]

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

"NonuniquelyThreeColorableGraph3" [== "UniquelyThreeColorableGraph" prior to V14.1]

Names

GraphData["NonuniquelyThreeColorableGraph3","StandardName"]

GraphData["NonuniquelyThreeColorableGraph3","StandardNames"]

Primary

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

All

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

Configuration

GraphData["NonuniquelyThreeColorableGraph3","Configuration"]

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["NonuniquelyThreeColorableGraph3","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Perspective

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

Perspective construction

GraphData["NonuniquelyThreeColorableGraph3","Polyhedron"]

PolyhedronGraph[GraphData["NonuniquelyThreeColorableGraph3","Polyhedron"]]

Bilateral

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

Circular

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

Circular construction

GraphData["NonuniquelyThreeColorableGraph3","Hamiltonian"]

GraphData["NonuniquelyThreeColorableGraph3","LCF"]

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

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

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

gs=bilat

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

quad

gs=DeleteDuplicates@Join[quad,bilat]

Length[gs]

Planar

GraphData["NonuniquelyThreeColorableGraph3","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData["NonuniquelyThreeColorableGraph3"],"CrossingNumber"->cn,RandomSeed->i],{i,1000}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["NonuniquelyThreeColorableGraph3","Circulant"]

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

Complement graph

GraphData["NonuniquelyThreeColorableGraph3","ComplementGraph","Name"]

Line graph

GraphData["NonuniquelyThreeColorableGraph3","Line"]

LineGraphQ[GraphData["NonuniquelyThreeColorableGraph3"]]//Timing

RootGraph

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

RootGraph[GraphData["NonuniquelyThreeColorableGraph3"]]

Halin

GraphData["NonuniquelyThreeColorableGraph3","Halin"]

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

Rigid

GraphData["NonuniquelyThreeColorableGraph3","Rigid"]

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

Flexible

GraphData["NonuniquelyThreeColorableGraph3","Flexible"]

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

LCF

GraphData["NonuniquelyThreeColorableGraph3","LCF"]

GraphData["NonuniquelyThreeColorableGraph3","HamiltonianCycleCount"]

GraphData["NonuniquelyThreeColorableGraph3","LCFSignature"]

GraphData["NonuniquelyThreeColorableGraph3","LCFNotations"]

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

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

UnitDistance

GraphData["NonuniquelyThreeColorableGraph3","UnitDistance"]

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

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

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

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

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

Matchstick

GraphData["NonuniquelyThreeColorableGraph3","Matchstick"]

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

3D default

Graph3D[GraphData["NonuniquelyThreeColorableGraph3","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["NonuniquelyThreeColorableGraph3","Polyhedral"]

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

"UniquelyThreeColorableTriangleFreeGraph"

Names

GraphData["UniquelyThreeColorableTriangleFreeGraph","StandardName"]

GraphData["UniquelyThreeColorableTriangleFreeGraph","StandardNames"]

Primary

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

All

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

Configuration

GraphData["UniquelyThreeColorableTriangleFreeGraph","Configuration"]

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["UniquelyThreeColorableTriangleFreeGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Perspective

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

Bilateral

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

Circular

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

Circular construction

GraphData["UniquelyThreeColorableTriangleFreeGraph","Hamiltonian"]

GraphData["UniquelyThreeColorableTriangleFreeGraph","LCF"]

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

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

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

gs=bilat

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

quad

Planar

GraphData["UniquelyThreeColorableTriangleFreeGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

GraphPlot@RotateGraph[,2Pi/5]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["UniquelyThreeColorableTriangleFreeGraph","Circulant"]

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

Complement graph

GraphData["UniquelyThreeColorableTriangleFreeGraph","ComplementGraph","Name"]

Line graph

GraphData["UniquelyThreeColorableTriangleFreeGraph","Line"]

LineGraphQ[GraphData["UniquelyThreeColorableTriangleFreeGraph"]]//Timing

RootGraph

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

RootGraph[GraphData["UniquelyThreeColorableTriangleFreeGraph"]]

Halin

GraphData["UniquelyThreeColorableTriangleFreeGraph","Halin"]

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

Rigid

GraphData["UniquelyThreeColorableTriangleFreeGraph","Rigid"]

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

Flexible

GraphData["UniquelyThreeColorableTriangleFreeGraph","Flexible"]

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

LCF

GraphData["UniquelyThreeColorableTriangleFreeGraph","LCF"]

GraphData["UniquelyThreeColorableTriangleFreeGraph","HamiltonianCycleCount"]

GraphData["UniquelyThreeColorableTriangleFreeGraph","LCFSignature"]

GraphData["UniquelyThreeColorableTriangleFreeGraph","LCFNotations"]

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

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

UnitDistance

GraphData["UniquelyThreeColorableTriangleFreeGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

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

Matchstick

GraphData["UniquelyThreeColorableTriangleFreeGraph","Matchstick"]

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

3D default

Graph3D[GraphData["UniquelyThreeColorableTriangleFreeGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["UniquelyThreeColorableTriangleFreeGraph","Polyhedral"]

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

GraphData

GraphDataString

file=OpenWrite["~/uniquelycolorable.m"]

WriteString[file,GraphDataString[g,
"StandardName"->"UniquelyThreeColorableTriangleFreeGraph",
"Name"->"uniquely three\[Hyphen]colorable triangle\[Hyphen]free graph",
"Information"->"UniquelyColorableGraph",
"AlternateStandardNames"->{"Uniquely3ColorableTriangleFreeGraph"},
"Classes"->{"UniquelyColorable"},
Debug->True,
TimeConstraint->60
]]