Transposition Graph

Author

Eric W. Weisstein
October 26, 2023

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

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

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

Example

GraphData["Transposition"]

Table[GraphData[{"Transposition",n}],{n,6}]

GraphicsRow[
Table[
Show[
SetProperty[GraphData[{"Transposition",n}],{System`EdgeStyle->Black,System`VertexStyle->Red,VertexSize->{"Scaled",.04}}],
PlotLabel->Column[{
Style[GraphData[{"Transposition",n},"Name"],Italic],
Row[{Subscript[Style["T",Italic],n]}]
},Alignment->Center],
TextStyle->{FontFamily->"Times",FontColor->Black}
],{n,4}],ImageSize->500]

Embeddings

<<MathWorld`Graphs`

GraphData["Transposition"]

{"Transposition", 1} == "SingletonGraph"

GraphData[{"Transposition",1},"StandardName"]

{"Transposition", 2} == {"Path", 2}

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

{"Transposition", 3} == "UtilityGraph"

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

{"Transposition", 4}

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

Primary

GraphData[{"Transposition",4}]//StyleGraphs[#,ImageSize->Small]&

All

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

Inexact

Select[GraphData[{"Transposition",4},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Transposition",4},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"Transposition",4},"Edges"]

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

RecognizeGraph[g]

Degenerate

GraphData[{"Transposition",4},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"Transposition",4},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Transposition",4},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"Transposition",4},"Planar"]

GraphData[{"Transposition",4},"Graph","Planar"]//StyleGraphs

MinimalCrossing

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

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Transposition",4}],TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Transposition",4}],TimeConstraint->60])//AbsoluteTiming

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData[{"Transposition",4}],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData[{"Transposition",4},"V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData[{"Transposition",4}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Transposition",4},"Circulant"]

GraphData[{"Transposition",4},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"Transposition",4},"Halin"]

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

LCF

GraphData[{"Transposition",4},"LCF"]

GraphData[{"Transposition",4},"HamiltonianCycleCount"]

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

GraphData[{"Transposition",4},"LCFNotations"]

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

Tally[LCFNotation[#][[2]]&/@%]

LCF compute 10^6

Tally[(lcf=LCF[GraphData[{"Transposition",4}],10^6])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2])]//Timing

Length[gs]

gs

LCF compute 10^7

Tally[(lcf=LCF[GraphData[{"Transposition",4}],10^7])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1|2}]

LCFGraph@@@DeleteCases[lcf,{_,1|2}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,3])]//Timing

Length[gs]

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,3])]//Timing

gs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,4,3])]//Timing

Length[gs]

gs

l={{{"Transposition",4},{0,Missing["NotAvailable",DeleteCases[LCFNotation/@gs,{_,3}]]}}}

PropertyReplace[l,"LCFNotations","14.1"]

RenameGraphFiles[]

LCF compute all

Length[FindHamiltonianCycle[GraphData[{"Transposition",4}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"Transposition",4}],All])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName[{"Transposition",4},".m.gz"]])[[All,2]]]//Timing

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2,1])]//Timing

Length[gs]

gs

UnitDistance

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Transposition",4},"VertexList"],GraphData[{"Transposition",4},"EdgeList"]]]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]]]&/@Complement@@(GraphData[{"Transposition",4},"Graph",#]&/@{"All","UnitDistance"})

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Transposition",4}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

Matchstick

GraphData[{"Transposition",4},"Matchstick"]

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

3D default

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

3D All

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

3D UnitDistance

GraphData[{"Transposition",4},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Transposition",4},"Polyhedral"]

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

{"Transposition", 5}

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

Primary

GraphData[{"Transposition",5}]//StyleGraphs[#,ImageSize->Small]&

All

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

Inexact

Select[GraphData[{"Transposition",5},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Transposition",5},"EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

GraphData[{"Transposition",5},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"Transposition",5},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Transposition",5},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"Transposition",5},"Planar"]

GraphData[{"Transposition",5},"Graph","Planar"]//StyleGraphs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

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

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Transposition",5}],TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Transposition",5}],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Transposition",5}],TimeConstraint->300])//AbsoluteTiming

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData[{"Transposition",5}],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData[{"Transposition",5},"V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData[{"Transposition",5}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Transposition",5},"Circulant"]

GraphData[{"Transposition",5},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"Transposition",5},"Halin"]

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

LCF

GraphData[{"Transposition",5},"LCF"]

GraphData[{"Transposition",5},"HamiltonianCycleCount"]

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

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

Tally[LCFNotation[#][[2]]&/@%]

LCF compute

Length[FindHamiltonianCycle[GraphData[{"Transposition",5}],All][[All,All,1]]]//Timing

Divisors[GraphData[{"Transposition",5},"V"]]

Tally[(lcf=LCF[GraphData[{"Transposition",5}],(10^6)])[[All,2]]]//Timing

Tally[(lcf=LCF[GraphData[{"Transposition",5}],(10^6)])[[All,2]]]//Timing

LCFGraph@@@lcf//StyleGraphs

gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFEmbedding[#],#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFEmbedding/@LCFGraph@@@Cases[lcf,{_,1}]]}]

UnitDistance

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

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

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

Select[%,!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&]

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Transposition",5},"VertexList"],GraphData[{"Transposition",5},"EdgeList"]]]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]]]&/@Complement@@(GraphData[{"Transposition",5},"Graph",#]&/@{"All","UnitDistance"})

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Transposition",5}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

Matchstick

GraphData[{"Transposition",5},"Matchstick"]

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

3D default

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

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"Transposition",5},"Polyhedral"]

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

{"Transposition", 6}

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

Primary

GraphData[{"Transposition",6}]//StyleGraphs[#,ImageSize->Small]&

All

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

Inexact

Select[GraphData[{"Transposition",6},"Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData[{"Transposition",6},"EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

GraphData[{"Transposition",6},"Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData[{"Transposition",6},"Graph","Bilateral"]//StyleGraphs

Circular

GraphData[{"Transposition",6},"Graph","Circular"]//StyleGraphs

Planar

GraphData[{"Transposition",6},"Planar"]

GraphData[{"Transposition",6},"Graph","Planar"]//StyleGraphs

MinimalCrossing

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

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"Transposition",6}],TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Transposition",6}],TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Transposition",6}],TimeConstraint->300])//AbsoluteTiming

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData[{"Transposition",6}],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData[{"Transposition",6},"V"]&]]//Timing

Table[MinimalCrossingGraph[GraphData[{"Transposition",6}],"CrossingNumber"->cn,RandomSeed->i],{i,50}]//Union

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"Transposition",6},"Circulant"]

GraphData[{"Transposition",6},"Graph","Circulant"]//StyleGraphs

Halin

GraphData[{"Transposition",6},"Halin"]

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

LCF

GraphData[{"Transposition",6},"LCF"]

GraphData[{"Transposition",6},"HamiltonianCycleCount"]

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

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

Tally[LCFNotation[#][[2]]&/@%]

LCF compute

Length[FindHamiltonianCycle[GraphData[{"Transposition",6}],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData[{"Transposition",6}],(10^4)])[[All,2]]]//Timing

LCFGraph@@@lcf//StyleGraphs

gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFEmbedding[#],#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFEmbedding/@LCFGraph@@@Cases[lcf,{_,1}]]}]

UnitDistance

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"Transposition",6},"VertexList"],GraphData[{"Transposition",6},"EdgeList"]]]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]]]&/@Complement@@(GraphData[{"Transposition",6},"Graph",#]&/@{"All","UnitDistance"})

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData[{"Transposition",6}],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

Matchstick

GraphData[{"Transposition",6},"Matchstick"]

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

3D default

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

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"Transposition",6},"Polyhedral"]

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

Construction

GraphData[{"Transposition",4},"Configurations"]

RecognizeGraph/@LeviGraph/@%

Properties

Acyclic

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

AdjacencyMatrixCount

seq=Table[GraphData[{"Transposition",n},"AdjacencyMatrixCount"],{n,5}]

FindSequenceFunction[Rest@seq,n]

Table[(((n!)!)/(Piecewise[{{1, n==1},{2,n==2}},2n!^2])),{n,5}]

%==seq

FullSimplify[(((n!)!)/(Piecewise[{{1, n==1},{2,n==2}},2n!^2]))]

Arboricity

Table[GraphData[{"Transposition",n},"Arboricity"],{n,6}]

ArcTransitive

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

ArcTransitivity

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

AutomorphismCount

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

FindLinearRecurrence[seq]

FindSequenceFunction[seq,n]

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

x FindGeneratingFunction[seq,x]

(seq=Table[GroupOrder[GraphAutomorphismGroup[TranspositionGraph[n]]],{n,8}])//Timing

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

Table[Piecewise[{{1, n==1},{2,n==2}},2n!^2],{n,8}]

BalabanIndex

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

FindSequenceFunction[seq,n]

(seq=Table[BalabanIndex[TranspositionGraph[n]],{n,6}])//Timing

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

FindSequenceFunction[Rest@seq,n-1]

(seq=Table[BalabanIndex[TranspositionGraph[n]],{n,8}])//Timing

FindSequenceFunction[Rest@seq,n-1]

Bandwidth

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

Bipartite

Table[GraphData[{"Transposition",n},"Bipartite"],{n,6}]

BridgeCount

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

BurningNumber

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

ChordCount

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

FindSequenceFunction[seq,n]

ChordlessCycleCount

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

FindSequenceFunction[seq,n]

ChromaticInvariant

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

FindSequenceFunction[Drop[seq,2],n]

ChromaticNumber

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

Circumference

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

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

seq=Table[Piecewise[{{Missing["NotApplicable"],n==1||n==2}},n!],{n,6}]

Classes

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

CliqueCount

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

FindSequenceFunction[seq,n]

(seq=Table[BalabanIndex[TranspositionGraph[n]],{n,8}])//Timing

gf=x FindGeneratingFunction[seq,x]

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

CliqueCoveringNumber

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

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

Table[n!/2,{n,6}]

CliqueNumber

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

ComplementOddChordlessCycleCount

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

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

ConnectedComponentCount

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

ConnectedDominatingSetCount

A291707

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

FindSequenceFunction[DeleteCases[seq,_Missing],n]

ConnectedDominationNumber

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

FindSequenceFunction[seq,n]

ConnectedDominationPolynomial

(poly=Factor@Table[GraphData[{"Transposition",n},"ConnectedDominationPolynomial"],{n,k0=1,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,20}]

FullSimplify[poly2-poly]

ConnectedInducedSubgraphCount

A290773

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

FindSequenceFunction[DeleteCases[seq,_Missing],n]

ConnectedInducedSubgraphPolynomial

(poly=DeleteCases[Factor@Table[GraphData[{"Transposition",n},"ConnectedInducedSubgraphPolynomial"][x],{n,k0=1,kmax=6}],_Missing[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,20}]

FullSimplify[poly2-poly]

CrossingNumber

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

CycleCount

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

Cyclic

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

CyclomaticNumber

A173038

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

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

(seq=Table[CyclomaticNumber[TranspositionGraph[n]],{n,8}])//Timing

Table[Binomial[n,2]n!/2-n!+1,{n,8}]

Table[(Binomial[n,2]/2-1)n!+1,{n,8}]

Factor[(Binomial[n,2]/2-1)]

DetourIndex

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

Diameter

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

DistinguishingNumber

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

DomaticNumber

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

DominatingSetCount

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

DominationNumber

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

Do[Print[{n,DominationNumber[GraphData[{"Transposition",n}]]//Timing}],{n,5}]

EdgeChromaticNumber

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

FindSequenceFunction[seq,n]

Table[Binomial[n,2],{n,6}]

EdgeConnectivity

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

EdgeCount

A001809

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

FindSequenceFunction[seq,n]

FindSequenceFunction[Rest@seq,n-1]

(seq=Table[EdgeCount[TranspositionGraph[n]],{n,8}])//Timing

FindSequenceFunction[Rest@seq,n-1]

FunctionExpand[%]

FullSimplify[(1/4) (-1+n) n Gamma[1+n]]

Table[Binomial[n,2]n!/2,{n,8}]

EdgeCoverCount

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

EdgeCoverNumber

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

FindSequenceFunction[seq,n]

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

Table[Piecewise[{{0,n==1}},n!/2],{n,6}]

EulerianCycleCount

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

FaceCount

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

FibonacciCube

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

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

FractionalChromaticNumber

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

FractionalEdgeChromaticNumber

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

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

Girth

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

Gonality

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

HamiltonConnected

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

HamiltonDecompositionCount

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

Hamiltonian

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

HamiltonianCycleCount

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

HamiltonianNumber

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

FindSequenceFunction[seq,n]

HamiltonianPathCount

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

HamiltonianWalkCount

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

HararyIndex

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

FindSequenceFunction[seq,n]

x FindSequenceFunction[seq,x]

HexagonCount

A300851

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

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

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

FindGeneratingFunction[seq,x]

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

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

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

Do[Print[{{"Transposition",n},CycleCount[TranspositionGraph[n],6]//Timing}],{n,8}]

seq={0,0,6,2880,83400,1742400,32810400,600606720};

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

gf=x FindGeneratingFunction[seq,x]

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

seq=Table[n!(Binomial[n,3]+116Binomial[n,4]+105Binomial[n,5]+30Binomial[n,6]),{n,20}]

FindLinearRecurrence[seq]

gf=x FindGeneratingFunction[seq,x]

FullSimplify[n!(Binomial[n,3]+116Binomial[n,4]+105Binomial[n,5]+30Binomial[n,6])]//Factor

Binomial[n,3]

seq=Table[n!Binomial[n,3] ((n^3)+9(n^2)+16n-152)/4,{n,30}]

FindLinearRecurrence[seq]

gf=x FindGeneratingFunction[seq,x]

IndependenceNumber

A001710

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

FindSequenceFunction[seq,n]

Table[Numerator[n!/2],{n,0,10}]

Numerator[Range[0,10]!/2]

Table[GroupOrder[System`AlternatingGroup[n]],{n,0,10}]

gf=FindGeneratingFunction[%,x]

IndependencePolynomial

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

CoefficientList[Take[poly,4],x]

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,k0,kmax}]

FullSimplify[poly2-poly]

IndependenceRatio

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

FindSequenceFunction[seq,n]

IndependentEdgeSetCount

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

IndependentVertexSetCount

A292709

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

FindSequenceFunction[DeleteCases[seq,_Missing],n]

IntersectionNumber

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

KirchhoffIndex

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

FindSequenceFunction[Rest@seq,n-1]

(seq=Table[KirchhoffIndex[TranspositionGraph[n]],{n,6}])//Timing

FindSequenceFunction[Rest@seq,n-1]

KirchhoffSumIndex

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

FindSequenceFunction[Rest@seq,n-1]

(seq=Table[KirchhoffSumIndex[TranspositionGraph[n]],{n,6}])//Timing

FindSequenceFunction[Rest@seq,n-1]

LeafCount

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

LongestCycleCount

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

LovaszNumber

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

LucasCube

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

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

MatchingNumber

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

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

MaximalCliqueCount

A001809

==EdgeCount

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

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

Table[Piecewise[{{1,n==1}},n!n(n-1)/4],{n,6}]

Table[n!Binomial[n,2]/2,{n,6}]

Table[Piecewise[{{1,n==1}},n!Binomial[n,2]/2],{n,6}]

MaximalIndependentEdgeSetCount

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

MaximalIndependentVertexSetCount

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

MaximumCliqueCount

A001809

==EdgeCount

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

Table[Piecewise[{{1,n==1}},n!Binomial[n,2]/2],{n,6}]

MaximumIndependentEdgeSetCount

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

MaximumIndependentVertexSetCount

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

Table[GraphData[{"Transposition",n},"MaximumIndependentVertexSets"],{n,4}]

Sort[FindIndependentVertexSet[GraphData[{"Transposition",4}],{4!/2},All]]

MaximumLeafNumber

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

MaximumVertexDegree

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

Table[Binomial[n,2],{n,6}]

MeanDistance

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

FindSequenceFunction[seq,n]//FullSimplify

MinimalDominatingSetCount

A290873

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

MinimalDominatingSetSignature

seq=Table[GraphData[{"Transposition",n},"MinimalDominatingSetSignature"],{n,6}]//Column

MinimumCliqueCoveringCount

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

MinimumConnectedDominatingSetCount

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

FindSequenceFunction[DeleteCases[seq,_Missing],n]

MinimumDistinguishingLabelingCount

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

MinimumDominatingSetCount

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

MinimumEdgeCoverCount

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

MinimumVertexDegree

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

Table[Binomial[n,2],{n,6}]

MolecularTopologicalIndex

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

FindSequenceFunction[seq,n]

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

FindSequenceFunction[Rest@seq,n-1]

(seq=Table[MolecularTopologicalIndex[TranspositionGraph[n]],{n,8}])//Timing

FindSequenceFunction[Rest@seq,n-1]

Nonhamiltonian

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

OddChordlessCycleCount

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

PathCount

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

FindLinearRecurrence[DeleteMissing@seq]

FindSequenceFunction[DeleteMissing@seq,n-3]//Factor

PathPolynomial

(poly=Factor[Table[GraphData[{"Transposition",n},"PathPolynomial"],{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,k0,kmax}]

FullSimplify[poly2-poly]

Pell

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

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

PentagonCount

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

Perfect

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

ProjectivePlaneCrossingNumber

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

Radius

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

RectilinearCrossingNumber

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

SpanningTreeCount

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

FindSequenceFunction[Rest@seq,n-1]

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

SquareCount

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

A300843

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

(seq=Table[GraphCycleCount[TranspositionGraph[n],4],{n,8}])//Timing

Do[Print[{{"Transposition",n},CycleCount[TranspositionGraph[n],4]//Timing,MaxMemoryUsed[]/10^9. GB}],{n,10}]

seq={0,0,9,162,2250,29700,396900,5503680};

Head/@Table[FindSequenceFunction[Drop[seq,k],n-k],{k,0,3}]//Union

Head/@Table[FindLinearRecurrence[Drop[seq,k]],{k,0,3}]//Union

x FindGeneratingFunction[seq,x]

Table[3 n! (2 Binomial[n,3]+Binomial[n,4])/4,{n,25}]

FullSimplify[3 n! (2 Binomial[n,3]+Binomial[n,4])/4]

seq=Table[3(n+5)Binomial[n,3]n!/16,{n,40}]

FindSequenceFunction[seq,n]

FindLinearRecurrence[seq]//Head

FindGeneratingFunction[seq,x]//Head

StabilityIndex

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

FindSequenceFunction[seq,n]

x FindGeneratingFunction[seq,x]

TopologicalIndex

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

ToroidalCrossingNumber

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

Traceable

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

TriangleCount

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

Untraceable

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

VertexConnectivity

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

VertexCount

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

FindSequenceFunction[seq,n]

VertexCoverNumber

Related to but not the same as IndependenceNumber

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

VertexDegrees

seq=Table[GraphData[{"Transposition",n},"VertexDegrees"],{n,5}]

WienerIndex

A292062

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

Do[Print[{{"Transposition",n},WienerIndex[TranspositionGraph[n]]//Timing}],{n,10}]

seq={0,1,21,552,19560,920160,55974240,4293596160,406306575360,46556342784000,6357567896064000,1020650937901056000,190386526063878144000,40844355820490686464000,9987985777548364185600000,2762125829379285162393600000,857790151281459139077734400000};

FindSequenceFunction[seq,n]

FindLinearRecurrence[seq]

FindLinearRecurrence[Rest@seq]

gf=x FindGeneratingFunction[seq,x]

Table[n!(n n!-Abs[StirlingS1[n+1,2]])/2,{n,20}]

FullSimplify[n!(n n!-(((-1))^(n+1))StirlingS1[n+1,2])/2]//FunctionExpand

Table[n!(n n!-(((-1))^(n+1))StirlingS1[n+1,2])/2,{n,20}]

WienerSumIndex

seq=Table[GraphData[{"Transposition",n},"WienerSumIndex"],{n,5}]

FindSequenceFunction[Rest@seq,n-1]

(seq=Table[WienerSumIndex[TranspositionGraph[n]],{n,8}])//Timing

FindSequenceFunction[Rest@seq,n-1]

GraphDataString

?GraphDataString

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

Do[WriteString[file,GraphDataString[TranspositionGraph[n],
"StandardName"->{"Transposition",n},
"Name"->ToString[n]<>"\[Hyphen]transposition graph",
"Classes"->{"Transposition"},
"Information"->"TranspositionGraph",
"NotationRules"->{"Transposition"->n},
"Embeddings"->None,
"Notation"->Subscript["G",n],
"Skip"->{"ChromaticPolynomial","TuttePolynomial","ChromaticPolynomial","DominatingSet","IdiosyncraticPolynomial","HamiltonianWalks","MaximalIndependentVertexSets"},
Debug->True,
TimeConstraint->10
]],
{n,5,6}]

Close[file]