Mean Distance

Author

Eric W. Weisstein
May 11, 2019

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

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

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

Table

classes={"AlternatingGroupGraph","Andrasfai","Antelope","Antiprism","Apollonian","Barbell","Bishop","BlackBishop","Bruhat","CocktailParty","Complete","CompleteBipartite","CompleteTripartite","CrossedPrism","Crown","CubeConnectedCycle","Cycle","DiagonalIntersection","Dipyramid","FibonacciCube","Fiveleaper","FoldedCube","Gear","Grid","HalvedCube","Hanoi","Helm","Hypercube","Keller","King","Knight","Ladder","LadderRung","MengerSponge","MoebiusLadder","Mycielski","Odd","Path","PathComplement","PermutationStar","Prism","Queen","Rook","RookComplement","SierpinskiCarpet","SierpinskiSieve","SierpinskiTetrahedron","Star","Sun","Sunlet","Tetrahedral","TorusGrid","Transposition","Triangular","TriangularGrid","TriangularHoneycombAcuteKnight","TriangularHoneycombBishop","TriangularHoneycombObtuseKnight","TriangularHoneycombQueen","TriangularHoneycombRook","Web","Wheel","WhiteBishop"};
TextGrid[Table[{
class,
If[IntegerQ[aseq=class/.Cases[classes,_Rule]],Hyperlink[anum="A"<>StringDrop[ToString[PaddedForm[aseq,6,NumberPadding->"0"]],1],"https://oeis.org/"<>anum],""],Table[GraphData[{Flatten[{class}][[1]],n},"MeanDistance"],{n,20}]}/.GraphData[{c_,n_},a_]:>GraphData[{c,{n,n}},a]/.GraphData[{c_,{n_,n_}},a_]:>GraphData[{c,{n,n,n}},a]/.{_Missing->"\[Placeholder]",_GraphData->"X"}/.{l__,"X"..}:>{l},{class,classes/.Rule[cl_,_]:>cl}],Dividers->All]//Quiet

Parametrized families

AlternatingGroupGraph

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

FindSequenceFunction[seq,m-1]

Andrasfai

seq=Table[GraphData[{"Andrasfai",n},"MeanDistance"],{n,10}]

FindSequenceFunction[seq,n]

FindGeneratingFunction[seq,x]//FullSimplify

Series[(5/(3-3 x))-(7/6) Hypergeometric2F1[(2/3),1,(5/3),x],{x,0,10}]

Antelope n×n

seq=Table[GraphData[{"Antelope",{n,n}},"MeanDistance"],{n,15}]

Antiprism

A060819/A176895

Entity["Graph",{"Antiprism",n}]["MeanDistance"]

seq=Table[GraphData[{"Antiprism",n},"MeanDistance"],{n,3,25}]

FindSequenceFunction[seq,n-2]

FindLinearRecurrence[seq]

gf=(x^3) FindGeneratingFunction[seq,x]

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

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

Apollonian

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

FindSequenceFunction[seq,n]

BlackBishop n×n

seq=Table[GraphData[{"BlackBishop",{n,n}},"MeanDistance"],{n,10}]

(seq=Table[MeanDistance[BlackBishopGraph[n,n]],{n,50}])//Timing

FullSimplify[FindSequenceFunction[Rest@seq,n-1],n∈Integers]

Bishop n×n

seq=Table[GraphData[{"Bishop",{n,n}},"MeanDistance"],{n,10}]

Bruhat

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

FindSequenceFunction[seq,n]

CocktailParty

seq=Table[GraphData[{"CocktailParty",n},"MeanDistance"],{n,20}]

Complete

Entity["Graph",{"Complete",n}]["MeanDistance"]

seq=Table[GraphData[{"Complete",n},"MeanDistance"],{n,20}]

FindSequenceFunction[seq,n]

CompleteBipartite m×n

Entity["Graph",{"CompleteBipartite",{m,n}}]["MeanDistance"]

CompleteBipartite n×n

Entity["Graph",{"CompleteBipartite",{n,n}}]["MeanDistance"]

seq=Table[GraphData[{"CompleteBipartite",{n,n}},"MeanDistance"],{n,20}]

FindSequenceFunction[seq,n]//FullSimplify

CompleteTripartite k×m×n

Entity["Graph",{"CompleteTripartite",{k,m,n}}]["MeanDistance"]

CompleteTripartite n×n×n

Entity["Graph",{"CompleteTripartite",{n,n,n}}]["MeanDistance"]

seq=Table[GraphData[{"CompleteTripartite",{n,n,n}},"MeanDistance"],{n,10}]

FindSequenceFunction[seq,n]//FullSimplify

CrossedPrism

seq=Table[GraphData[{"CrossedPrism",2n},"MeanDistance"],{n,2,10}]

FindSequenceFunction[seq,n-1]//Factor

Crown

seq=Table[GraphData[{"Crown",n},"MeanDistance"],{n,3,20}]

Cycle

Entity["Graph",{"Cycle",n}]["MeanDistance"]

seq=Table[GraphData[{"Cycle",n},"MeanDistance"],{n,3,20}]

FullSimplify[FindSequenceFunction[seq,n-2],n∈Integers]

DiagonalIntersection

seq=Table[GraphData[{"DiagonalIntersection",n},"MeanDistance"],{n,3,14}]

Dipyramid

seq=Table[GraphData[{"Dipyramid",n},"MeanDistance"],{n,3,20}]

FindSequenceFunction[seq,n-2]//FullSimplify

FibonacciCube

seq=Table[GraphData[{"FibonacciCube",n},"MeanDistance"],{n,15}]

FindSequenceFunction[seq,n]//Head//Timing

FindSequenceFunction[Rest@seq,n-1]//Head//Timing

(seq=Table[MeanDistance[FibonacciCubeGraph[n]],{n,18}])//Timing

(seq=Table[MeanDistance[FibonacciCubeGraph[n]],{n,19}])//Timing

FindSequenceFunction[seq,n]//Head//Timing

FindSequenceFunction[Rest@seq,n-1]//Head//Timing

FoldedCube

seq=Table[GraphData[{"FoldedCube",n},"MeanDistance"],{n,2,10}]

(seq=Table[MeanDistance[FoldedCubeGraph[n]],{n,2,13}])//Timing

(seq=Table[MeanDistance[FoldedCubeGraph[n]],{n,2,14}])//Timing

(seq=Table[MeanDistance[FoldedCubeGraph[n]],{n,2,15}])//Timing

FindSequenceFunction[seq,n]

FindGeneratingFunction[seq,x]

RecurrenceTable[{-2-n+(-4-2 n) a[n]-2 a[1+n]+(4+2 n) a[2+n]==0,a[1]==1/2,a[2]==3/4},a,{n,14}]

RSolve[{-2-n+(-4-2 n) a[n]-2 a[1+n]+(4+2 n) a[2+n]==0,a[1]==1/2,a[2]==3/4},a[n],n]

Grid m×n

Entity["Graph",{"Grid",{m,n}}]["MeanDistance"]

Grid n×n

Entity["Graph",{"Grid",{n,n}}]["MeanDistance"]

seq=Table[GraphData[{"Grid",{n,n}},"MeanDistance"],{n,10}]

FindSequenceFunction[seq,n]

Grid k×m×n

Entity["Graph",{"Grid",{k,m,n}}]["MeanDistance"]

Sort@Flatten[Table[{
{k,m,n},
GraphData[{"Grid",{k,m,n}},"MeanDistance"],
(((k+m+n) (k m n-1))/(3 k m n))
},{n,5},{m,n},{k,m}],2]

Tally[GraphData[{"Grid",{2,3,4}},"DistanceMatrix"]//Normal//Flatten]

Grid n×n×n

Entity["Graph",{"Grid",{n,n,n}}]["MeanDistance"]

seq=Table[GraphData[{"Grid",{n,n,n}},"MeanDistance"],{n,10}]

FindSequenceFunction[seq,n]//FullSimplify

HalvedCube

seq=Table[GraphData[{"HalvedCube",n},"MeanDistance"],{n,10}]

FindSequenceFunction[Rest@seq,n-1]

gf=x FindGeneratingFunction[seq,x]

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

Hanoi

seq=Table[GraphData[{"Hanoi",n},"MeanDistance"],{n,5}]

(seq=Table[MeanDistance[HanoiGraph[n]],{n,8}])//Timing

FindSequenceFunction[seq,n]//Head//Timing

FindSequenceFunction[Rest@seq,n-1]//Head//Timing

Hypercube

Entity["Graph",{"Hypercube",n}]["MeanDistance"]

seq=Table[GraphData[{"Hypercube",n},"MeanDistance"],{n,0,10}]

FindSequenceFunction[seq,n+1]

Keller

Entity["Graph",{"Keller",n}]["MeanDistance"]

seq=Table[GraphData[{"Keller",n},"MeanDistance"],{n,5}]

FindSequenceFunction[seq,n]

King n×n

seq=Table[GraphData[{"King",{n,n}},"MeanDistance"],{n,10}]

FindSequenceFunction[seq,n]//Factor

Knight m×n

Entity["Graph",{"Knight",{m,n}}]["MeanDistance"]

Knight n×n

Entity["Graph",{"Knight",{n,n}}]["MeanDistance"]

seq=Table[GraphData[{"Knight",{n,n}},"MeanDistance"],{n,20}]

FindSequenceFunction[Drop[seq,3],n-3]//Head//Timing

FindSequenceFunction[Drop[seq,4],n-4]//Head//Timing

FindGeneratingFunction[Drop[seq,3],x]//Head//Timing

FindGeneratingFunction[Drop[seq,3],x]//Head//Timing

Ladder

Entity["Graph",{"Ladder",n}]["MeanDistance"]

seq=Table[GraphData[{"Ladder",n},"MeanDistance"],{n,20}]

FindSequenceFunction[seq,n]//Factor

LadderRung

seq=Table[GraphData[{"LadderRung",n},"MeanDistance"],{n,20}]

MengerSponge

seq=Table[GraphData[{"MengerSponge",n},"MeanDistance"],{n,3}]

(seq=Table[MeanDistance[MengerSpongeGraph[n]],{n,3}])//Timing

(seq=Table[MeanDistance[MengerSpongeGraph[n]],{n,4}])//Timing

MoebiusLadder

Entity["Graph",{"MoebiusLadder",n}]["MeanDistance"]

seq=Table[GraphData[{"MoebiusLadder",n},"MeanDistance"],{n,3,25}]

FullSimplify[FindSequenceFunction[seq,n-2],n∈Integers]

FullSimplify[%-((-3+(((-1))^(1+n))+4 n+2 (n^2))/(8 n)),n∈Integers]

Mycielski

Entity["Graph",{"Mycielski",n}]["MeanDistance"]

seq=Table[GraphData[{"Mycielski",n},"MeanDistance"],{n,11}]

(seq=Table[MeanDistance[MycielskiGraph[n]],{n,12}])//Timing

FullSimplify[FindSequenceFunction[Rest@seq,n-1],n∈Integers]

(seq=Table[MeanDistance[MycielskiGraph[n]],{n,13}])//Timing

Table[((2 (216-27 (2^(3+n))-56 (3^n)+81 (4^n)))/(9 (((4-3 (2^n)))^2))),{n,13}]

Odd

Entity["Graph",{"Odd",n}]["MeanDistance"]

seq=Table[GraphData[{"Odd",n},"MeanDistance"],{n,7}]

Table[((InactiveSum[\[FormalK] Binomial[-1+n,Floor[(\[FormalK]/2)]] Binomial[n,Ceiling[(\[FormalK]/2)]], \[FormalK], -1+n])/(Binomial[-1+2 n,-1+n])),{n,7}]//Activate

(seq=Table[MeanDistance[OddGraph[n]],{n,7}])//Timing

FindSequenceFunction[seq,n]//Head//Timing

(seq=Table[MeanDistance[OddGraph[n]],{n,8}])//Timing

FindSequenceFunction[Rest@seq,n-1]//Head//Timing

FindGeneratingFunction[seq,x]//Head//Timing

Prism

Entity["Graph",{"Prism",n}]["MeanDistance"]

seq=Table[GraphData[{"Prism",n},"MeanDistance"],{n,3,25}]

FullSimplify[FindSequenceFunction[seq,n-2],n∈Integers]

Queen n×n

seq=Table[GraphData[{"Queen",{n,n}},"MeanDistance"],{n,10}]

FullSimplify[FindSequenceFunction[seq,n],n∈Integers]//Factor

Rook n×n

seq=Table[GraphData[{"Rook",{n,n}},"MeanDistance"],{n,10}]

FullSimplify[FindSequenceFunction[seq,n],n∈Integers]//Factor

RookComplement n×n

seq=Table[GraphData[{"RookComplement",{n,n}},"MeanDistance"],{n,10}]

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

SierpinskiCarpet

seq=Table[GraphData[{"SierpinskiCarpet",n},"MeanDistance"],{n,4}]

FindSequenceFunction[seq,n]

(seq=Table[MeanDistance[SierpinskiCarpetGraph[n]],{n,5}])//Timing

FindSequenceFunction[seq,n]//Head//Timing

SierpinskiSieve

seq=Table[GraphData[{"SierpinskiSieve",n},"MeanDistance"],{n,5}]

FindSequenceFunction[seq,n]

(seq=Table[MeanDistance[SierpinskiSieveGraph[n]],{n,9}])//Timing

FindSequenceFunction[Rest@seq,n-1]//Head//Timing

SierpinskiTetrahedron

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

FindSequenceFunction[seq,n]

(seq=Table[MeanDistance[SierpinskiTetrahedronGraph[n]],{n,7}])//Timing

FindSequenceFunction[Rest@seq,n-1]//Head//Timing

Star

Entity["Graph",{"Star",n}]["MeanDistance"]

seq=Table[GraphData[{"Star",n},"MeanDistance"],{n,25}]

FindSequenceFunction[seq,n]//Factor

Sun

seq=Table[GraphData[{"Sun",n},"MeanDistance"],{n,3,20}]

FindSequenceFunction[seq,n-2]//Factor

Sunlet

seq=Table[GraphData[{"Sunlet",n},"MeanDistance"],{n,3,20}]

FullSimplify[FindSequenceFunction[seq,n-2],n∈Integers]

TorusGrid n×n

seq=Table[GraphData[{"TorusGrid",{n,n}},"MeanDistance"],{n,3,10}]

(seq=Table[MeanDistance[TorusGridGraph[n,n]],{n,3,15}])//Timing

FullSimplify[FindSequenceFunction[seq,n-2],n∈Integers]

Transposition

Entity["Graph",{"Transposition",n}]["MeanDistance"]

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

(seq=Table[MeanDistance[TranspositionGraph[n]],{n,7}])//Timing

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

Triangular

seq=Table[GraphData[{"Triangular",n},"MeanDistance"],{n,2,10}]

FindSequenceFunction[seq,n-1]

TriangularGrid

seq=Table[GraphData[{"TriangularGrid",n},"MeanDistance"],{n,0,10}]

FindSequenceFunction[seq,n+1]//FullSimplify

TriangularHoneycombAcuteKnight

seq=Table[GraphData[{"TriangularHoneycombAcuteKnight",n},"MeanDistance"],{n,20}]

TriangularHoneycombBishop

seq=Table[GraphData[{"TriangularHoneycombBishop",n},"MeanDistance"],{n,9}]

FindSequenceFunction[seq,n]//Factor

TriangularHoneycombObtuseKnight

seq=Table[GraphData[{"TriangularHoneycombObtuseKnight",n},"MeanDistance"],{n,20}]

FindSequenceFunction[Drop[seq,5],n-5]//Head//Timing

(seq=Table[MeanDistance[TriangularHoneycombObtuseKnightGraph[n]],{n,50}])//Timing

FindSequenceFunction[Drop[seq,5],n-5]//Head//Timing

FindSequenceFunction[Drop[seq,6],n-6]//Head//Timing

TriangularHoneycombQueen

seq=Table[GraphData[{"TriangularHoneycombQueen",n},"MeanDistance"],{n,10}]

FindSequenceFunction[seq,n]

TriangularHoneycombRook

seq=Table[GraphData[{"TriangularHoneycombRook",n},"MeanDistance"],{n,10}]

Wheel

Entity["Graph",{"Wheel",n}]["MeanDistance"]

seq=Table[GraphData[{"Wheel",n},"MeanDistance"],{n,4,20}]

FindSequenceFunction[seq,n-3]//FullSimplify

WhiteBishop n×n

seq=Table[GraphData[{"WhiteBishop",{n,n}},"MeanDistance"],{n,2,10}]

(seq=Table[MeanDistance[WhiteBishopGraph[n,n]],{n,2,50}])//Timing

FullSimplify[FindSequenceFunction[Rest@seq,n-2],n∈Integers]

Factor[%]