Graph Cartesian Product

Author

Eric W. Weisstein
August 7, 2023

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

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

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

Special Cases

(Subscript[P, m])□(Subscript[P, n])≃ {"Grid", {m, n}}

TextGrid[data=Flatten[Table[{{m,n},"Grid"/.GraphData[c=CanonicalName[ToEntity@GraphCartesianProduct[PathGraph[Range[m]],PathGraph[Range[n]]]],"NotationRules"],c},{n,10},{m,n}],1],Dividers->All,Alignment->{{Decimal,Decimal,Left}}]

Cases[data,{x_,"Grid",y_}:>(y->x)]

(Subscript[P, m])□(Subscript[P, 2])≃ {"Ladder",m}

TextGrid[data=Table[{m,"Ladder"/.GraphData[c=CanonicalName[ToEntity@GraphCartesianProduct[PathGraph[Range[m]],PathGraph[Range[2]]]],"NotationRules"],c},{m,20}],Dividers->All,Alignment->{{Decimal,Decimal,Left}}]

Cases[data,{x_,"Ladder",y_}:>(y->x)]

(Subscript[C, m])□(Subscript[P, 2])≃ {"Prism",m}

TextGrid[data=Table[{m,"Prism"/.GraphData[c=CanonicalName[ToEntity@GraphCartesianProduct[CycleGraph[m],PathGraph[Range[2]]]],"NotationRules"],c},{m,3,20}],Dividers->All,Alignment->{{Decimal,Decimal,Left}}]

Cases[data,{x_,"Prism",y_}:>(y->x)]

(Subscript[C, m])□(Subscript[P, n])≃ {"StackedPrism",{m,n}}

TextGrid[data=DeleteCases[Flatten[Table[{{m,n},"StackedPrism"/.GraphData[c=CanonicalName@ToEntity@GraphCartesianProduct[CycleGraph[m],PathGraph[Range[n]]],"NotationRules"],c},{n,5},{m,3,10}],1],{_,_,_CanonicalName}],Dividers->All,Alignment->{{Decimal,Decimal,Left}}]//Quiet

Cases[data,{x_,"StackedPrism",y_}:>(y->x)]

(Subscript[C, m])□(Subscript[C, n])≃ {"TorusGrid",{m,n}}

TextGrid[data=Flatten[Table[{{m,n},"TorusGrid"/.GraphData[c=CanonicalName[ToEntity@GraphCartesianProduct[CycleGraph[m],CycleGraph[n]]],"NotationRules"],c},{n,3,10},{m,3,10}],1],Dividers->All,Alignment->{{Decimal,Decimal,Left}}]

Cases[data,{x_,"TorusGrid",y_}:>(y->x)]

(Subscript[S, m+1])□(Subscript[P, 2])≃ {"Book",m}

TextGrid[data=Table[{m,"Book"/.GraphData[c=CanonicalName[ToEntity@GraphCartesianProduct[StarGraph[m+1],PathGraph[{1,2}]]],"NotationRules"],c},{m,10}],Dividers->All,Alignment->{{Decimal,Decimal,Left}}]

Cases[data,{x_,"Book",y_}:>(y->x)]

(Subscript[S, m+1])□(Subscript[P, n])≃ {"StackedBook",{m,n}}

TextGrid[data=Flatten[Table[{{m,n},"StackedBook"/.GraphData[c=CanonicalName[ToEntity@GraphCartesianProduct[StarGraph[m+1],PathGraph[Range[n]]]],"NotationRules"],c},{n,10},{m,10}],1],Dividers->All,Alignment->{{Decimal,Decimal,Left}}]

Cases[data,{x_,"StackedBook",y_}:>(y->x)]

(Subscript[K, m])□(Subscript[K, n])≃ {"Rook", {m, n}}

TextGrid[data=Flatten[Table[{{m,n},"Rook"/.GraphData[c=CanonicalName[ToEntity@GraphCartesianProduct[System`CompleteGraph[m],System`CompleteGraph[n]]],"NotationRules"],c},{n,10},{m,n}],1],Dividers->All,Alignment->{{Decimal,Decimal,Left}}]

Cases[data,{x_,"Rook",y_}:>(y->x)]

(Underscript[(Subscript[P, 2])□… □(Subscript[P, 2]), ⏟]) == {"Hypercube", n}

TextGrid[data=Table[{n,"Hypercube"/.GraphData[c=CanonicalName[ToEntity@Nest[GraphCartesianProduct[PathGraph[{1,2}],#]&,System`Graph[{1},{}],n]],"NotationRules"],c},{n,10}],Dividers->All,Alignment->{{Decimal,Decimal,Left}}]

Cases[data,{x_,"Hypercube",y_}:>(y->x)]

Implementation

GraphProduct

GraphProduct[PathGraph[{1,2}],PathGraph[{1,2,3}],"Cartesian"]

bug(425318): GraphProduct could give nice (nondegenerate) embeddings

Graph@EdgeList[%]

Adjacency matrices

Hammack et al. (2016)

With[{G=PathGraph[{1,2}],H=PathGraph[{1,2,3}]},
IsomorphicGraphQ[
GraphProduct[G,H,"Cartesian"],
AdjacencyGraph[KroneckerProduct[AdjacencyMatrix[G],IdentityMatrix[VertexCount[H]]]+KroneckerProduct[IdentityMatrix[VertexCount[G]],AdjacencyMatrix[H]]]
]]

Timings

bug(413615): GraphComputation`GraphProduct[_, _, "Cartesian"] slowdown in V13

V12.2

$Version

g1=CompleteGraph[2];
g2=GraphData[{"Firecracker",{2,4}}]

RepeatedTiming[GraphComputation`GraphProduct[g1,g2,"Cartesian"]]//First

Length[gsv122=GraphData[{"Connected","UnitDistance"},;;100]]

gsv122={};

data122=Monitor[{g=#,Timing[GraphComputation`GraphProduct[CompleteGraph[2],GraphData[#],"Cartesian"]][[1]]}&/@gsv122,g];//Timing

data122={};

V13.0

$Version

g1=CompleteGraph[2];
g2=GraphData[{"Firecracker",{2,4}}]

RepeatedTiming[GraphComputation`GraphProduct[g1,g2,"Cartesian"]]//First

((0.001074248046875`)/(0.00037955078125`))

Length[gsv130=GraphData[{"Connected","UnitDistance"},;;100]]

data130=Monitor[{g=#,Timing[GraphComputation`GraphProduct[CompleteGraph[2],GraphData[#],"Cartesian"]][[1]]}&/@gsv130,g];//Timing

Take[data122,2]

Both

Complement[gsv122,gsv130]

Complement[gsv130,gsv122]

Length[gs=Intersection[gsv130,gsv122]]

ratios=Reverse@SortBy[{#1[[1]],#2[[3]]/#1[[3]]}&@@@Select[SplitBy[Sort[Join[{#,1,#2}&@@@data122,{#,2,#2}&@@@data130]],First],Length[#]==2&],Last];

Take[ratios,3]

ListPlot[Callout[#2,#1]&@@@Take[ratios,100]]

ListPlot[#2&@@@ratios]

Search

$Version

Length[ud100=GraphData[{"UnitDistance","Connected"},;;100]]

Length[ud1000=GraphData[{"UnitDistance","Connected"},;;1000]]

DiamondGraph□G

GraphData["DiamondGraph"]

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[GraphData["DiamondGraph"],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[GraphData["DiamondGraph"],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

GemGraph□G

GraphData["GemGraph"]

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[GraphData["GemGraph"],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[GraphData["GemGraph"],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[C, 3])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[CycleGraph[3],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[CycleGraph[3],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[C, 4])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[CycleGraph[4],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[CycleGraph[4],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[C, 5])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[CycleGraph[5],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[CycleGraph[5],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[P, 2])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[CompleteGraph[2],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[CompleteGraph[2],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[P, 3])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[PathGraph[Range[3]],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[PathGraph[Range[3]],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[P, 4])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[PathGraph[Range[4]],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[PathGraph[Range[4]],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[Q, 3])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[HypercubeGraph[3],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[Q, 4])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[HypercubeGraph[4],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[S, 3])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[StarGraph[3],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[StarGraph[3],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

(Subscript[S, 4])□G

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[StarGraph[4],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud100,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Monitor[Select[DeleteCases[{gn=#,RecognizeGraph[GraphCartesianProduct[StarGraph[4],GraphData[#]],"Cache"->"InternalOnly"]}&/@Take[ud1000,All],{_,{}}],GraphData[#[[2]],"UnitDistance"]=!=True&],gn]//Timing

Embeddings

<<MathWorld`Graphs`

"GraphCartesianProductOfK33AndK3"

Names

GraphData["GraphCartesianProductOfK33AndK3","StandardName"]

GraphData["GraphCartesianProductOfK33AndK3","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["GraphCartesianProductOfK33AndK3","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["GraphCartesianProductOfK33AndK3","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["GraphCartesianProductOfK33AndK3","Circulant"]

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

Line graph

GraphData["GraphCartesianProductOfK33AndK3","Line"]

LineGraphQ[GraphData["GraphCartesianProductOfK33AndK3"]]//Timing

RootGraph

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

RootGraph[GraphData["GraphCartesianProductOfK33AndK3"]]

Halin

GraphData["GraphCartesianProductOfK33AndK3","Halin"]

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

Rigid

GraphData["GraphCartesianProductOfK33AndK3","Rigid"]

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

Flexible

GraphData["GraphCartesianProductOfK33AndK3","Flexible"]

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

LCF

GraphData["GraphCartesianProductOfK33AndK3","LCF"]

GraphData["GraphCartesianProductOfK33AndK3","HamiltonianCycleCount"]

GraphData["GraphCartesianProductOfK33AndK3","LCFSignature"]

GraphData["GraphCartesianProductOfK33AndK3","LCFNotations"]

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

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

LCF compute all

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

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

DeleteCases[lcf,{_,1}]

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

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,XXX}]]}])//Timing

Length[gs]

UnitDistance

GraphData["GraphCartesianProductOfK33AndK3","UnitDistance"]

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

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

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

UnitDistance by refinement

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

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

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

GraphData["GraphCartesianProductOfK33AndK3","Matchstick"]

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

3D default

Graph3D[GraphData["GraphCartesianProductOfK33AndK3","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["GraphCartesianProductOfK33AndK3","Polyhedral"]

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