Determined by Spectrum

Author

Eric W. Weisstein
April 10, 2024

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

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

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

Counts

https://oeis.org/A178925

https://doi.org/10.37236/258

Cospectral Graphs on 12 Vertices
A. E. Brouwer 
E. Spence
Elec. J. Combin,
Volume 16, Issue 1 (2009)

simple=Take[BFileSequence[000088],13]

mates=FromDigits/@DeleteCases[StringSplit[TextRecognize[],"\n"],""]

simple-mates

Fraction

DS

ListPlot[{1,2,4,11,32,146,933,10624,223629,9444562}/{1,2,4,11,34,156,1044,12346,274668,12005168},PlotStyle->Red]

NDS

ListPlot[1-{1,2,4,11,32,146,933,10624,223629,9444562}/{1,2,4,11,34,156,1044,12346,274668,12005168},PlotStyle->Red]

Special cases

van Dam and Haemers 2003, Table 5

(Subscript[C, 5])⊗(Subscript[J, k]) = (Subscript[Ci, 5k])(1,4,6,9,11,14,…,⌊5k/2⌋)

ds[n_]:=FromAdjacencyMatrix[KroneckerProduct[AdjacencyMatrix[Graph["C5"]],ConstantArray[1,n{1,1}]]//Normal]

Table[{n,RecognizeGraph[ds[n]]},{n,4}]

Table[CirculantIndices[ds[n]],{n,6}]//Timing

GraphData["C5","DS"]

Spectrum[g]//SpectrumForm//TraditionalForm

Print[GraphDataString[g,
"StandardName"->"XXX",
"Name"->"XXX",
"Classses"->{"DeterminedBySpectrum"},
"Information"->"DeterminedbySpectrum",
Debug->True,
TimeConstraint->120
]]

Cylc(13)

<<Utilities`Typesetting`

Select[GraphData[13],Count[GetGraphData[#,"Spectrum"],4]===1&]

{#,GraphData[#,"Spectrum"]//SpectrumForm}&/@%//Column//TraditionalForm

GraphData[{"Circulant",{13,{1,5}}},"Spectrum"]//SpectrumForm//TraditionalForm

(Subscript[K, 3,3])⊕(Subscript[K, 3])

g=GraphProduct[Graph["K3,3"],Graph["K3"]]

RecognizeGraph[g]

Spectrum[g]//SpectrumForm//TraditionalForm

Row[{Subscript["K",Row[{"3",",","3"}]],"⊕",Subscript["K","3"]}]

Print[GraphDataString[g,
"StandardName"->"GraphCartesianProductOfK33AndK3",
"Name"->"graph Cartesian product of K3,3 and K3",
"Classses"->{"DeterminedBySpectrum"},
"Information"->"DeterminedbySpectrum",
"Notation"->Row[{Subscript["K",Row[{"3",",","3"}]],"⊕",Subscript["K","3"]}],
Debug->True,
TimeConstraint->120
]]

Cylc(19)

l=Select[GraphData[19],Count[GetGraphData[#,"Spectrum"],6]===1&]

c=CirculantGraph[19,#]&/@(subs=Subsets[Floor[19/2]]);

l=Sort[Select[First/@FastIsomorphicSets[c],Count[Spectrum[c[[#]]],6]===1&]]

{subs[[#]],Spectrum[c[[#]]]//SpectrumForm}&/@l//Column//TraditionalForm

Spectrum[CirculantGraph[19, {1, 7, 8}]]//SpectrumForm//TraditionalForm

file=OpenWrite["ci19.m"]

WriteString[file,GraphDataString[CirculantGraph[19,{1,7,8}],
"Name"->"19-circulant graph (1,7,8)",
"StandardName"->{"Circulant",{19,{1,7,8}}},
"Classes"->{"DeterminedBySpectrum"},
"Skip"->{"ChromaticPolynomial","ClawFree","Perfect"},
"NotationRules"->{"Circulant"->{19,{1,7,8}}},
Debug->True,
TimeConstraint->120
]]

Close[file]

(OverBar[I])⊗(Subscript[J, 2])

GraphData["IcosahedralGraph","Notation"]

g=FromAdjacencyMatrix[KroneckerProduct[AdjacencyMatrix[GraphComplement[Graph["IcosahedralGraph"]]],ConstantArray[1,{2,2}]]//Normal]

RecognizeGraph[g]

Spectrum[g]//SpectrumForm//TraditionalForm

Print[GraphDataString[g,
"StandardName"->"KroneckerProductOfIcosahedralGraphComplementAndOnesMatrixJ2",
"Name"->"Kronecker product of the icosahedral graph complement and the ones matrix J2",
"Classses"->{"DeterminedBySpectrum"},
"Information"->"DeterminedbySpectrum",
Debug->True,
TimeConstraint->120
]]

(OverBar[L(Petersen)])⊗(Subscript[J, 2])

GraphData["PetersenGraph","Notation"]

GraphData["PetersenGraph","NotationRules"]

(OverBar[L(GP(5,2))])⊗(Subscript[J, 2])

CellPrint@Cell[BoxData[
 FormBox[
  RowBox[{
   OverscriptBox[
    RowBox[{"L", "(", 
     RowBox[{"GP", "(", 
      RowBox[{"5", ",", "2"}], ")"}], ")"}], "_"], "⊗", 
   SubscriptBox["J", "2"]}], TraditionalForm]], "Text"]

(OverBar[L(GP(5,2))])⊗(Subscript[J, 2])

Row[{
   Overscript[
    Row[{"L", "(", 
     Row[{"GP", "(", 
      Row[{"5", ",", "2"}], ")"}], ")"}],"_"], "⊗", 
   Subscript["J", "2"]}]//TraditionalForm

Row[{
   Overscript[
    Row[{"L", "(", 
     Row[{"GP", "(", 
      Row[{"5", ",", "2"}], ")"}], ")"}], _], "⊗", 
   Subscript["J", "2"]}]//TraditionalForm

g=FromAdjacencyMatrix[KroneckerProduct[AdjacencyMatrix[GraphComplement[LineGraph[Graph["PetersenGraph"]]]],ConstantArray[1,{2,2}]]//Normal]

RecognizeGraph[g]

Spectrum[g]//SpectrumForm//TraditionalForm

Print[GraphDataString[g,
"StandardName"->"KroneckerProductOfPetersenLineGraphComplementAndOnesMatrixJ2",
"Name"->"Kronecker product of the Petersen line graph complement and the ones matrix J2",
"Classses"->{"DeterminedBySpectrum"},
"Information"->"DeterminedbySpectrum",
Debug->True,
TimeConstraint->120
]]

van Dam and Haemers Table 2

FormatTable[{"C5",{"Paley",13},"ClebschGraph",{"Paley",17},"SchlaefliGraph","HoffmanSingletonGraph","GewirtzGraph","M22Graph",{"LocalGeneralizedQuadrangle",{3,9}},"HigmanSimsGraph",{"GeneralizedQuadrangle",{3,9}},"LocalMcLaughlinGraph","McLaughlinGraph"}]

van Dam and Haemers Table 3

FormatTable[{"IcosahedralGraph","HeawoodGraph","Qt31","Qt39","GH2,1",{"Incidence",{11,5,2}},{"Incidence",{11,6,3}},{"Cage",{4,6}},{"Incidence",{13,9,6}},"SylvesterGraph","HoffmanSingletonMinusStarGraph",{"Cage",{5,6}},{"Incidence",{21,16,12}},"GH3,1","PerkelGraph","GH1,5",{"Incidence",{31,25,20}},"GH4,1",{"Cage",{8,6}},{"Incidence",{57,49,42}},{"Cage",{9,6}},{"Incidence",{73,64,56}},"HoffmanSingletonLineGraph","GH5,1","GH7,1","TruncatedWittGraph","DoublyTruncatedBinaryGolayCodeCosetGraph","GH8,1","ExtendedTernaryGolayCodeCosetGraph","GH2,8","BinaryGolayCodeCosetGraph","GH8,2"}]

van Dam and Haemers Table 4

FormatTable[{"PappusGraph","DodecahedralGraph","CoxeterGraph","LeviGraph","IG(AG(2,4)\pc)","GO2,1","IG(AG(2,5)\pc)",{"Cage",{4,8}},"IG(AG(2,7)\pc)","BiggsSmithGraph","Tutte12Cage","IG(AG(2,8)\pc)","GO3,1",{"Cage",{5,8}},"GD2,1","DoublyTruncatedWittGraph","GO4,1","IvanovIvanovFaradjevGraph"}]

van Dam and Haemers Proposition 10

ci=Table[{"Circulant",{5n,Select[Range[5n/2],MemberQ[{1,4},Mod[#,5]]&]}},{n,5}]

FormatTable[ci]

van Dam and Haemers Table 5

<<Utilities`Typesetting`

FormatTable[{{"Circulant",{13,{1,5}}},"TwistedDoubleLineGraphOfK33","GraphCartesianProductOfK33AndK3","BCS179",{"Circulant",{19,{1,7,8}}},"TwoCoverOfComplementOfKroneckerProductOfC5AndOnesMatrixJ2","TwoCoverOfComplementOfKroneckerProductOfC6AndOnesMatrixJ2","KroneckerProductOfIcosahedralGraphComplementAndOnesMatrixJ2","KleinDistance2Graph",{"TwistedDoublePaley",13},"KroneckerProductOfPetersenLineGraphComplementAndOnesMatrixJ2",{"TwistedDoublePaley",17}}]

van Dam and Haemers Table 6

FormatTable[{"PetersenCone","IG(7,4,2)PlusCliquesOnBlocks","GraphOnPointsAndPlanesOfAG(3,2)","SwitchedLineGraphOfK55","SwitchLineGraphOfK9","GewirtzCone"}]

Rewrite files as polynomial lines

SetDirectory[FileNameJoin[{$GraphDataDirectory,"Nodes","CharacteristicPolynomial"}]]

CharacteristicPolynomial[AdjacencyMatrix[#],x]&/@Graphs[4]

Do[Export[file="CharacteristicPolynomial_"<>If[n<10,"0",""]<>ToString[n]<>".m",CharacteristicPolynomial[AdjacencyMatrix[#],x]&/@Graphs[n],"Lines"],{n,3}]

Do[Export[file="CharacteristicPolynomial_"<>If[n<10,"0",""]<>ToString[n]<>".m",#.x^Range[0,n]&/@(c=Get[file]),"Lines"],{n,6,10}]

Compute 1-10 nodes

Compute

$GraphData10Nodes=GraphData[;;10];

(valid[#]=True)&/@$GraphData10Nodes;
valid[_]=False;

$GraphDataIndexRules=Association[(Cases[GraphData[#,"StandardNames"],{_Integer,_Integer}][[1]]->#)&/@$GraphData10Nodes];

ComputeCharacteristic[n_]:=Module[
(* Import[...,"Lines"] takes > 50 GB on a 5 GB file, so use ReadList[..., String] *)
{groups={n,#}&/@#[[All,2]]&/@Select[SplitBy[Sort[MapIndexed[{#,#2[[1]]}&,Hash/@ReadList[FileNameJoin[{$GraphDataDirectory,"Nodes","CharacteristicPolynomial","CharacteristicPolynomial_"<>If[n<10,"0",""]<>ToString[n]<>".m"}],String]]],First],Length[#]>1&],
c,
indexedgroups,
definedindexedgroups
},
indexedgroups=(groups/.$GraphDataIndexRules);
definedindexedgroups=Pick[indexedgroups,valid/@Or@@#&/@indexedgroups];
Flatten[((First[#]->SortBy[Rest[#],First[Flatten[{#}]]&])&/@Pick[c=NestList[RotateRight,#,Length[#]-1],valid/@c[[All,1]]])&/@definedindexedgroups]
]

ComputeCharacteristic[5]

(cospec=Join@@Monitor[Table[ComputeCharacteristic[n],{n,10}],n])//Length//Timing

Sort[cospec[[All,1]]]

CospectralGraphNames

l={#1,{0,#3}}&@@@DeleteCases[{#1,GraphData[#1,"CospectralGraphNames"],#2}&@@@cospec,{_,x_,x_}]

PropertyReplace[l,"CospectralGraphNames","14.2"]

RenameGraphFiles[]

DeterminedBySpectrum === True

l2={#,{0,True}}&/@Select[Complement[GraphData[;;10],cospec[[All,1]]],GraphData[#,"DeterminedBySpectrum"]=!=True&]

MissingFillin[l2,"DeterminedBySpectrum"]

RenameGraphFiles[]

DeterminedBySpectrum === False

l3={#,{0,False}}&/@Select[cospec[[All,1]],GraphData[#,"DeterminedBySpectrum"]=!=False&]

MissingFillin[l3,"DeterminedBySpectrum"]

RenameGraphFiles[]

Compute >10 nodes

Compute

groups=SplitBy[Sort[{
Sort[{poly=Expand[GraphData[#,"CharacteristicPolynomial"][x]],-poly}][[1]],
#
}&/@Intersection[GraphData[11;;500],GraphData["CharacteristicPolynomial","Defined"]]],First];//Timing

cospec=Pick[groups,Length/@groups,Except[1,_Integer]][[All,All,2]]

CospectralGraphNames

new=DeleteCases[{First[#],GraphData[#[[1]],"CospectralGraphNames"],SortBy[Rest[#],First[Flatten[{#}]]&]}&/@Flatten[NestList[RotateRight,#,Length[#]-1]&/@cospec,1],{_,x_,x_}]

l={#1,{0,#3}}&@@@new

PropertyReplace[l,"CospectralGraphNames","14.2"]

RenameGraphFiles[]

DeterminedBySpectrum

l2={#,{0,False}}&/@Select[Flatten[cospec,1],GraphData[#,"DeterminedBySpectrum"]=!=False&]

MissingFillin[l2,"DeterminedBySpectrum"]

RenameGraphFiles[]