Graph Skewness

Author

Eric W. Weisstein
January 26, 2021

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

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

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

Counts

Tally[Sort[#]]&/@(values=Table[GraphSkewness/@Graphs[n],{n,7}])//Column

SetDirectory[FileNameJoin[{$GraphDataDirectory,"Nodes"}]];

(tallies=Tally[Sort[#]][[All,2]]&/@(values=Get/@FileNames["*.m","Skewness"]))//Column

Sort[Tally[#]][[All,1]]&/@values//Column

Flattened tallies

A294224

Flatten[tallies]

Tally totals

A000088

Total/@tallies

Row lengths

Looks like A000124(n-4) for n>3

Length/@tallies

First column k==0 (planar graphs)

A005470

tallies[[All,1]]

Second column (k==1)

Not in OEIS

seq=Drop[tallies,4][[All,2]]

FindGeneratingFunction[seq,x]

FindSequenceFunction[seq,n]

Second-to-last column

All one's for n>1

Drop[tallies,4][[All,-2]]

Last column

All one's for n≠2,4

tallies[[All,-1]]

Totals of skewnesses in each row

Not in OEIS:

Total/@values

Parametrized family table

GraphDataCountTable["Skewness",{"Complete"->000217,"CompleteBipartite"->000290,"Empty"->000004,"Hypercube"->291526,"MoebiusLadder"->000012,"Sun"->000217,"TriangularHoneycombRook"->000292}]

Parametrized families

Andrasfai

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

Antiprism

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

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

Bishop n×n

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

BlackBishop n×n

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

CocktailParty

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

pi[g_Graph]:=Ceiling[EdgeCount[g]-((Girth[g])/(Girth[g]-2))(VertexCount[g]-2)]

Ceiling[2 (-1+n) n-((Piecewise[{{4,n==2}},3])/(Piecewise[{{4,n==2}},3]-2))(2n-2)]//FullSimplify

Table[Piecewise[{{0,n==2}},Ceiling[2 (n-3) (n-1)]],{n,20}]

Complete

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

A000217

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

Table[Piecewise[{{(n-3)(n-4)/2,n≥3}}],{n,20}]

Table[Piecewise[{{0,n<3}},(n-3)(n-4)/2],{n,20}]

Table[Piecewise[{{0,n<3}},Binomial[n-3,2]],{n,20}]

Do[Print[{i,GraphSkewness[GraphData[{"Complete",i}]]//Timing}],{i,8}]

Complete Bipartite m×n

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

Expand[4+m n-2 (m+n)]

Expand[(m-2)(n-2)]

Sort@DeleteCases[Block[{m,n},{{m,n}="CompleteBipartite"/.GraphData[#,"NotationRules"],GraphData[#,"Skewness"],Piecewise[{{0,Min[m,n]==1}},m n-2(m+n)+4]}]&/@GraphData["CompleteBipartite"],{_,x_,x_}]

Complete Bipartite n×n

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

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

FindSequenceFunction[Drop[seq,1],n-1]

Table[Piecewise[{{0,n==1}},(n-2)^2],{n,20}]

Complete Tripartite k×m×n

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

https://www.sciencedirect.com/science/article/pii/S0166218X13001704

http://studentsrepo.um.edu.my/4826/1/mscthesis.pdf

pi[g_Graph]:=Ceiling[EdgeCount[g]-((Girth[g])/(Girth[g]-2))(VertexCount[g]-2)]

DeleteCases[{
#,
{k,m,n}="CompleteTripartite"/.GraphData[#,"NotationRules"],
Piecewise[{
{0,k m n/Max[k,m,n]==1},
{pi[GraphData[#]]+Max[k,m,n]-1,Min[k,m,n]==1},
{pi[GraphData[#]],2<=Max[k,m,n]≤Min[k,m,n]+k m n/(Min[k,m,n]Max[k,m,n])-2},
{pi[GraphData[#]]+Max[k,m,n]+2-Min[k,m,n]-k m n/(Min[k,m,n]Max[k,m,n]),Max[k,m,n]>Min[k,m,n]+k m n/(Min[k,m,n]Max[k,m,n])-2}
}],GraphData[#,"Skewness"]
}&/@GraphData["CompleteTripartite"],{_,_,_,_Missing}]

k=.;m=.;n=.;

Entity["Graph",{"CompleteTripartite",{k,m,n}}][#]&/@{"VertexCount","EdgeCount","Girth"}

Ceiling[k m+k n+m n-(3/(3-2))(k+m+n-2)]//ExpandAll

Ceiling[k m+m n+k n-3(k+m+n)]+6

Piecewise[{
{0,k m n/Max[k,m,n]==1},
{Ceiling[k m+m n+k n-3(k+m+n)]+6+Max[k,m,n]-1,Min[k,m,n]==1},
{Ceiling[k m+m n+k n-3(k+m+n)]+6,2<=Max[k,m,n]≤Min[k,m,n]+k m n/(Min[k,m,n]Max[k,m,n])-2},
{Ceiling[k m+m n+k n-3(k+m+n)]+6+Max[k,m,n]+2-Min[k,m,n]-k m n/(Min[k,m,n]Max[k,m,n]),Max[k,m,n]>Min[k,m,n]+k m n/(Min[k,m,n]Max[k,m,n])-2}
}]

Block[{k,m,n},DeleteCases[{
#,
{k,m,n}="CompleteTripartite"/.GraphData[#,"NotationRules"],
Piecewise[{
{0,k m n/Max[k,m,n]==1},
{Ceiling[k m+m n+k n-3(k+m+n)]+6+Max[k,m,n]-1,Min[k,m,n]==1},
{Ceiling[k m+m n+k n-3(k+m+n)]+6,2<=Max[k,m,n]≤Min[k,m,n]+k m n/(Min[k,m,n]Max[k,m,n])-2},
{Ceiling[k m+m n+k n-3(k+m+n)]+6+Max[k,m,n]+2-Min[k,m,n]-k m n/(Min[k,m,n]Max[k,m,n]),Max[k,m,n]>Min[k,m,n]+k m n/(Min[k,m,n]Max[k,m,n])-2}
}],GraphData[#,"Skewness"]
}&/@GraphData["CompleteTripartite"],{_,_,_,_Missing}|{_,_,x_,x_}]]

Complete Tripartite n×n×n

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

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

FullSimplify[Piecewise[{
{0,k m n/Max[k,m,n]==1},
{Ceiling[k m+m n+k n-3(k+m+n)]+6+Max[k,m,n]-1,Min[k,m,n]==1},
{Ceiling[k m+m n+k n-3(k+m+n)]+6,2<=Max[k,m,n]≤Min[k,m,n]+k m n/(Min[k,m,n]Max[k,m,n])-2},
{Ceiling[k m+m n+k n-3(k+m+n)]+6+Max[k,m,n]+2-Min[k,m,n]-k m n/(Min[k,m,n]Max[k,m,n]),Max[k,m,n]>Min[k,m,n]+k m n/(Min[k,m,n]Max[k,m,n])-2}
}]/.{k->n,m->n},n>0]

Table[Ceiling[3n(n-3)]+6,{n,10}]

CubeConnectedCycle

Entity["Graph",{"CubeConnectedCycle",n}]["Skewness"]

seq=Table[GraphData[{"CubeConnectedCycle",n},"Skewness"],{n,3,8}]

Cycle

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

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

Empty

Entity["Graph",{"Empty",n}]["Skewness"]

seq=Table[GraphData[{"Empty",n},"Skewness"],{n,30}]

GeneralizedPetersen

Grid m×n

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

DeleteCases[{#2,GraphData[#2,"Skewness"],0}&@@@Select[{"Grid"/.GraphData[#,"NotationRules"],#}&/@GraphData["Grid"],Length[#[[1]]]==2&],{_,x_,x_}]

Grid n×n

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

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

Grid k×m×n

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

Grid n×n×n

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

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

Hanoi

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

Hypercube

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

A291526

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

FindSequenceFunction[Drop[seq,3],n-2]//FullSimplify

Table[Piecewise[{{0,n==0||n==1}},(2^(n-1)) (n-4)+4],{n,0,10}]

Do[Print[{i,GraphSkewness[GraphData[{"Hypercube",i}]]//Timing}],{i,5}]

FindSequenceFunction[Drop[seq,2],n]//FullSimplify

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

FindLinearRecurrence[seq]

LinearRecurrence[{5,-8,4},{0,0,4},20]

gf=x FindGeneratingFunction[seq,x]

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

Keller

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

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

King n×n

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

Knight m×n

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

Knight n×n

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

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

Ladder

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

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

LadderRung

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

MoebiusLadder

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

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

MengerSponge

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

Mycielski

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

seq=Table[GraphData[{"Mycielski",n},"Skewness"],{n,10}]

Odd

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

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

Pan

GraphData[{"Pan",6}]

seq=Table[GraphData[{"Pan",n},"Skewness"],{n,3,20}]

Path

Entity["Graph",{"Path",n}]["Skewness"]

seq=Table[GraphData[{"Path",n},"Skewness"],{n,20}]

Prism

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

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

Queen n×n

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

Rook n×n

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

RookComplement n×n

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

SierpinskiCarpet

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

SierpinskiSieve

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

SierpinskiTetrahedron

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

Star

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

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

Sun

Same a (Subscript[K, n]) skewness

GraphData[{"Sun",5}]

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

Table[GraphData[{"Complete",n},"Skewness"],{n,3,20}]

Sunlet

GraphData[{"Sunlet",6}]

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

Transposition

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

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

Wheel

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

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

WhiteBishop n×n

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

Algorithms

Loop

DeleteCases[{#,GraphData[#,"Skewness"],GraphSkewness[GraphData[#],Method->"Loop"]}&/@ GraphData["Nonplanar",;;8],{_,x_,x_}]//Timing

MapSubsetsEdgeDelete

(EdgeDelete is slow)

DeleteCases[{#,GraphData[#,"Skewness"],GraphSkewness[GraphData[#],Method->"MapSubsetsEdgeDelete"]}&/@ GraphData["Nonplanar",;;8],{_,x_,x_}]//Timing

MapSubsets

DeleteCases[{#,GraphData[#,"Skewness"],GraphSkewness[GraphData[#],Method->"MapSubsets"]}&/@ GraphData["Nonplanar",;;8],{_,x_,x_}]//Timing

SymmetricallyDistinctEdges

DeleteCases[
Monitor[{gn=#,GraphData[#,"Skewness"],GraphSkewness[GraphData[#],Method->"SymmetricallyDistinctEdges"]}&/@ GraphData["Nonplanar",;;6],gn],
{_,x_,x_}]//Timing

DeleteCases[
Monitor[{gn=#,GraphData[#,"Skewness"],GraphSkewness[GraphData[#],Method->"SymmetricallyDistinctEdges"]}&/@ GraphData["Nonplanar",;;7],gn],
{_,x_,x_}]//Timing

Disconnected

DeleteCases[
Monitor[{gn=#,GraphData[#,"Skewness"],GraphSkewness[GraphData[#]]}&/@GraphData["Disconnected",;;9],gn],
{_,x_,x_}
]//Timing