Sierpinski Tetrahedron Graph

Author

Eric W. Weisstein
September 1, 2022

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

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

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

References

https://mathematica.stackexchange.com/questions/222942/how-to-replicate-graphic-output-of-graphdata-with-graphplot

Graphic

GraphicsRow[Table[SierpinskiTetrahedronGraph[n],{n,3}],Spacings->-100]

Special Cases

GraphData["SierpinskiTetrahedron"]

DeleteCases[Table[{n,RecognizeGraph[SierpinskiTetrahedronGraph[n]]},{n,8}],{_,{}|{"SierpinskiTetrahedron",_}}]//Column

Properties

tets8=SierpinskiTetrahedronGraph/@Range[8];//Timing

MaxMemoryUsed[]/10^9.GB

tets9=SierpinskiTetrahedronGraph/@Range[9];//Timing

MaxMemoryUsed[]/10^9.GB

Acyclic

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"Acyclic"],{n,6}]

AdjacencyMatrixCount

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"AdjacencyMatrixCount"],{n,3}]

Table[(((2((4^(n-1))+1))!)/24),{n,3}]

Arboricity

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"Arboricity"],{n,6}]

ArcTransitive

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"ArcTransitive"],{n,6}]

ArcTransitivity

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"ArcTransitivity"],{n,6}]

AutomorphismCount

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"AutomorphismCount"],{n,6}]

seq=GroupOrder[GraphAutomorphismGroup[#]]&/@Take[tets9,5]

BalabanIndex

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"BalabanIndex"],{n,3}]

Bandwidth

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"Bandwidth"],{n,6}]

BridgeCount

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

BurningNumber

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

CharacteristicPolynomial

(poly=Factor[Table[GraphData[{"SierpinskiTetrahedron",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]

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

FullSimplify[poly2-poly]

Chordal

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"Chordal"],{n,6}]

ChordCount

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"ChordCount"],{n,6}]

Chordless

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"Chordless"],{n,6}]

ChordlessCycleCount

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

FindSequenceFunction[seq,n]

Chords

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"Chords"],{n,6}]

ChromaticallyUnique

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"ChromaticallyUnique"],{n,6}]

GraphData[{"ChromaticallyUnique","RookComplement"}]

ChromaticInvariant

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

FindSequenceFunction[Drop[seq,2],n]

ChromaticNumber

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

ChromaticPolynomial

(poly=Factor[Table[GraphData[{"SierpinskiTetrahedron",n},"ChromaticPolynomial"],{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]

Circumference

=== VertexCount

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

Table[2 ((4^(n-1))+1),{n,6}]

FindSequenceFunction[Drop[seq,2],n]

Classes

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

CliqueCount

A292537

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

FindSequenceFunction[Rest@seq,n-1]//FullSimplify

seq=Table[Piecewise[{{16,n==1}},7 (4^n)/2+3],{n,20}]

FindLinearRecurrence[Rest@seq]

Join[{16},LinearRecurrence[{5,-4},{59,227},30]]

gf=x FindGeneratingFunction[seq,x]

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

CliqueCoveringNumber

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

CliqueNumber

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

CliquePolynomial

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

CoefficientList[poly,x]//Column

FindSequenceFunction[#,n]&/@Transpose[CoefficientList[poly,x]]//FullSimplify

Table[1+2(1+(4^(n-1)))x+3/2 (4^n)(x^2)+5 (4^(n-1))(x^3)+(4^(n-1))(x^4),{n,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]

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

FullSimplify[poly2-poly]

CochromaticGraphNames

Table[GraphData[{"SierpinskiTetrahedron",n},"CochromaticGraphNames"],{n,6}]//Column

ComplementOddChordlessCycleCount

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

FindSequenceFunction[Take[seq,{6,5}],n]

ConnectedComponentCount

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

ConnectedDominatingSetCount

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

FindSequenceFunction[seq,n]

ConnectedDominationNumber

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

FindSequenceFunction[seq,n]

ConnectedDominationPolynomial

(poly=Factor[Table[GraphData[{"SierpinskiTetrahedron",n},"ConnectedDominationPolynomial"],{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]

ConnectedInducedSubgraphCount

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"ConnectedInducedSubgraphCount"],{n,4}]

ConnectedInducedSubgraphPolynomial

(poly=Factor[Table[GraphData[{"SierpinskiTetrahedron",n},"ConnectedInducedSubgraphPolynomial"],{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[{"SierpinskiTetrahedron",n},"CrossingNumber"],{n,6}]

CycleCount

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

CyclePolynomial

(poly=Factor[Table[GraphData[{"SierpinskiTetrahedron",n},"CyclePolynomial"],{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]

Cyclic

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

CyclomaticNumber

A024036

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

FindSequenceFunction[seq,n]

DetourIndex

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

FullSimplify[With[{v=2+(2^(-1+2 n))},((v^2)-v)(2^(2n-1)+1)/2]]

Table[(1/16) (((2+(4^n)))^2) (4+(4^n)),{n,6}]

DetourMatrix

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

MatrixForm/@Table[SparseArray[{i_,i_}:>0,2+(2^(-1+2 n)),(2^(2n-1)+1)],{n,3}]

DetourPolynomial

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

FindSequenceFunction[{3,9,33,129,513,2049},n]

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

Diameter

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

FindSequenceFunction[seq,n]

DistanceMatrix

MatrixForm/@Table[GraphData[{"SierpinskiTetrahedron",n},"DistanceMatrix"],{n,4}]

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

DistancePolynomial

(poly=Factor[Table[GraphData[{"SierpinskiTetrahedron",n},"DistancePolynomial"],{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]

DistinguishingNumber

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

DomaticNumber

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"DomaticNumber"],{n,6}]

DominationNumber

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

DominationPolynomial

(poly=Factor[Table[GraphData[{"SierpinskiTetrahedron",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]

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

FullSimplify[poly2-poly]

DominatingSetCount

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

EdgeChromaticNumber

Probably 6 for n>1

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

Table[GraphData[{"SierpinskiTetrahedron",n},"Class1"],{n,6}]

EdgeConnectivity

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

EdgeCount

A002023

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

seq=EdgeCount/@tets

FindLinearRecurrence[seq]

seq=LinearRecurrence[{4},{6},20]

FindSequenceFunction[seq,n]//FullSimplify

Table[6 (4^(n-1)),{n,20}]

6 4^Range[0,20]

gf=x FindGeneratingFunction[seq,x]

CoefficientList[Series[(6/(1-4 x)),{x,0,20}],x]

EdgeCoverCount

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

EdgeCoverNumber

A052539

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

FindSequenceFunction[seq,n]//FullSimplify

seq=4^Range[0,20]+1

FindLinearRecurrence[seq]

LinearRecurrence[{5,-4},{2,5},20]

gf=x FindGeneratingFunction[seq,x]

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

EdgeCoverPolynomial

(poly=Factor[Table[GraphData[{"SierpinskiTetrahedron",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]

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

FullSimplify[poly2-poly]

EulerianCycleCount

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

FaceCount

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

FlowPolynomial

(poly=Factor[Table[GraphData[{"SierpinskiTetrahedron",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]

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

FullSimplify[poly2-poly]

FractionalChromaticNumber

Probably 4

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

FractionalEdgeChromaticNumber

Probably 6 for n > 1

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

FindSequenceFunction[seq,n]

Girth

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

Gonality

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

HamiltonConnected

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

HamiltonDecompositionCount

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

Hamiltonian

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

HamiltonianCycleCount

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

HamiltonianPathCount

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

HexagonCount

A292545

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

(seq=Monitor[Table[CycleCount[SierpinskiTetrahedronGraph[n],6],{n,8}],n])//Timing

FindSequenceFunction[Drop[seq,2],n-2]//Simplify

Table[Piecewise[{{0,n==1},{218,n==2}},219 (4^(n-2))],{n,30}]

FindLinearRecurrence[Drop[seq,2]]

Join[{0,218},LinearRecurrence[{4},{876},20]]

gf=x FindGeneratingFunction[seq,x]

SeriesCoefficient[-((2 (x^2) (109+2 x))/(-1+4 x)),{x,0,n}]

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

IndependentEdgeSetCount

A292669

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

IndependentVertexSetCount

A292697

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

IndependenceNumber

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

IrredundantSetCount

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"IrredundantSetCount"],{n,6}]

MatchingNumber

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

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

MaximalIndependentEdgeSetCount

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

MaximalIndependentVertexSetCount

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

MaximalIrredundantSetCount

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"MaximalIrredundantSetCount"],{n,6}]

MaximumIndependentEdgeSetCount

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

MaximumIndependentVertexSetCount

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

MaximumIrredundantSetCount

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"MaximumIrredundantSetCount"],{n,6}]

MeanDistance

MeanDistance/@Take[tets,7]

FindSequenceFunction[%,n]

MinimalDominatingSetCount

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"MinimalDominatingSetCount"],{n,6}]

MinimumDominatingSetCount

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

PentagonCount

A292543

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

FindSequenceFunction[Rest@seq,n-1]//Simplify

Table[If[n==1,0,6 (4^n)],{n,30}]

FindLinearRecurrence[Rest@seq]

Join[{0},LinearRecurrence[{4},{96},20]]

gf=x FindGeneratingFunction[seq,x]

CoefficientList[Series[((96 x)/(1-4 x)),{x,0,20}],x]

Radius

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

SquareCount

A292542

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

FindSequenceFunction[Rest@seq,n-1]

seq=Table[If[n==1,3,39 (4^(n-2))],{n,30}]

FindLinearRecurrence[Rest@seq]

Join[{3},LinearRecurrence[{4},{39},20]]

gf=x FindGeneratingFunction[seq,x]

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

Traceable

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

TriangleCount

A292540

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

FindSequenceFunction[Rest@seq,n-1]

Table[If[n==1,4,5 (4^(n-1))],{n,10}]

FindLinearRecurrence[Rest@seq]

Join[{4},LinearRecurrence[{4},{20},30]]

gf=x FindGeneratingFunction[seq,x]

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

VertexCount

A283070

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

seq=VertexCount/@tets

FindSequenceFunction[seq,n]//FullSimplify

seq=Table[2((4^(n-1))+1),{n,20}]

2((4^(Range[0,20]))+1)

FindLinearRecurrence[seq]

LinearRecurrence[{5,-4},{4,10},20]

gf=FindGeneratingFunction[seq,x]

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

WienerIndex

A292026

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

Do[Print[{{"SierpinskiTetrahedron",n},WienerIndex[SierpinskiTetrahedronGraph[n]]//Timing}],{n,10}]

seq={6,66,1476,42984,1343568,42744480,1365843264,43691203200,1397992469760};

FindLinearRecurrence[seq]

seq=LinearRecurrence[{46,-504,1856,-2048},{6,66,1476,42984},20]

gf=x FindGeneratingFunction[seq,x]

CoefficientList[Series[-((6 (-1+35 x-244 (x^2)+464 (x^3)))/(1-46 x+504 (x^2)-1856 (x^3)+2048 (x^4))),{x,0,20}],x]

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

Table[(2^(n-6)) (2016+15 (2^(n+4))+175 (4^(n+1))+89 (16^n))/35,{n,20}]

Construction

By hand

SierpinskiMesh[1,3]

v=MeshCoordinates[SierpinskiMesh[1,3]]

c0=MeshCells[SierpinskiMesh[1,3],0]

c1=MeshCells[SierpinskiMesh[1,3],1]

c1[[All,1]]

Graphics3D[{Sphere[v,.1],GraphicsComplex[v,Line[c1[[All,1]]]],MapIndexed[Text[#2[[1]],#]&,v]},Boxed->False]

Table[SierpinskiTetrahedronGraph[n],{n,3}]

RecognizeGraph/@Table[SierpinskiTetrahedronGraph[n],{n,5}]

MeshConnectivityGraph (V12.1)

MeshConnectivityGraph@SierpinskiMesh[2,3]

RecognizeGraph[%]

MeshConnectivityGraph@SierpinskiMesh[3,3]

RecognizeGraph[%]

Embeddings

{"SierpinskiTetrahedron", 2}

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

Primary

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

All

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

Planar

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

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

MinimalCrossing

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

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

Tutte embeddings

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

Tally[ReverseSort[Length/@faces]]

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

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

Tutte embedding construction 3 #1

GraphPlot[RotateGraph[]]

v=Join[{{-1,-(1/(Sqrt[3]))},{1,-(1/(Sqrt[3]))},{0,Sqrt[3]-(1/(Sqrt[3]))},{0,0}},Flatten[Table[RotationMatrix[Pi+2Pi j/3].#&/@Table[{0,i/Sqrt[3]/3},{i,2}],{j,0,2}],1]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,6,2,8,3,10,1,5,2,7,3,9,1],e[10,9,4,7,8],e[6,5,4],e[5,7,9,5]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Tutte embedding construction 3 #2

GraphPlot[RotateGraph[,2Pi/3]]

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

RecognizeGraph[g]

Halin

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

LCF

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

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

UnitDistance

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

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

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

Matchstick

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

Default embedding

GraphPlot[GraphData[{"SierpinskiTetrahedron",2},"Edges"],VertexLabels->Automatic]

GraphData[{"SierpinskiTetrahedron",2}]//GraphEmbedding

p=4{{-1,-1},{0,-1},.25{1,1},{-1,0},{1,-1},{1,0},-.25{1,1},{1,1},{0,1},{-1,1}}

Round[%]

g=System`Graph[VertexList[SierpinskiTetrahedronGraph[2]],EdgeList[SierpinskiTetrahedronGraph[2]],VertexCoordinates->p]

RecognizeGraph[%]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData[{"SierpinskiTetrahedron",2}],"CrossingNumber"->-1]]

c3={{0,0.29`},{1,-1.44`},{0,-0.5`},{-1,-1.4433756729740657`},{0.4`,-1.25`},{0.2000053679291236`,-1.07`},{0,-1.25`},{0,-0.88`},{-0.2`,-1.07`},{-0.4`,-1.25`}};

SierpinskiTetrahedronGraph[2,VertexCoordinates->c3,VertexLabels->"Name"]

c4=MapIndexed[If[MatchQ[#2[[1]],1|2|4],#,#+{0,.1}]&,c3]

SierpinskiTetrahedronGraph[2,VertexCoordinates->c4,VertexLabels->"Name"]

c5=MapIndexed[Switch[#2[[1]],9,Mean[c4[[{3,10}]]],6,Mean[c4[[{5,3}]]],8,#+{0,.15},_,#]&,c4]

SierpinskiTetrahedronGraph[2,VertexCoordinates->c5,VertexLabels->"Name"]

p={{-1,0},{1,0},{0,Sqrt[3]}}

p2=Mean[{#,Mean[p]}]&/@p

p3=Mean/@Subsets[p2,{2}]//Simplify

ps=Join[p,p2,p3,p4];

p4={Mean[ps[[{6,8,9}]]]}//Simplify

q=Join[ps,p4]//Simplify

q={{-1,0},{1,0},{0,(Sqrt[3])},{-(1/2),(1/(2 (Sqrt[3])))},{(1/2),(1/(2 (Sqrt[3])))},{0,(2/(Sqrt[3]))},{0,(1/(2 (Sqrt[3])))},{-(1/4),(5/(4 (Sqrt[3])))},{(1/4),(5/(4 (Sqrt[3])))},{0,((Sqrt[3])/2)}};

Graphics[{Point[q],MapIndexed[Text[#2[[1]],#+.05]&,q]}]

System`Graph[Range[10],UndirectedEdge@@@(Sort/@Join[
Flatten[Partition[#,2,1,1]&/@{{1,2,3},{6,8,4,7,5,9},{7,8,9}},1],
{10,#}&/@{6,8,9},
{1,#}&/@{6,8,4,7},
{2,#}&/@{7,5,9,6},
{{6,3}}
]),VertexCoordinates->q,VertexLabels->"Name"]

RecognizeGraph@%

3D default

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

3D All

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

3D UnitDistance

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

3D Polyhedron

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

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

3D Canonical

GraphData[{"SierpinskiTetrahedron",2},"Graph",{"3D","Canonical"}]

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

3D Canonical construction

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

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->10000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//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]

{"SierpinskiTetrahedron", 3}

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

All

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

Planar

GraphData[{"SierpinskiTetrahedron",3},"Planar"]

GraphData[{"SierpinskiTetrahedron",3},"Graph","Planar"]//StyleGraphs

Halin

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

LCF

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

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

UnitDistance

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

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

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

Matchstick

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

MinimalCrossing

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

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

Default embedding

GraphPlot@GraphData[{"SierpinskiTetrahedron",3},"Edges"]

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

RecognizeGraph[g]

MinimalCrossing construction

g1=MinimalCrossingGraph[GraphData[{"SierpinskiTetrahedron",3}],"CrossingNumber"->12,VertexSize->1.5,VertexLabels->Automatic]

Length[v=GraphEmbedding[CenterGraph@g]]

el=Table[AdjacencyList[g1,v],{v,Range[35,46]}]

e=UndirectedEdge@@@Flatten[Subsets[#,{2}]&/@e,1]

v=If[Norm[#]<.1,2.5#,#]&/@GraphEmbedding[g1];

g=VertexDelete[Graph[VertexList[g1],Union[EdgeList[g1],e],VertexCoordinates->v,VertexSize->.5],Range[46-12+1,46]]

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

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

3D All

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

3D UnitDistance

GraphData[{"SierpinskiTetrahedron",3},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"SierpinskiTetrahedron",3},"Polyhedral"]

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

GraphData

GraphDataString

file=OpenWrite["~/sierpinskitetrahedron.m"]

Do[WriteString[file,GraphDataString[SierpinskiTetrahedronGraph[n],
"StandardName"->{"SierpinskiTetrahedron",n},
"Name"->ToString[n]<>"\[Hyphen]Sierpiński tetrahedron graph",
"Embeddings"->None,
"Embeddings3D"->Automatic,
"EmbeddingClasses3D"->{{"Primary","TriangularGrid"}},
"AlternateNames"->{ToString[n]<>"\[Hyphen]Sierpiński sponge graph",ToString[n]<>"\[Hyphen]tetrix graph"},
"AlternateStandardNames"->{{"SierpinskiSponge",n},{"Tetrix",n}},
"Classes"->{"SierpinskiTetrahedron"},
"Information"->"Textrix",
"NotationRules"->{"SierpinskiTetrahedron"->n},
"Skip"->{"Arboricity","CliqueCoveringNumber","Skewness"},
	(*bug(338571):TimeConstrained Subgraph sporadically crashes kernel after multiple evaluations*)
Debug->True,
TimeConstraint->10
]],{n,6,6}]

Close[file]