Unigraphic Graph

Author

Eric W. Weisstein
January 20, 2024

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

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

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

Enumeration

<<MathWorld`Graphs`

All

A122423

Unigraphs[n_]:=Select[
SplitBy[Sort[MapIndexed[{Sort[VertexDegree[#]],#2[[1]]}&,Graphs[n]]],First],
Length[#]==1&][[All,1,2]]

Length/@Table[Unigraphs[n],{n,9}]

Length/@Table[GraphData["Unigraphic",n],{n,10}]

Table[
Count[
Split[Sort[Hash/@ToExpression/@Import["/Users/eww/Documents/Mathematica/Paclets/GraphData/Nodes/DegreeSequence/DegreeSequence_"<>If[n<10,"0",""]<>ToString[n]<>".m","Lines"]]],
_?(Length[#]==1&)
],{n,10}]

seq=Cases[Import["https://oeis.org/A122423/b122423.txt","Table"],{_Integer?Positive,n_Integer}:>n]

Table[SimpleGraphCount[n],{n,10}]-seq

Complement[RecognizeGraph/@Graphs[5][[Unigraphs[5]]],GraphData["Unigraphic",5]]

GraphData[{"Cycle",5},"Unigraphic"]

GraphData["Unigraphic",5]

Connected

ConnectedUnigraphs[n_]:=Module[
{
gs=Select[
SplitBy[Sort[MapIndexed[{Sort[VertexDegree[#]],#2[[1]]}&,Graphs[n]]],First],
Length[#]==1&
]
},
Select[Graphs[n][[gs[[All,1,2]]]],ConnectedGraphQ]
]

Length/@Table[ConnectedUnigraphs[n],{n,9}]

Length/@Table[GraphData[{"Connected","Unigraphic"},n],{n,9}]

SetDirectory["/Users/eww/Documents/Mathematica/Paclets/GraphData/Nodes/DegreeSequence"]

Length/@Table[
Intersection[
Select[SplitBy[SortBy[MapIndexed[{#,#2[[1]]}&,Hash/@ToExpression/@Import["/Users/eww/Documents/Mathematica/Paclets/GraphData/Nodes/DegreeSequence/DegreeSequence_"<>If[n<10,"0",""]<>ToString[n]<>".m","Lines"]],First],First],Length[#]==1&][[All,1,2]],
ConnectedGraphIndices[n]],{n,10}]

Connected graphs that have distinct degree sequences among all connected graphs with n nodes

A309757

Number of connected graphs that have distinct degree sequences among all connected graphs with n nodes.

UnigraphsAmongConnectedGraphs[n_]:=Select[
SplitBy[Sort[MapIndexed[{Sort[VertexDegree[#]],#2[[1]]}&,ConnectedGraphs[n]]],First],
Length[#]==1&
][[All,1,2]]

seq=Cases[Import["https://oeis.org/A309757/b309757.txt","Table"],{_Integer?Positive,n_Integer}:>n]

Length/@Table[UnigraphsAmongConnectedGraphs[n],{n,9}]

Regular Unigraph

Tyshkevich 2000

https://doi.org/10.1016/S0012-365X(99)00381-7

RecognizeGraph/@GraphComplement/@Table[LadderRungGraph[n],{n,7}]

GraphData[{"Regular","Unigraphic"}]

Complement of a Unigraph is a Unigraph

DeleteCases[{#,GraphData[#,"Unigraphic"]}&/@Select[GraphData[#,"ComplementGraph","Name"]&/@GraphData["Unigraphic"],DataPaclets`GraphDataDump`MyGraphQ],{_,True}]

Parametrized families

Alkane

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

FindSequenceFunction[seq,n]

AlternatingGroupGraph

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

Andrasfai

seq=Table[GraphData[{"Andrasfai",n},"Unigraphic"],{n,10}]

FindSequenceFunction[seq,n]

FindGeneratingFunction[seq,x]//FullSimplify

Antelope n×n

seq=Table[GraphData[{"Antelope",{n,n}},"Unigraphic"],{n,15}]

Antiprism

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

Inferred for n == 17, 19, 22, 23 (?):

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

Table[GraphData[{"Antiprism",n},"CodegreeSequenceGraphNames"],{n,3,25}]//Column

Apollonian

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

FindSequenceFunction[seq,n]

Barbell

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

FindSequenceFunction[seq,n]

BlackBishop n×n

seq=Table[GraphData[{"BlackBishop",{n,n}},"Unigraphic"],{n,10}]

FullSimplify[FindSequenceFunction[Rest@seq,n-1],n∈Integers]

Bishop n×n

seq=Table[GraphData[{"Bishop",{n,n}},"Unigraphic"],{n,10}]

Book

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

FindSequenceFunction[seq,n]

Bruhat

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

FindSequenceFunction[seq,n]

Camel n×n

seq=Table[GraphData[{"Camel",{n,n}},"Unigraphic"],{n,10}]

Centipede

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

FindSequenceFunction[seq,n]

CocktailParty

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

Complete

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

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

CompleteBipartite m×n

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

CompleteBipartite n×n

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

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

FindSequenceFunction[seq,n]//FullSimplify

CompleteTripartite k×m×n

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

CompleteTripartite n×n×n

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

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

CrossedPrism

seq=Table[GraphData[{"CrossedPrism",2n},"Unigraphic"],{n,2,10}]

Crown

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

Table[GraphData[{"Crown",n},"CodegreeSequenceGraphNames"],{n,20}]//Column

CubeConnectedCycle

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

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

Table[GraphData[{"CubeConnectedCycle",n},"CodegreeSequenceGraphs","Name"]//First,{n,3,8}]

Cycle

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

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

CycleComplement

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

Table[GraphData[{"CycleComplement",n},"CodegreeSequenceGraphNames"],{n,3,20}]//Column

DiagonalIntersection

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

Dipyramid

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

DoubleCone

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

Empty

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

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

FibonacciCube

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

Flower

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

FoldedCube

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

Gear

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

Giraffe n×n

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

Goldberg

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

Grid m×n

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

Grid n×n

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

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

Grid k×m×n

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

Sort@Flatten[Table[{
{k,m,n},
GraphData[{"Grid",{k,m,n}},"Unigraphic"],
(((k+m+n) (k m n-1))/(3 k m n))
},{n,5},{m,n},{k,m}],2]

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

Grid n×n×n

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

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

HalvedCube

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

Hanoi

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

Helm

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

Hypercube

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

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

Keller

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

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

King n×n

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

Knight m×n

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

Knight n×n

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

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

Ladder

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

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

FindSequenceFunction[seq,n]//Factor

LadderRung

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

LucasCube

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

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

MengerSponge

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

MoebiusLadder

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

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

Mycielski

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

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

Odd

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

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

Pan

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

Path

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

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

Table[GraphData[{"Path",n},"CodegreeSequenceGraphNames"],{n,20}]//Column

Equal@@@Table[
{Sort[VertexDegree[PathGraph[Range[n]]]],Sort[VertexDegree[GraphDisjointUnion[CycleGraph[3],PathGraph[Range[n-3]]]]]},
{n,5,20}]

PathComplement

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

Table[GraphData[{"PathComplement",n},"CodegreeSequenceGraphNames"],{n,20}]//Column

Pell

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

Prism

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

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

Table[Take[GraphData[{"Prism",n},"CodegreeSequenceGraphNames"],UpTo[10]],{n,3,25}]//Column

Queen n×n

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

Rook n×n

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

RookComplement n×n

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

SierpinskiCarpet

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

FindSequenceFunction[seq,n]

SierpinskiGasket

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

FindSequenceFunction[seq,n]

SierpinskiTetrahedron

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

FindSequenceFunction[seq,n]

Spoke n×n

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

FindSequenceFunction[seq,n]

StackedBook

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

StackedPrism

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

Star

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

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

Sun

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

Sunlet

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

TorusGrid n×n

seq=Table[GraphData[{"TorusGrid",{n,n}},"Unigraphic"],{n,3,10}]

Transposition

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

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

Trapezohedron

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

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

FullSimplify[FindSequenceFunction[seq,n-2],n∈Integers]

Triangular

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

TriangularGrid

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

FindSequenceFunction[seq,n+1]//FullSimplify

TriangularHoneycombAcuteKnight

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

TriangularHoneycombBishop

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

FindSequenceFunction[seq,n]//Factor

TriangularHoneycombObtuseKnight

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

TriangularHoneycombQueen

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

FindSequenceFunction[seq,n]

TriangularHoneycombRook

seq=Table[GraphData[{"TriangularHoneycombRook",n},"Unigraphic"],{n,10}]

TriangularSnake

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

Web

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

Wheel

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

Inferred for n == 12, 14, 18, 20 (?):

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

Table[GraphData[{"Wheel",n},"CodegreeSequenceGraphNames"],{n,4,20}]//Column

WheelComplement

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

WhiteBishop n×n

seq=Table[GraphData[{"WhiteBishop",{n,n}},"Unigraphic"],{n,2,10}]

Zebra n×n

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

GraphData

5

(uni=Select[RecognizeGraph /@ Graphs[5][[Unigraphs[5]]], DataPaclets`GraphDataDump`MyGraphQ])//Timing

l=Join[
{#,{0,True}}&/@uni,
{#,{0,False}}&/@Complement[GraphData[5],uni]
]

6

Graphs[6]//Length//Timing

(l=With[{n=6},
uni=Select[RecognizeGraph /@ Graphs[n][[Unigraphs[n]]], DataPaclets`GraphDataDump`MyGraphQ];
Join[
{#,{0,True}}&/@uni,
{#,{0,False}}&/@Complement[GraphData[n],uni]
]
])//Timing

7

Graphs[7]//Length//Timing

(l=With[{n=7},
uni=Select[RecognizeGraph /@ Graphs[n][[Unigraphs[n]]], DataPaclets`GraphDataDump`MyGraphQ];
Join[
{#,{0,True}}&/@uni,
{#,{0,False}}&/@Complement[GraphData[n],uni]
]
])//Timing

8

Graphs[8]//Length//Timing

(l=With[{n=8},
uni=Select[RecognizeGraph /@ Graphs[n][[Unigraphs[n]]], DataPaclets`GraphDataDump`MyGraphQ];
Join[
{#,{0,True}}&/@uni,
{#,{0,False}}&/@Complement[GraphData[n],uni]
]
])//Timing

9

Graphs[9]//Length//Timing

(l=With[{n=9},
uni=Select[RecognizeGraph /@ Graphs[n][[Unigraphs[n]]], DataPaclets`GraphDataDump`MyGraphQ];
Join[
{#,{0,True}}&/@uni,
{#,{0,False}}&/@Complement[GraphData[n],uni]
]
])//Timing

10

<<MathWorld`Graphs`

Graphs[10]//Length//Timing

(l=With[{n=10},
uni=Select[RecognizeGraph /@ Graphs[n][[Unigraphs[n]]], DataPaclets`GraphDataDump`MyGraphQ];
Join[
{#,{0,True}}&/@uni,
{#,{0,False}}&/@Complement[GraphData[n],uni]
]
])//Timing

Fillin

MissingFillin[l,"Unigraphic","14.0"]

RenameGraphFiles[]

l2=Cases[l,{gn_,{_,True}}:>{gn,{0,{}}}]

PropertyReplace[l2,"CodegreeSequenceGraphNames","14.0"]