Integral Graph

Author

Eric W. Weisstein
December 11, 2017

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

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

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

Counts

All

A077027

1, 2, 3, 6, 10, 20, 33, 71, 121, 269, 492

Total[Boole[Get[#]]]&/@FileNames["*.m",FileNameJoin[{$GraphDataDirectory,"Nodes","Integral"}]]

Table[Total[Boole[IntegralGraphQ/@Graphs[n]]],{n,10}]//Timing

Table[Length@GraphData["Integral",n],{n,12}]

Connected

A064731

1, 1, 1, 2, 3, 6, 7, 22, 24, 83, 113

Table[Total[Boole[Get[FileNameJoin[{$GraphDataDirectory,"Nodes","Integral","Integral_"<>If[n<10,"0",""]<>ToString[n]<>".m"}]][[ConnectedGraphIndices[n]]]]],{n,10}]

Table[Total[Boole[IntegralGraphQ/@ConnectedGraphs[n]]],{n,10}]//Timing

Table[Length@GraphData[{"Connected","Integral"},n],{n,12}]

Disconnected

A287154

0, 1, 2, 4, 7, 14, 26, 49, 97, 186, 379

Table[Total[Boole[Get[FileNameJoin[{$GraphDataDirectory,"Nodes","Integral","Integral_"<>If[n<10,"0",""]<>ToString[n]<>".m"}]][[DisconnectedGraphIndices[n]]]]],{n,10}]

A077027={1,2,3,6,10,20,33,71,121,269,492};

A064731={1,1,1,2,3,6,7,22,24,83,113};

Length/@{A077027,A064731}

A077027-A064731

Table[Length@GraphData[{"Disconnected","Integral"},n],{n,12}]

Parametrized familes

Antiprism

Entity["Graph","Antiprism"]["Integral"]

Timing[Position[IntegralGraphQ/@AntiprismGraph/@Range[20],True]//Flatten]

Complete

Timing[Position[IntegralGraphQ/@CompleteGraph/@Range[30],True]//Flatten]

Cycle

Timing[Position[IntegralGraphQ/@Cycle/@Range[34],True]//Flatten]

Hangs for n = 36, 49

Timing[Position[IntegralGraphQ/@Cycle/@Range[36,48],True]//Flatten]

Empty

Timing[Position[IntegralGraphQ/@EmptyGraph/@Range[30],True]//Flatten]

Prism

Timing[Position[IntegralGraphQ/@PrismGraph/@Range[20],True]//Flatten]

Star

Position[IntegralGraphQ/@Star/@Range[37],True]//Flatten

Table[n^2+1,{n,6}]

Wheel

Timing[Position[IntegralGraphQ/@Wheel/@Range[40],True]//Flatten]

Graphics

All

ShowGraphArray[Flatten[Partition[#,6,6,{1,1},{}]&/@Map[RecognizeGraph,Take[i,5],{2}],1],
GraphicsSpacing->.3,
AspectRatio->1,
VertexStyle->Disk[.1],
VertexColor->Red]

Connected

Length/@(ic=Select[#,ConnectedQ]&/@i)

ShowGraphArray[Flatten[Partition[#,8,8,{1,1},{}]&/@Map[RecognizeGraph,DeleteCases[ic,{}],{2}],1],
VertexStyle->Disk[.1],
AspectRatio->1,
VertexColor->Red]

Checks

Machine

DeleteCases[Monitor[{g=#,GraphData[#,"Integral"],IntegralGraphQ[GraphData[#]]}&/@GraphData[;;10],g],{_,x_,x_}]//Timing

DeleteCases[Monitor[{g=#,GraphData[#,"Integral"],IntegralGraphQ[GraphData[#]]}&/@GraphData[;;100],g],{_,x_,x_}]//Timing

DeleteCases[Monitor[{g=#,GraphData[#,"Integral"],IntegralGraphQ[GraphData[#]]}&/@GraphData[;;1000],g],{_,x_,x_}]//Timing

DeleteCases[Monitor[{g=#,GraphData[#,"Integral"],IntegralGraphQ[GraphData[#]]}&/@GraphData[All],g],{_,x_,x_}]//Timing

Exact

<<MathWorld`Graphs`

DeleteCases[Monitor[{g=#,GraphData[#,"Integral"],IntegralGraphQ[GraphData[#],WorkingPrecision->∞]}&/@GraphData[;;10],g],{_,x_,x_}]//Timing

DeleteCases[Monitor[{g=#,GraphData[#,"Integral"],IntegralGraphQ[GraphData[#],WorkingPrecision->∞]}&/@GraphData[;;100],g],{_,x_,x_}]//Timing