Apollonian Network

Author

Eric W. Weisstein
September 2, 2022

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

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

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

Graphs

GraphData

GraphicsRow[Table[GraphData[{"Apollonian",n}]/.g_System`Graph:>SetProperty[g,{VertexSize->{"Scaled",.03},System`VertexStyle->Red,System`EdgeStyle->Black}],{n,4}],ImageSize->500]

Graphs.m

GraphicsRow[Table[ApollonianGraph[n,VertexSize->{"Scaled",.03},System`VertexStyle->Red,System`EdgeStyle->Black],{n,4}],ImageSize->500]

Special cases

GraphData["Apollonian"]

With[{prop="Apollonian"},TextGrid[Sort[{prop/.GraphData[#,"NotationRules"],GraphData[#,"Name"]}&/@DeleteCases[GraphData[prop],{prop,_}]],Dividers->All]]

Graphics

Graphics[ApollonianGasket[#]]&/@{0,2}

Table[Length[Split[Sort[Last/@Flatten[ApollonianGasket[n]]],Abs[#1-#2]<10.^-8&]],{n,6}]

RecognizeGraph[ApollonianGraph[#]]&/@Range[0,4]

{GraphPlot[ApollonianGraph[2],Method->None],GraphPlot[ApollonianGraph[2]]}

GraphicsGrid[{
Show[{Graphics[ApollonianGasket[#]],GraphPlot[ApollonianGraph[#],Method->None]}]&/@Range[0,2]},ImageSize->500]

With[{n=2},Show[{Graphics[{Blue,ApollonianGasket[n]}],GraphPlot[ApollonianGraph[n],Method->None]},PlotRange->{{-1,1},{-1.1,.9}},ImageSize->250]]

With[{n=2},GraphicsArray[{
gas=Graphics[{Blue,ApollonianGasket[n]}],
Show[{gas,GraphPlot[ApollonianGraph[n],Method->None]},PlotRange->{{-1,1},{-1.1,.9}}]},ImageSize->500]]

Embeddings

{"Apollonian", 2}

GraphData[{"Apollonian",2},"StandardName"]

All

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

All

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

Planar

GraphData[{"Apollonian",2},"Planar"]

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

MinimalCrossing

GraphData[{"Apollonian",2},{"RCN","CN"}]

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

MinimalCrossing Construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"Apollonian",2}]],-2Pi/3]

e[l__]:=Sequence@@Partition[{l},2,1]
v={{-1/2,0},{1/2,0},{-1/8,1/4},{1/8,1/4},{0,1/4},{0,1/2},{0,Sqrt[3]/2}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,7,1,5,2,4,5,3,1],e[3,6,4],e[7,6,5],e[1,6,2]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"Apollonian",2}]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData[{"Apollonian",2}],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot[RotateGraph[,-2Pi/3]]

e[l__]:=Sequence@@Partition[{l},2,1]

v={{-1,0},{1,0},{0,Sqrt[3]},{0,1/4},{0,1/2},{0,1},{1/4,1/2}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,4,2,7,6,2,5,1,6],e[3,6,5,4],{5,7}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Halin

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

LCF

GraphData[{"Apollonian",2},"LCFSignature"]

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

UnitDistance

GraphData[{"Apollonian",2},"UnitDistance"]

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

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

Matchstick

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

Default embedding

g=Graph@GraphData[{"Apollonian",2},"Edges"]

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

RecognizeGraph[g]

3D default

Graph3D[GraphData[{"Apollonian",2},"Edges"]]

3D All

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

3D Polyhedron

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

Graphics3D[{FaceForm[Green,Red],GraphData[{"Apollonian",2},"Polyhedron"]}]

3D Polyhedron canonical

Graphics3D[{Opacity[.5],Red,GraphData[{"Apollonian",2},"Polyhedron"],Yellow,Sphere[]}]

3D Polyhedron construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"Apollonian",2}],-1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->5000,PrecisionGoal->20])//Timing

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

SimplePolyhedronQ[can]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"Apollonian", 3}

GraphData[{"Apollonian",3},"StandardName"]

All

GraphData[{"Apollonian",3},"Graph","All"]//StyleGraphs

Halin

GraphData[{"Apollonian",3},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"Apollonian",3},"LCFSignature"]

GraphData[{"Apollonian",3},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"Apollonian",3},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Apollonian",3}],Debug->True]//Timing

GraphData[{"Apollonian",3},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"Apollonian",3},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"Apollonian",3},{"RCN","CN"}]

GraphData[{"Apollonian",3},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

g=Graph@GraphData[{"Apollonian",3},"Edges"]

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

RecognizeGraph[g]

MinimalCrossing Construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"Apollonian",3}]],-2Pi/3]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"Apollonian",3},"Edges"]]

3D All

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

3D Polyhedron

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

Graphics3D[{FaceForm[Green,Red],GraphData[{"Apollonian",3},"Polyhedron"]}]

3D Canonical

GraphData[{"Apollonian",3},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"Apollonian",3},"Polyhedron"],Yellow,Sphere[]}]

3D Polyhedron construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"Apollonian",3}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20,Debug->True,"ProgressInterval"->500])//Timing

can=Polyhedron[];

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,Debug->True,"ProgressInterval"->500])//Timing

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

SimplePolyhedronQ[can]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"Apollonian", 4}

GraphData[{"Apollonian",4},"StandardName"]

All

GraphData[{"Apollonian",4},"Graph","All"]//StyleGraphs

Halin

GraphData[{"Apollonian",4},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"Apollonian",4},"LCFSignature"]

GraphData[{"Apollonian",4},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"Apollonian",4},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Apollonian",4}],Debug->True]//Timing

GraphData[{"Apollonian",4},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"Apollonian",4},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"Apollonian",4},{"RCN","CN"}]

GraphData[{"Apollonian",4},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

g=Graph@GraphData[{"Apollonian",4},"Edges"]

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

RecognizeGraph[g]

MinimalCrossing Construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"Apollonian",4}]],-2Pi/3]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"Apollonian",4},"Edges"]]

3D All

GraphData[{"Apollonian",4},"Graph",{"3D","All"}]

3D Polyhedron

GraphData[{"Apollonian",4},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"Apollonian",4},"Polyhedron"]}]

3D Canonical

GraphData[{"Apollonian",4},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"Apollonian",4},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"Apollonian",4},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->4],Boxed->True]

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->1000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

can=Polyhedron[];

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->500,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

can=Polyhedron[];

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->200000,PrecisionGoal->20,"ProgressInterval"->500,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"Apollonian", 5}

GraphData[{"Apollonian",5},"StandardName"]

All

GraphData[{"Apollonian",5},"Graph","All"]//StyleGraphs

Halin

GraphData[{"Apollonian",5},"Graph","Halin"]//StyleGraphs

LCF

GraphData[{"Apollonian",5},"LCFSignature"]

GraphData[{"Apollonian",5},"Graph","LCF"]//StyleGraphs

UnitDistance

GraphData[{"Apollonian",5},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Apollonian",5}],Debug->True]//Timing

GraphData[{"Apollonian",5},"Graph","UnitDistance"]//StyleGraphs

Matchstick

GraphData[{"Apollonian",5},"Graph","Matchstick"]//StyleGraphs

MinimalCrossing

GraphData[{"Apollonian",5},{"RCN","CN"}]

GraphData[{"Apollonian",5},"Graph","MinimalCrossing"]//StyleGraphs

Default embedding

GraphPlot@GraphData[{"Apollonian",5},"Edges"]

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

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"Apollonian",5}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"Apollonian",5},"Edges"]]

3D All

GraphData[{"Apollonian",5},"Graph",{"3D","All"}]

3D UnitDistance

GraphData[{"Apollonian",5},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Apollonian",5},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"Apollonian",5},"Polyhedron"]}]

3D Canonical

GraphData[{"Apollonian",5},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"Apollonian",5},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"Apollonian",5}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->50,MaxIterations->5000,PrecisionGoal->20,"ProgressInterval"->500,"TangentFactor"->1/1000,"PlanarFactor"->1/1000,Debug->True])//Timing

Graphics3D[can]

(can=FindCanonicalPolyhedron[can,WorkingPrecision->50,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->1000,"TangentFactor"->1/1000,"PlanarFactor"->1/1000,Debug->True])//Timing

Graphics3D[can]

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

<<MathWorld`Graphs`

g=GraphData[{"Apollonian",5},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->4],Boxed->True]

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->50,MaxIterations->1000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/500,"PlanarFactor"->1/500,Debug->True])//Timing

Graphics3D[can]

(can=FindCanonicalPolyhedron[can,WorkingPrecision->50,MaxIterations->1000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/500,"PlanarFactor"->1/500,Debug->True])//Timing

Graphics3D[can]

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->500,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

(can=FindCanonicalPolyhedron[can,WorkingPrecision->100,MaxIterations->200000,PrecisionGoal->20,"ProgressInterval"->500,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"Apollonian", 6}

GraphData[{"Apollonian",6},"StandardName"]

All

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

Halin

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

LCF

GraphData[{"Apollonian",6},"LCFSignature"]

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

UnitDistance

GraphData[{"Apollonian",6},"UnitDistance"]

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

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

Matchstick

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

MinimalCrossing

GraphData[{"Apollonian",6},{"RCN","CN"}]

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

Default embedding

GraphPlot@GraphData[{"Apollonian",6},"Edges"]

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

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"Apollonian",6}],"CrossingNumber"->-1]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData[{"Apollonian",6},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

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

Graphics3D[{FaceForm[Green,Red],GraphData[{"Apollonian",6},"Polyhedron"]}]

3D Canonical

GraphData[{"Apollonian",6},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"Apollonian",6},"Polyhedron"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"Apollonian",6}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

Properties

<<MathWorld`Graphs`

Acyclic

Table[GraphData[{"Apollonian",n},"Acyclic"],{n,6}]

AdjacencyMatrixCount

seq=Table[GraphData[{"Apollonian",n},"AdjacencyMatrixCount"],{n,4}]

FullSimplify[((((1/2) (5+(3^n)))!)/6)]

Table[((((1/2) (5+(3^n)))!)/(Piecewise[{{24,n==1}},6])),{n,4}]

ArcTransitive

Table[GraphData[{"Apollonian",n},"ArcTransitive"],{n,6}]

ArcTransitivity

Table[GraphData[{"Apollonian",n},"ArcTransitivity"],{n,6}]

AutomorphismCount

Table[GraphData[{"Apollonian",n},"AutomorphismCount"],{n,6}]

BalabanIndex

Table[GraphData[{"Apollonian",n},"BalabanIndex"],{n,4}]

Bandwidth

Table[GraphData[{"Apollonian",n},"Bandwidth"],{n,6}]

BridgeCount

seq=Table[GraphData[{"Apollonian",n},"BridgeCount"],{n,6}]

BurningNumber

seq=Table[GraphData[{"Apollonian",n},"BurningNumber"],{n,6}]

CharacteristicPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"CharacteristicPolynomial"][x],{n,k0=1,kmax=6}])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

ChordlessCycleCount

seq=Table[GraphData[{"Apollonian",n},"ChordlessCycleCount"],{n,6}]

ChromaticInvariant

seq=Table[GraphData[{"Apollonian",n},"ChromaticInvariant"],{n,6}]

ChromaticNumber

seq=Table[GraphData[{"Apollonian",n},"ChromaticNumber"],{n,6}]

ChromaticPolynomial

Probably

Table[(((x-3))^((3^n-1)/2))(x-2)(x-1)x,{n,6}]//Column

(poly=Factor@Table[GraphData[{"Apollonian",n},"ChromaticPolynomial"][x],{n,k0=1,kmax=6}])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

Circumference

seq=Table[GraphData[{"Apollonian",n},"Circumference"],{n,6}]

FindSequenceFunction[seq,n]

FindSequenceFunction[Rest@seq,n-1]

Classes

Intersection@@(GraphData[#,"Classes"]&/@GraphData["Apollonian"])

CliqueCount

seq=Table[GraphData[{"Apollonian",n},"CliqueCount"],{n,6}]

FindSequenceFunction[seq,n]

(1/2) (((1+x))^3) (2+(-1+(3^n)) x)/.x->1

CliqueCoveringNumber

seq=Table[GraphData[{"Apollonian",n},"CliqueCoveringNumber"],{n,6}]

FindSequenceFunction[seq,n]

CliqueNumber

seq=Table[GraphData[{"Apollonian",n},"CliqueNumber"],{n,6}]

Coefficient[(1/2) (((1+x))^3) (2+(-1+(3^n)) x),x,Min]

...wrong...

CliquePolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"CliquePolynomial"][x],{n,k0=1,kmax=6}])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

ComplementOddChordlessCycleCount

seq=Table[GraphData[{"Apollonian",n},"ComplementOddChordlessCycleCount"],{n,6}]

ConnectedComponentCount

seq=Table[GraphData[{"Apollonian",n},"ConnectedComponentCount"],{n,6}]

ConnectedDominatingSetCount

seq=Table[GraphData[{"Apollonian",n},"ConnectedDominatingSetCount"],{n,6}]

FindSequenceFunction[seq,n-1]

ConnectedDominationNumber

seq=Table[GraphData[{"Apollonian",n},"ConnectedDominationNumber"],{n,6}]

FindSequenceFunction[seq,n]

ConnectedDominationPolynomial

(poly=Factor[Table[GraphData[{"Apollonian",n},"ConnectedDominationPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x]])//Column

coef=Factor/@FindLinearRecurrence[DeleteMissing@poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

Factor[Take[poly2-poly,kmax-k0-Count[poly,_Missing]+1]]

FullSimplify[poly2-poly]

ConnectedInducedSubgraphCount

seq=Table[GraphData[{"Apollonian",n},"ConnectedInducedSubgraphCount"],{n,6}]

FindSequenceFunction[DeleteMissing[seq],n]

ConnectedInducedSubgraphPolynomial

(poly=Factor[Table[GraphData[{"Apollonian",n},"CharacteristicPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x]])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

CrossingNumber

seq=Table[GraphData[{"Apollonian",n},"CrossingNumber"],{n,6}]

CycleCount

seq=Table[GraphData[{"Apollonian",n},"CycleCount"],{n,6}]

CyclePolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"CyclePolynomial"][x],{n,k0=1,kmax=6}])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

Cyclic

Table[GraphData[{"Apollonian",n},"Cyclic"],{n,6}]

CyclomaticNumber

seq=Table[GraphData[{"Apollonian",n},"CyclomaticNumber"],{n,6}]

FindSequenceFunction[seq,n]

DetourIndex

seq=Table[GraphData[{"Apollonian",n},"DetourIndex"],{n,6}]

DetourMatrix

MatrixForm/@Table[GraphData[{"Apollonian",n},"DetourMatrix"],{n,6}]

MatrixForm/@Table[SparseArray[{i_,j_}:>Abs[i-j],n],{n,6}]

DetourPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"DetourPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

Diameter

seq=Table[GraphData[{"Apollonian",n},"Diameter"],{n,6}]

(seq=Table[GraphDiameter[ApollonianGraph[n]],{n,7}])//Timing

(seq=Table[GraphDiameter[ApollonianGraph[n]],{n,8}])//Timing

DistanceMatrix

MatrixForm/@Table[GraphData[{"Apollonian",n},"DistanceMatrix"],{n,6}]

MatrixForm/@Table[SparseArray[{i_,j_}:>Abs[i-j],n],{n,6}]

DistancePolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"DistancePolynomial"][x],{n,k0=1,kmax=6}])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

DistinguishingNumber

seq=Table[GraphData[{"Apollonian",n},"DistinguishingNumber"],{n,6}]

DomaticNumber

seq=Table[GraphData[{"Apollonian",n},"DomaticNumber"],{n,5}]

DominatingSetCount

seq=Table[GraphData[{"Apollonian",n},"DominatingSetCount"],{n,6}]

DominationNumber

A291773

seq=Table[GraphData[{"Apollonian",n},"DominationNumber"],{n,6}]

(seq=Table[DominationNumber[ApollonianGraph[n]],{n,6}])//Timing

(seq=Table[DominationNumber[ApollonianGraph[n]],{n,7}])//Timing

(seq=Table[DominationNumber[ApollonianGraph[n]],{n,8}])//Timing

FindSequenceFunction[seq,n]

DominationPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"DominationPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

EdgeChromaticNumber

seq=Table[GraphData[{"Apollonian",n},"EdgeChromaticNumber"],{n,6}]

FindSequenceFunction[seq,n]

EdgeConnectivity

Table[GraphData[{"Apollonian",n},"EdgeConnectivity"],{n,6}]

EdgeCount

seq=Table[GraphData[{"Apollonian",n},"EdgeCount"],{n,6}]

FindSequenceFunction[seq,n]

EdgeCoverCount

seq=Table[GraphData[{"Apollonian",n},"EdgeCoverCount"],{n,6}]

EdgeCoverNumber

seq=Table[GraphData[{"Apollonian",n},"EdgeCoverNumber"],{n,6}]

FindSequenceFunction[seq,n]

gf=x FindGeneratingFunction[seq,x]

FullSimplify[SeriesCoefficient[gf,{x,0,n}],n>0]

EdgeCoverPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"EdgeCoverPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

EulerianCycleCount

seq=Table[GraphData[{"Apollonian",n},"EulerianCycleCount"],{n,6}]

FaceCount

seq=Table[GraphData[{"Apollonian",n},"FaceCount"],{n,6}]

FindSequenceFunction[seq,n]

FlowPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"FlowPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

FractionalChromaticNumber

seq=Table[GraphData[{"Apollonian",n},"FractionalChromaticNumber"],{n,6}]

FractionalEdgeChromaticNumber

seq=Table[GraphData[{"Apollonian",n},"FractionalEdgeChromaticNumber"],{n,6}]

FindSequenceFunction[seq,n]

Girth

seq=Table[GraphData[{"Apollonian",n},"Girth"],{n,6}]

Gonality

seq=Table[GraphData[{"Apollonian",n},"Gonality"],{n,6}]

HamiltonConnected

seq=Table[GraphData[{"Apollonian",n},"HamiltonConnected"],{n,6}]

HamiltonDecompositionCount

seq=Table[GraphData[{"Apollonian",n},"HamiltonDecompositionCount"],{n,6}]

Hamiltonian

Table[GraphData[{"Apollonian",n},"Hamiltonian"],{n,6}]

HamiltonianCycleCount

seq=Table[GraphData[{"Apollonian",n},"HamiltonianCycleCount"],{n,6}]

HamiltonianNumber

seq=Table[GraphData[{"Apollonian",n},"HamiltonianNumber"],{n,6}]

HamiltonianPathCount

seq=Table[GraphData[{"Apollonian",n},"HamiltonianPathCount"],{n,6}]

HamiltonianWalkCount

seq=Table[GraphData[{"Apollonian",n},"HamiltonianWalkCount"],{n,6}]

HararyIndex

seq=Table[GraphData[{"Apollonian",n},"HararyIndex"],{n,6}]

(seq=Table[HararyIndex[ApollonianGraph[n]],{n,7}])//Timing

FindSequenceFunction[seq,n]

gf=x FindGeneratingFunction[seq,x]

HexagonCount

seq=Table[GraphData[{"Apollonian",n},"HexagonCount"],{n,6}]

(seq=Table[CycleCount[ApollonianGraph[n],6],{n,7}])//Timing

FindSequenceFunction[seq,n]

FindSequenceFunction[Rest@seq,n-1]

gf=(x^2)FindGeneratingFunction[Rest@seq,x]

IdiosyncraticPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"IdiosyncraticPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x,y])//Column

coef=Factor/@FindLinearRecurrence[DeleteMissing@poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

IndependenceNumber

seq=Table[GraphData[{"Apollonian",n},"IndependenceNumber"],{n,6}]

FindSequenceFunction[seq,n]

IndependencePolynomial

(poly=Table[GraphData[{"Apollonian",n},"IndependencePolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x])//Column

coef=Factor/@FindLinearRecurrence[DeleteMissing@poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

IndependenceRatio

seq=Table[GraphData[{"Apollonian",n},"IndependenceRatio"],{n,6}]

FullSimplify[((3^(-1+n))/((1/2) (5+(3^n))))]

Table[((2 (3^(-1+n)))/(5+(3^n))),{n,6}]

(seq=Table[((IndependenceNumber[ApollonianGraph[n]])/((1/2) (5+(3^n)))),{n,7}])//Timing

FindSequenceFunction[seq,n]

IndependentEdgeSetCount

A292429

seq=Table[GraphData[{"Apollonian",n},"IndependentEdgeSetCount"],{n,6}]

IndependentVertexSetCount

=== MaximalIndependentVertexSetCount (n-1)

A289021

seq=Table[GraphData[{"Apollonian",n},"IndependentVertexSetCount"],{n,6}]

{1,3}.#&/@NestList[{Total[##^3],#[[1]]#[[2]]^2}&,{1,1},6]

{1,3}.#&/@NestList[Function[{t,u},{t^3+u^3,t u^2}]@@#&,{1,1},6]

Looks like it should be related to the IndependencePolynomial, but not directly anyway...

{1,3x}.#&/@NestList[{#[[1]]^3+#[[2]]^3x,#[[1]]#[[2]]^2}&,{x,1},3]//Factor//Column

seq=Table[GraphData[{"Apollonian",n},"IndependencePolynomial"][x],{n,3}]//Column//Factor

seq=Table[GraphData[{"Apollonian",n},"IndependentVertexSetCount"],{n,6}]

FindSequenceFunction[DeleteMissing@seq,n]

IntersectionNumber

seq=Table[GraphData[{"Apollonian",n},"IntersectionNumber"],{n,6}]

KirchhoffIndex

seq=Table[GraphData[{"Apollonian",n},"KirchhoffIndex"],{n,6}]

FindSequenceFunction[seq,n]

KirchhoffSumIndex

seq=Table[GraphData[{"Apollonian",n},"KirchhoffSumIndex"],{n,6}]

LaplacianMatrix

MatrixForm/@Table[GraphData[{"Apollonian",n},"LaplacianMatrix"],{n,10}]

LaplacianPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"LaplacianPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

LeafCount

seq=Table[GraphData[{"Apollonian",n},"LeafCount"],{n,6}]

LongestCycleCount

seq=Table[GraphData[{"Apollonian",n},"LongestCycleCount"],{n,6}]

LovaszNumber

seq=Table[GraphData[{"Apollonian",n},"LovaszNumber"],{n,6}]

MatchingGeneratingPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"MatchingGeneratingPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

MatchingNumber

seq=Table[GraphData[{"Apollonian",n},"MatchingNumber"],{n,6}]

(seq=Table[MatchingNumber[ApollonianGraph[n]],{n,7}])//Timing

FindSequenceFunction[seq,n]

FindSequenceFunction[Rest@seq,n-1]

MatchingPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"MatchingPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

MaximalCliqueCount

A003462

seq=Table[GraphData[{"Apollonian",n},"MaximalCliqueCount"],{n,6}]

FindSequenceFunction[seq,n]

FindLinearRecurrence[seq]

seq=LinearRecurrence[{4,-2},{1,4},{0,20}]

FindGeneratingFunction[seq,x]

CoefficientList[Series[(x/(1-4 x+3 (x^2))),{x,0,20}],x]

MaximalIndependentEdgeSetCount

seq=Table[GraphData[{"Apollonian",n},"MaximalIndependentEdgeSetCount"],{n,6}]

MaximalIndependentVertexSetCount

===IndependentVertexSetCount(n+1)

A289021

seq=Table[GraphData[{"Apollonian",n},"MaximalIndependentVertexSetCount"],{n,6}]

seq={4,5,15,845,403227665,64175114443109790962237345,264288160993294964501375691029638701718807009656135518176301450923295365341665};

{1,3}.#&/@NestList[Function[{t,u},{t^3+u^3,t u^2}]@@#&,{1,1},6]

MaximumCliqueCount

seq=Table[GraphData[{"Apollonian",n},"MaximumCliqueCount"],{n,6}]

FindSequenceFunction[seq,n]

MaximumIndependentEdgeSetCount

seq=Table[GraphData[{"Apollonian",n},"MaximumIndependentEdgeSetCount"],{n,6}]

MaximumIndependentVertexSetCount

Probably 1

seq=Table[GraphData[{"Apollonian",n},"MaximumIndependentVertexSetCount"],{n,6}]

MaximumLeafNumber

seq=Table[GraphData[{"Apollonian",n},"MaximumLeafNumber"],{n,6}]

MeanDistance

seq=Table[GraphData[{"Apollonian",n},"MeanDistance"],{n,6}]

(seq=Table[Mean[Flatten[GraphDistanceMatrix[ApollonianGraph[n]]]],{n,7}])//Timing

FindSequenceFunction[seq,n]

MinimumCliqueCoveringCount

Probably 1

seq=Table[GraphData[{"Apollonian",n},"MinimumCliqueCoveringCount"],{n,6}]

MinimumDistinguishingLabelingCount

seq=Table[GraphData[{"Apollonian",n},"MinimumDistinguishingLabelingCount"],{n,6}]

MinimumDominatingSetCount

seq=Table[GraphData[{"Apollonian",n},"MinimumDominatingSetCount"],{n,6}]

MinimumEdgeCoverCount

seq=Table[GraphData[{"Apollonian",n},"MinimumEdgeCoverCount"],{n,6}]

MolecularTopologicalIndex

A192792

seq=Table[GraphData[{"Apollonian",n},"MolecularTopologicalIndex"],{n,6}]

gf=x((36 (2-48 x+421 (x^2)-1584 (x^3)+2096 (x^4)+1960 (x^5)-9573 (x^6)+17670 (x^7)-25056 (x^8)+15552 (x^9)))/((1-x) (1-2 x) (((1-3 x))^2) (1-4 x) (((1-9 x))^2) (1+2 x) (1+2 (x^2))));

seq=CoefficientList[Series[((36 (2-48 x+421 (x^2)-1584 (x^3)+2096 (x^4)+1960 (x^5)-9573 (x^6)+17670 (x^7)-25056 (x^8)+15552 (x^9)))/((1-x) (1-2 x) (((1-3 x))^2) (1-4 x) (((1-9 x))^2) (1+2 x) (1+2 (x^2)))),{x,0,50}],x]

coef=FindLinearRecurrence[seq]

Length@coef

Take[seq,10]

LinearRecurrence[{29,-320,1676,-4109,2537,9182,-26346,43920,-49896,23328},{72,360,2556,22572,219636,2204244,22197420,222257988,2207645892,21754722852},20]

FullSimplify[SeriesCoefficient[gf,{x,0,n}],n>0]

Table[((3 (3025+605 (2^(2+n))+3 (((-1))^n) (2^(4+n))+605 (2^(3+2 n))+5 (9^n) (63+44 n)+4 (3^n) (-277+55 n)+35 (2^(2+(n/2))) Cos[((n π)/2)]-15 (2^((7+n)/2)) Sin[((n π)/2)]))/1210),{n,20}]

Nonhamiltonian

Table[GraphData[{"Apollonian",n},"Nonhamiltonian"],{n,6}]

NormalizedLaplacianMatrix

MatrixForm/@Table[GraphData[{"Apollonian",n},"NormalizedLaplacianMatrix"],{n,10}]

OddChordlessCycleCount

seq=Table[GraphData[{"Apollonian",n},"OddChordlessCycleCount"],{n,6}]

PathCount

A292002

seq=Table[GraphData[{"Apollonian",n},"PathCount"],{n,6}]

PathPolynomial

(poly=Factor[Table[GraphData[{"Apollonian",n},"PathPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x]])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

Factor[Take[poly2-poly,kmax-k0-Count[poly,_Missing]+1]]

FullSimplify[poly2-poly]

PentagonCount

seq=Table[GraphData[{"Apollonian",n},"PentagonCount"],{n,6}]

(seq=Table[CycleCount[ApollonianGraph[n],5],{n,7}])//Timing

FindSequenceFunction[seq,n]

FindSequenceFunction[Rest@seq,n-1]

gf=(x^2)FindGeneratingFunction[Rest@seq,x]

Perfect

Table[GraphData[{"Apollonian",n},"Perfect"],{n,6}]

ProjectivePlaneCrossingNumber

seq=Table[GraphData[{"Apollonian",n},"ProjectivePlaneCrossingNumber"],{n,6}]

Radius

seq=Table[GraphData[{"Apollonian",n},"Radius"],{n,6}]

(seq=Table[GraphRadius[ApollonianGraph[n]],{n,7}])//Timing

RankPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"RankPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x,y])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

RectilinearCrossingNumber

seq=Table[GraphData[{"Apollonian",n},"RectilinearCrossingNumber"],{n,6}]

ReliabilityPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"ReliabilityPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

SigmaPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"SigmaPolynomial"][x],{n,k0=1,kmax=6}])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

SpanningTreeCount

A193128

seq=Table[GraphData[{"Apollonian",n},"SpanningTreeCount"],{n,6}]

FindSequenceFunction[seq,n]

SquareCount

seq=Table[GraphData[{"Apollonian",n},"SquareCount"],{n,6}]

(seq=Table[CycleCount[ApollonianGraph[n],4],{n,7}])//Timing

(seq=Table[CycleCount[ApollonianGraph[n],4],{n,8}])//Timing

(seq=Table[CycleCount[ApollonianGraph[n],4],{n,9}])//Timing

FindSequenceFunction[seq,n]

FindSequenceFunction[Rest@seq,n-1]

gf=x FindGeneratingFunction[seq,x]

StabilityIndex

seq=Table[GraphData[{"Apollonian",n},"StabilityIndex"],{n,6}]

FindSequenceFunction[seq,n]

gf=x FindGeneratingFunction[seq,x]

TopologicalIndex

seq=Table[GraphData[{"Apollonian",n},"TopologicalIndex"],{n,6}]

FindSequenceFunction[seq,n]

FindGeneratingFunction[seq,x]

ToroidalCrossingNumber

seq=Table[GraphData[{"Apollonian",n},"ToroidalCrossingNumber"],{n,6}]

Traceable

Table[GraphData[{"Apollonian",n},"Traceable"],{n,6}]

TriangleCount

seq=Table[GraphData[{"Apollonian",n},"TriangleCount"],{n,6}]

FindSequenceFunction[seq,n]

TuttePolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"TuttePolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x,y])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

Untraceable

Table[GraphData[{"Apollonian",n},"Untraceable"],{n,6}]

VertexConnectivity

Table[GraphData[{"Apollonian",n},"VertexConnectivity"],{n,6}]

VertexCount

seq=Table[GraphData[{"Apollonian",n},"VertexCount"],{n,6}]

FindSequenceFunction[seq,n-1]//FullSimplify

VertexCoverNumber

Related to but not the same as IndependenceNumber

seq=Table[GraphData[{"Apollonian",n},"VertexCoverNumber"],{n,6}]

FindSequenceFunction[seq,n]//FullSimplify

VertexCoverPolynomial

(poly=Factor@Table[GraphData[{"Apollonian",n},"VertexCoverPolynomial"],{n,k0=1,kmax=6}]/.f_Function:>f[x,y])//Column

coef=Factor/@FindLinearRecurrence[poly]

ToPolynomialRecurrence[p,x,n,coef]

FormattedPolynomialRecurrence[p,x,n,coef]//TraditionalForm

TeXForm[%]

LinearRecurrence[coef,poly,{2-k0,Length[coef]-k0+1}]

FullSimplify[RSolve[Prepend[Table[p[k+k0-1,x]==poly[[k]],{k,Length[coef]}],ToPolynomialRecurrence[p,x,n,coef]],p[n,x],n],n∈Integers&&n>0]

gf=Factor[(z^k0)FindGeneratingFunction[poly,z]]

FullSimplify[SeriesCoefficient[gf,{z,0,n}],n>0]

poly2=Table[XXX,{n,6}]

FullSimplify[poly2-poly]

VertexDegrees

seq=Table[GraphData[{"Apollonian",n},"VertexDegrees"],{n,6}]

VertexTransitive

Table[GraphData[{"Apollonian",n},"VertexTransitive"],{n,6}]

WienerIndex

A289022

seq=Table[GraphData[{"Apollonian",n},"WienerIndex"],{n,6}]

seq={6,27,204,1941,19572,198567,1999056,19931337,196939572,1930784091,18802964760,182062831005,1754100012108,16826739416271,160799296563312,1531421717572401,14540848734272388,137690120683444995,1300613432805623496,1225814203971788454};

FindLinearRecurrence[seq]

gf=((x (6-111 x+627 (x^2)-741 (x^3)-1497 (x^4)+2862 (x^5)-5670 (x^6)+8748 (x^7)))/((1-x) (((1-3 x))^2) (((1-9 x))^2) (1+2 x) (1+2 (x^2))));

Series[gf,{x,0,20}]

seq=CoefficientList[Series[((6-111 x+627 (x^2)-741 (x^3)-1497 (x^4)+2862 (x^5)-5670 (x^6)+8748 (x^7))/((1-x) (((1-3 x))^2) (((1-9 x))^2) (1+2 x) (1+2 (x^2)))),{x,0,50}],x]

coef=FindLinearRecurrence[seq]

Take[seq,Length@coef]

LinearRecurrence[{23,-174,448,-29,-1221,2088,-4050,2916},{6,27,204,1941,19572,198567,1999056,19931337},20]

FullSimplify[SeriesCoefficient[gf,{x,0,n}],n>0&&n∈Integers]

Table[((6655+31 (((-1))^n) (2^(n+2))+5 (3^(1+2 n)) (24+11 n)+(3^(n+1)) (1197+55 n)+5 (2^(5+(n/2))) Cos[((n π)/2)]-155 (2^((3+n)/2)) Sin[((n π)/2)])/3630),{n,20}]

WienerSumIndex

seq=Table[GraphData[{"Apollonian",n},"WienerSumIndex"],{n,6}]

FindSequenceFunction[seq,n]

Checks

EdgeCount

wrong for n > 6:

EdgeCount/@Table[ApollonianGraph[n],{n,10}]

Table[(3/2) (1+(3^n)),{n,10}]

VertexCount

wrong for n > 6:

VertexCount/@Table[ApollonianGraph[n],{n,10}]

Table[(1/2) (5+(3^n)),{n,10}]

GraphData

GraphClassString

GraphClassString[GraphData["Apollonian"]]

GraphDataString

Do[Print[
GraphDataString[ApollonianGraph[n],
"Name"->ToString[n]<>"-Apollonian graph",
"StandardName"->{"Apollonian",n},
"Source"->"ApollonianNetwork"
]],{n,6}]

Do[Print[
GraphDataString[ApollonianGraph[n],
"Name"->ToString[n]<>"-Apollonian graph",
"StandardName"->{"Apollonian",n},
"Source"->"ApollonianNetwork",
TimeConstraint->60
]],{n,4,6}]

Apollonius spheres

Code by
Michael Trott
October 5, 2007

(* position a sphere between four given spheres *)
centerSphere[{Sphere[{x1_, y1_, z1_}, r1_], Sphere[{x2_, y2_, z2_}, r2_], 
              Sphere[{x3_, y3_, z3_}, r3_], Sphere[{x4_, y4_, z4_}, r4_]}] := 
Module[{x, y, z, r}, Sphere[Most[#], Last[#]]&[
    Sort[Select[({x, y, z, r} /. #&) /@ 
        Solve[{(x1 - x)^2 + (y1 - y)^2 + (z1 - z)^2 == (r1 + r)^2, 
               (x2 - x)^2 + (y2 - y)^2 + (z2 - z)^2 == (r2 + r)^2, 
               (x3 - x)^2 + (y3 - y)^2 + (z3 - z)^2 == (r3 + r)^2, 
               (x4 - x)^2 + (y4 - y)^2 + (z4 - z)^2 == (r4 + r)^2}, {x, y, z, r}], 
               #[[4]] > 0&], Last[#2] > Last[#1]&][[1]]]]

(* form 4-tuples of spheres*)
newSphereSet[{s1_, s2_, s3_, s4_}] := 
With[{S = centerSphere[{s1, s2, s3, s4}]}, 
     {{S, s1, s2, s3}, {S, s1, s2, s4}, {S, s1, s3, s4}, {S, s2, s3, s4}}]

(* start with spheres at the vertices of a tetrahedron *)
startSpheres = Sphere[#, 1/2]& /@ PolyhedronData["Tetrahedron", "VertexCoordinates"];

ApollonianGasket3D[n_]:=
Union[Flatten[(* iterate sphere adding *)
 Nest[Flatten[newSphereSet[#]& /@ #, 1] &, {startSpheres // N}, n]],  SameTest -> (Norm[#1[[1]] - #2[[1]]] < 10^-6&)]

Graphics3D[{Directive[Yellow, Specularity[Blue, 15]],ApollonianGasket3D[2]}]

ApollonianGasket3D[2]

ApollonianGraph3D[n_]:=Module[{g=Flatten[ApollonianGasket3D[n]]},
ChangeVertices[MakeUndirected[MakeGraph[g,Abs[Norm[First[#1]-First[#2]]-(Last[#1]+Last[#2])]<.001&]],{#[[1,1]],#[[1,2]]}&/@g]
]

GraphPlot[ApollonianGraph3D[1]]

GraphPlot[ApollonianGraph3D[2]]

GraphPlot3D[ApollonianGraph3D[2]]