Bipartite Kneser Graph

Author

Eric W. Weisstein
February 1, 2023

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

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

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

Table

TextGrid[special=DeleteCases[Sort[Flatten[Table[{{n,k},BipartiteKneserGraph[n,k]//RecognizeGraph},{k,10},{n,2k,10}],1]],{_,{"BipartiteKneser",_}}],Dividers->All]

Embeddings

<<MathWorld`Graphs`

{"BipartiteKneser", {6, 2}}

GraphData[{"BipartiteKneser",{6,2}},"StandardName"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"BipartiteKneser",{6,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"BipartiteKneser",{6,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData[{"BipartiteKneser",{6,2}},"Graph","Degenerate"]

Bilateral

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

Circular

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

Planar

GraphData[{"BipartiteKneser",{6,2}},"Planar"]

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

MinimalCrossing

GraphData[{"BipartiteKneser",{6,2}},{"RCN","CN"}]

GraphData[{"BipartiteKneser",{6,2}},"Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

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

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

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"BipartiteKneser",{6,2}},"Circulant"]

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

Halin

GraphData[{"BipartiteKneser",{6,2}},"Halin"]

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

Rigid

GraphData[{"BipartiteKneser",{6,2}},"Rigid"]

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

Flexible

GraphData[{"BipartiteKneser",{6,2}},"Flexible"]

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

LCF

GraphData[{"BipartiteKneser",{6,2}},"LCF"]

GraphData[{"BipartiteKneser",{6,2}},"HamiltonianCycleCount"]

GraphData[{"BipartiteKneser",{6,2}},"LCFSignature"]

GraphData[{"BipartiteKneser",{6,2}},"LCFNotations"]

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

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

LCF compute random

ComputeRandomLCFNotation[{"BipartiteKneser",{6,2}},2,TimeConstraint->120]

lcf={{{-15,-13,7,13},{-13,-9,-5,3},{-15,-7,-3,9},{-13,-7,-5,3},{-9,-3,3,11},{-15,-11,7,9},{-7,-3,5,7},{-15,-7,-3,13},{-9,5,11,13},{-11,3,7,9}},3};

g=LCFGraph@@lcf

BilateralLCFGraph@g

LCF compute 10^5

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

MaxMemoryUsed[]/10.^9 "GB"

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]

LCF compute 1*^7

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

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1|2}]

lcf=Union[{{{{-15,-13,7,13},{-13,-9,-5,3},{-15,-7,-3,9},{-13,-7,-5,3},{-9,-3,3,11},{-15,-11,7,9},{-7,-3,5,7},{-15,-7,-3,13},{-9,5,11,13},{-11,3,7,9}},3}},
{{{{-13,-11,3,7},{-7,-5,7,11},{-7,-5,3,5},{-5,-3,5,7},{-11,-7,5,7},{-7,-3,11,13}},5},{{{-15,-13,-11,3},{-9,-3,5,11},{-11,-7,-3,9},{-15,-7,-5,-3},{-15,-7,3,13},{-15,-9,-7,7},{-5,7,9,13},{-13,-3,7,13},{-15,3,5,7},{-15,-13,3,11}},3},{{{-15,-13,-11,3},{-5,3,7,11},{-13,-11,-7,5},{-9,-5,-3,11},{-15,-11,-3,9},{-15,3,7,13},{-9,3,5,11},{-11,-5,9,13},{-13,-7,-3,5},{-15,-3,11,13}},3},{{{-15,-13,-11,3},{-3,3,5,13},{-13,-9,5,11},{-11,-7,-3,9},{-15,-13,-7,-3},{-15,-7,3,13},{-9,-5,3,7},{-5,7,9,13},{-13,-3,3,7},{-15,-3,11,13}},3},{{{-15,-13,-11,9},{-3,3,5,13},{-9,-5,3,11},{-15,-11,3,9},{-13,-5,-3,13},{-15,-9,-3,3},{-5,-3,3,9},{-13,5,11,13},{-15,-11,-3,3},{-9,-3,5,11}},3},{{{-15,-13,-9,3},{-15,3,7,9},{-9,-7,-3,11},{-11,-3,3,9},{-7,-5,-3,5},{-15,-9,-7,7},{-15,-3,3,9},{-9,7,11,13},{-11,-7,7,9},{-5,-3,3,5}},3},{{{-15,-13,-3,7},{-15,3,5,7},{-15,-13,3,13},{-9,-5,3,11},{-11,-3,5,9},{-15,-13,-3,13},{-15,-7,-5,-3},{-15,-7,3,13},{-13,-9,-7,5},{-5,7,9,13}},3},{{{-15,-13,-3,13},{-15,-5,-3,3},{-13,-9,-7,5},{-13,-7,5,9},{-9,-3,11,13},{-15,-11,7,9},{-15,3,5,7},{-13,-5,3,13},{-9,-5,3,11},{-11,-3,9,13}},3},{{{-15,-13,3,11},{-15,-11,-7,-3},{-13,-3,5,7},{-5,-3,3,5},{-9,-7,7,11},{-15,-11,-7,9},{-15,-9,-3,3},{-5,7,9,13},{-5,3,5,7},{-7,-3,3,13}},3},{{{-15,-13,5,13},{-5,7,11,13},{-11,-5,-3,3},{-13,-9,-7,11},{-13,-11,9,13},{-15,-5,-3,3},{5,7,11,13},{-13,-11,5,13},{-9,-7,-3,11},{-13,-11,3,9}},3},{{{-15,-13,5,13},{5,7,11,13},{-11,-5,-3,3},{-13,-9,5,11},{-13,-11,9,13},{-15,-5,-3,13},{-7,-5,3,13},{-13,5,11,13},{-13,-11,-7,-5},{-13,-3,3,7}},3},{{{-15,-11,-7,7},{-9,-3,3,11},{-11,-5,7,9},{-5,3,5,7},{-15,-7,-3,3},{-15,-9,3,11},{-11,-7,-3,9},{-7,-3,5,7},{-5,-3,3,5},{-15,-7,7,11}},3},{{{-15,-11,-7,7},{-5,-3,3,5},{-13,-9,3,11},{-11,3,7,9},{-9,-7,-3,5},{-15,-3,3,9},{-7,-5,-3,5},{-9,-7,7,11},{-11,-3,3,9},{-5,7,11,13}},3},{{{-15,-11,-7,9},{-3,5,7,13},{-9,-7,-3,5},{3,5,7,9},{-13,-9,-5,13},{-15,-7,7,9},{-9,-5,-3,11},{-13,-11,-5,9},{-7,-5,3,7},{-9,3,5,11}},3},{{{-15,-9,-7,7},{-5,7,9,13},{-15,-3,3,5},{-9,3,7,11},{-13,-11,3,9},{-15,-3,11,13},{-11,-3,5,13},{-15,-7,-5,-3},{-13,-9,-7,11},{-13,-11,3,9}},3},{{{-15,-9,-3,11},{-11,-5,-3,9},{-13,-7,3,5},{-15,-9,3,11},{-11,-5,3,9},{-15,-7,-3,7},{-3,3,5,11},{-11,-5,-3,3},{-15,-9,3,7},{-3,5,9,13}},3},{{{-15,-9,-3,13},{-3,5,9,13},{-7,-5,-3,5},{-13,-9,-7,5},{-13,-5,3,9},{-15,-9,7,11},{-11,-5,7,9},{-5,-3,3,5},{-9,-5,3,11},{-11,3,5,9}},3},{{{-15,-5,-3,13},{-9,-5,11,13},{-11,3,5,9},{-13,-7,-5,11},{-13,-11,-7,5},{-15,-3,5,13},{5,7,11,13},{-11,-5,3,7},{-13,-9,5,11},{-13,-11,-5,9}},3},{{{-13,-11,-5,3},{-13,-3,7,13},{-3,3,5,11},{-11,-5,-3,3},{-13,-7,3,5},{-9,-3,5,11},{-11,-3,9,13},{-5,-3,7,13},{-7,3,5,13},{-13,-5,3,11}},3}}];

l={{{"BipartiteKneser",{6,2}},{0,Missing["NotAvailable",lcf]}}}

PropertyReplace[l,"LCFNotations","13.3"]

RenameGraphFiles[]

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|2}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,XXX}]]}])//Timing

Length[gs]

UnitDistance

GraphData[{"BipartiteKneser",{6,2}},"UnitDistance"]

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"BipartiteKneser",{6,2}},"VertexList"],GraphData[{"BipartiteKneser",{6,2}},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"BipartiteKneser",{6,2}}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

Matchstick

GraphData[{"BipartiteKneser",{6,2}},"Matchstick"]

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

3D default

Graph3D[GraphData[{"BipartiteKneser",{6,2}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"BipartiteKneser",{6,2}},"Polyhedral"]

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

GraphDataString

Add {6, 2}

file=OpenWrite["~/bipartitekneser.m",PageWidth->Infinity]

Do[WriteString[file,GraphDataString[
BipartiteKneserGraph[n,k],
"Name"->"("<>ToString[n]<>","<>ToString[k]<>")-bipartite Kneser graph",
"StandardName"->{"BipartiteKneser",{n,k}},
"Skip"->{"Perfect"},
"Classes"->{"BipartiteKneser","EdgeTransitive","VertexTransitive","Hamiltonian","Traceable"},
"NotationRules"->{"BipartiteKneser"->{n,k}},
"Vertices"->None,
Debug->True,
TimeConstraint->60
]],{n,6,6},{k,2,2}]

Close[file]

Add

Do[Print[GraphDataString[
BipartiteKneserGraph[n,k],
"Name"->"("<>ToString[n]<>","<>ToString[k]<>")-bipartite Kneser graph",
"StandardName"->{"BipartiteKneser",{n,k}},
"Skip"->{"Perfect"},
"Classes"->{"BipartiteKneser","EdgeTransitive","VertexTransitive","Hamiltonian","Traceable"},
"NotationRules"->{"BipartiteKneser"->{n,k}},
"Vertices"->None,
TimeConstraint->60
]],{n,2,2},{k,Floor[n/2]}]

file=OpenWrite["~/bipartitekneser.m",PageWidth->Infinity]

Monitor[Do[WriteString[file,GraphDataString[
BipartiteKneserGraph[n,k],
"Name"->"("<>ToString[n]<>","<>ToString[k]<>")-bipartite Kneser graph",
"StandardName"->{"BipartiteKneser",{n,k}},
"Skip"->{"EdgeChromaticNumber","Perfect","Grid"},
"Classes"->{"BipartiteKneser","Symmetric","Hamiltonian","LineGraph"},
"NotationRules"->{"BipartiteKneser"->{n,k}},
"Vertices"->None,
TimeConstraint->10,
Debug->True
]],{n,2,2},{k,Floor[n/2]}],{"BipartiteKneser",{n,k}}]

Close[file]