Cospectral Graphs

Author

Eric W. Weisstein
January 27, 2008

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

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

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

Code

GroupedIsospectralGraphs[n_]:=Module[{s={Spectrum[#],#}&/@Graphs[n]},
Map[{#[[1,1]],Last/@#}&,
Select[
Split[
Sort[s,OrderedQ[{First[#1],First[#2]}]&],
First[#1]==First[#2]&],
Length[#]>1&],
{1}]
]

IsospectralGraphs[n_]:=Module[{},
Select[
Split[Sort[Spectrum/@Graphs[n]]],
Length[#]>1&]
]

Two Graphs with the Same spectrum

ShowGraphArray[CircularEmbedding/@{g1,g2},
VertexStyle->Disk[.05],
VertexColor->Red,
GraphicsSpacing->.7]

Spectrum/@{g1=GraphUnion[Cycle[4],CompleteGraph[1]],g2=Star[5]}

Spectrum/@{g1=GraphUnion[Cycle[4],CompleteGraph[1]],g2=Star[5]}

IsomorphicQ[g1,g2]

Systematic Enumeration

GraphData

cosp=SortBy[Union[Sort[Append[GraphData[#,"CospectralGraphNames"],#]]&/@Select[GraphData[All],GraphData[#,"CospectralGraphNames"]=!={}&]],GetGraphData[#[[1]],"VertexCount"]&];//Timing

Select[cosp,Union[#]=!=#&]

TableForm[Prepend[#,GetGraphData[#[[1]],"VertexCount"]]&/@cosp,TableDepth->2]

3 nodes

GraphData["NotDeterminedBySpectrum",3]

IsospectralGraphs[3]

4 nodes

GraphData["NotDeterminedBySpectrum",4]

GraphData[%[[1]],"CospectralGraphNames"]

IsospectralGraphs[4]

5 nodes

GraphData["NotDeterminedBySpectrum",5]

iso5=GroupedIsospectralGraphs[5]

Count[Length/@IsospectralGraphs[5],#]&/@Range[5]

6 nodes

GraphData["NotDeterminedBySpectrum",6]

iso6=IsospectralGraphs[6];//Timing

Count[Length/@iso6,#]&/@Range[10]

%.Range[10]

Last/@iso6

ShowGraphArray[Transpose[Last/@Join[iso5,iso6]]]

7 nodes

iso7=IsospectralGraphs[7];//Timing

Count[Length/@iso7,#]&/@Range[10]

%.Range[10]

ShowGraphArray[Transpose[Last/@Select[iso7,Length[Last[#]]==3&]]]

8 nodes

iso8=IsospectralGraphs[8];//Timing

Count[Length/@iso8,#]&/@Range[10]

%.Range[10]

9 nodes

iso9=IsospectralGraphs[9];//Timing

Count[Length/@iso9,#]&/@Range[15]

%.Range[15]

Flatten[iso9,1]//Length