Permutation Star Graph

Author

Eric W. Weisstein
November 24, 2023

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

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

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

Embeddings

<<MathWorld`Graphs`

GraphData["PermutationStar*"]

{"PermutationStar", {5, 2}}

GraphData[{"PermutationStar",{5,2}},"StandardName"]

Primary

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

All

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

Default embedding

GraphPlot@GraphData[{"PermutationStar",{5,2}},"Edges"]

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"PermutationStar",{5,2}},"EdgeList"]]

Degenerate

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

Circular

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

Planar

GraphData[{"PermutationStar",{5,2}},"Planar"]

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

MinimalCrossing

GraphData[{"PermutationStar",{5,2}},{"RCN","CN"}]

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

MinimalCrossing construction

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

CrossingNumber[GraphData[{"PermutationStar",{5,2}}],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData[{"PermutationStar",{5,2}}],"CrossingNumber"->cn]]

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

GraphPlot@RotateGraph[,Pi/2]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"PermutationStar",{5,2}},"Circulant"]

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

Halin

GraphData[{"PermutationStar",{5,2}},"Halin"]

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

LCF

GraphData[{"PermutationStar",{5,2}},"LCF"]

GraphData[{"PermutationStar",{5,2}},"LCFSignature"]

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

LCF compute

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

Tally[(lcf=LCF[GraphData[{"PermutationStar",{5,2}}],All])[[All,2]]]

gs=LCFGraph@@@DeleteCases[lcf,{_,1}]

UnitDistance

GraphData[{"PermutationStar",{5,2}},"UnitDistance"]

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

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

Matchstick

GraphData[{"PermutationStar",{5,2}},"Matchstick"]

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

3D default

Graph3D[GraphData[{"PermutationStar",{5,2}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"PermutationStar",{5,2}},"Polyhedral"]

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

{"PermutationStar", {5, 3}}

GraphData[{"PermutationStar",{5,3}},"StandardName"]

Primary

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

All

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

Default embedding

GraphPlot@GraphData[{"PermutationStar",{5,3}},"Edges"]

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

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData[{"PermutationStar",{5,3}},"EdgeList"]]

Degenerate

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

Circular

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

Planar

GraphData[{"PermutationStar",{5,3}},"Planar"]

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

MinimalCrossing

GraphData[{"PermutationStar",{5,3}},{"RCN","CN"}]

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

MinimalCrossing construction

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

CrossingNumber[GraphData[{"PermutationStar",{5,3}}],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData[{"PermutationStar",{5,3}}],"CrossingNumber"->cn]]

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"PermutationStar",{5,3}},"Circulant"]

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

Halin

GraphData[{"PermutationStar",{5,3}},"Halin"]

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

LCF

GraphData[{"PermutationStar",{5,3}},"LCF"]

GraphData[{"PermutationStar",{5,3}},"HamiltonianCycleCount"]

GraphData[{"PermutationStar",{5,3}},"LCFSignature"]

GraphData[{"PermutationStar",{5,3}},"LCFNotations"]

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

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

LCF compute 10^5

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

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

LCF compute 10^6

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

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

LCF compute 10^7

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

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

LCF compute all

Divisors[GraphData[{"PermutationStar",{5,3}},"V"]]

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

Tally[(lcf=LCF[GraphData[{"PermutationStar",{5,3}}],All])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName[{"PermutationStar",{5,3}},".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

i=0;
gs={};
t0=AbsoluteTime[];
count=Length[order2];
Monitor[
Do[
If[!MissingQ[g=BilateralLCFGraph[LCFGraph@@order2[[i]]]],AppendTo[gs,g]],
{i,count}
],
Column[{
ProgressIndicator[i,{1,count}],
Row[{i,"/",count}],
Row[{"estimated time remaining: ",Round[(AbsoluteTime[]-t0) (count/i-1)]," s"}],
Row[{Length[gs]," bilateral graphs"}]
}]
];//Timing

UnitDistance

GraphData[{"PermutationStar",{5,3}},"UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine/@GraphData[{"PermutationStar",{5,3}},"Graph","All"]

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistanceEmbeddingRefine/@Complement@@(GraphData[{"PermutationStar",{5,3}},"Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

FindUnitDistanceEmbedding[GraphData[{"PermutationStar",{5,3}}],MaxIterations->1000,"ReturnWithMessage"->False]//Quiet//Timing

FindUnitDistanceEmbedding[GraphData[{"PermutationStar",{5,3}}],MaxIterations->50000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{{"PermutationStar",{5,3}},l=FindSubgraphUnitDistanceEmbedding[GraphData[{"PermutationStar",{5,3}}],TimeConstraint->300,"Results"->All]//Timing}

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

{{"PermutationStar",{5,3}},l=FindSubgraphUnitDistanceEmbedding[GraphData[{"PermutationStar",{5,3}}],TimeConstraint->300,"Results"->All]//Timing}

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

Matchstick

GraphData[{"PermutationStar",{5,3}},"Matchstick"]

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

3D default

Graph3D[GraphData[{"PermutationStar",{5,3}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"PermutationStar",{5,3}},"Polyhedral"]

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

{"PermutationStar", {5, 4}}

Names

GraphData[{"PermutationStar",{5,4}},"StandardName"]

GraphData[{"PermutationStar",{5,4}},"StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"PermutationStar",{5,4}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"PermutationStar",{5,4}},"Edges"]

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

RecognizeGraph[g]

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData[{"PermutationStar",{5,4}},"Graph","Degenerate"]

Perspective

GraphData[{"PermutationStar",{5,4}},"Graph","Perspective"]//StyleGraphs

Perspective construction

GraphData[{"PermutationStar",{5,4}},"Polyhedron"]

Bilateral

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

Circular

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

Planar

GraphData[{"PermutationStar",{5,4}},"Planar"]

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

MinimalCrossing

GraphData[{"PermutationStar",{5,4}},{"RCN","CN"}]

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"PermutationStar",{5,4}}],TimeConstraint->1])//AbsoluteTiming

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

(g=MinimalCrossingGraph[GraphData[{"PermutationStar",{5,4}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[g,"OuterFace"->#]&/@faces

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

Table[MinimalCrossingGraph[GraphData[{"PermutationStar",{5,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[{"PermutationStar",{5,4}},"Circulant"]

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

Complement graph

GraphData[{"PermutationStar",{5,4}},"ComplementGraph","Name"]

Line graph

GraphData[{"PermutationStar",{5,4}},"Line"]

LineGraphQ[GraphData[{"PermutationStar",{5,4}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"PermutationStar",{5,4}}&]

RootGraph[GraphData[{"PermutationStar",{5,4}}]]

Halin

GraphData[{"PermutationStar",{5,4}},"Halin"]

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

Rigid

GraphData[{"PermutationStar",{5,4}},"Rigid"]

GraphData[{"PermutationStar",{5,4}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"PermutationStar",{5,4}},"Flexible"]

GraphData[{"PermutationStar",{5,4}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"PermutationStar",{5,4}},"LCF"]

GraphData[{"PermutationStar",{5,4}},"HamiltonianCycleCount"]

GraphData[{"PermutationStar",{5,4}},"LCFSignature"]

GraphData[{"PermutationStar",{5,4}},"LCFNotations"]

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

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

LCF compute random

FindRandomLCFNotation[GraphData[{"PermutationStar",{5,4}}],TimeConstraint->120]

LCF compute 10^5

Tally[(lcf=LCF[GraphData[{"PermutationStar",{5,4}}],10^5])[[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

BilateralGraphEmbeddingQ/@gs

LCF compute 10^6

Tally[(lcf=LCF[GraphData[{"PermutationStar",{5,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

BilateralGraphEmbeddingQ/@gs

LCF compute all

Divisors[GraphData[{"PermutationStar",{5,4}},"V"]]

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

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

MaxMemoryUsed[]/10.^9 "GB"

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName[{"PermutationStar",{5,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[{"PermutationStar",{5,4}},"UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"PermutationStar",{5,4}},"VertexList"],GraphData[{"PermutationStar",{5,4}},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

FindUnitDistanceEmbedding[GraphData[{"PermutationStar",{5,4}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{{"PermutationStar",{5,4}},l=FindSubgraphUnitDistanceEmbedding[GraphData[{"PermutationStar",{5,4}}],TimeConstraint->300,"Results"->All]//Timing}

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

Matchstick

GraphData[{"PermutationStar",{5,4}},"Matchstick"]

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

3D default

Graph3D[GraphData[{"PermutationStar",{5,4}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"PermutationStar",{5,4}},"Polyhedral"]

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

{"PermutationStar", {6, 2}}

Names

GraphData[{"PermutationStar",{6,2}},"StandardName"]

GraphData[{"PermutationStar",{6,2}},"StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"PermutationStar",{6,2}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"PermutationStar",{6,2}},"Edges"]

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

RecognizeGraph[g]

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData[{"PermutationStar",{6,2}},"Graph","Degenerate"]

Perspective

GraphData[{"PermutationStar",{6,2}},"Graph","Perspective"]//StyleGraphs

Perspective construction

GraphData[{"PermutationStar",{6,2}},"Polyhedron"]

Bilateral

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

Circular

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

Planar

GraphData[{"PermutationStar",{6,2}},"Planar"]

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

MinimalCrossing

GraphData[{"PermutationStar",{6,2}},{"RCN","CN"}]

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"PermutationStar",{6,2}}],TimeConstraint->1])//AbsoluteTiming

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

(g=MinimalCrossingGraph[GraphData[{"PermutationStar",{6,2}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[g,"OuterFace"->#]&/@faces

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

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

GraphPlot[RotateGraph[,Pi/6],VertexSize->1]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"PermutationStar",{6,2}},"Circulant"]

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

Complement graph

GraphData[{"PermutationStar",{6,2}},"ComplementGraph","Name"]

Line graph

GraphData[{"PermutationStar",{6,2}},"Line"]

LineGraphQ[GraphData[{"PermutationStar",{6,2}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"PermutationStar",{6,2}}&]

RootGraph[GraphData[{"PermutationStar",{6,2}}]]

Halin

GraphData[{"PermutationStar",{6,2}},"Halin"]

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

Rigid

GraphData[{"PermutationStar",{6,2}},"Rigid"]

GraphData[{"PermutationStar",{6,2}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"PermutationStar",{6,2}},"Flexible"]

GraphData[{"PermutationStar",{6,2}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"PermutationStar",{6,2}},"LCF"]

GraphData[{"PermutationStar",{6,2}},"HamiltonianCycleCount"]

GraphData[{"PermutationStar",{6,2}},"LCFSignature"]

GraphData[{"PermutationStar",{6,2}},"LCFNotations"]

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

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

LCF compute all

Divisors[GraphData[{"PermutationStar",{6,2}},"V"]]

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

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

MaxMemoryUsed[]/10.^9 "GB"

With[{debug=True},
ComputeLCF[
If[debug,Print[#]];
#,
"Prune"->False,
Method->"FindHamiltonianCycle",
"ChunkSize"->10^6,
Debug->debug
]
]&/@{{"PermutationStar",{6,2}}};

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

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

gs

BilateralGraphEmbeddingQ/@%

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

Length[gs]

gs

UnitDistance

GraphData[{"PermutationStar",{6,2}},"UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"PermutationStar",{6,2}},"VertexList"],GraphData[{"PermutationStar",{6,2}},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

g=;

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

FindUnitDistanceEmbedding[GraphData[{"PermutationStar",{6,2}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"PermutationStar",{6,2}},"Matchstick"]

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

3D default

Graph3D[GraphData[{"PermutationStar",{6,2}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"PermutationStar",{6,2}},"Polyhedral"]

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

{"PermutationStar", {6, 3}}

Names

GraphData[{"PermutationStar",{6,3}},"StandardName"]

GraphData[{"PermutationStar",{6,3}},"StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"PermutationStar",{6,3}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"PermutationStar",{6,3}},"Edges"]

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

RecognizeGraph[g]

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData[{"PermutationStar",{6,3}},"Graph","Degenerate"]

Perspective

GraphData[{"PermutationStar",{6,3}},"Graph","Perspective"]//StyleGraphs

Perspective construction

GraphData[{"PermutationStar",{6,3}},"Polyhedron"]

Bilateral

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

Circular

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

Planar

GraphData[{"PermutationStar",{6,3}},"Planar"]

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

MinimalCrossing

GraphData[{"PermutationStar",{6,3}},{"RCN","CN"}]

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"PermutationStar",{6,3}}],TimeConstraint->1])//AbsoluteTiming

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

(g=MinimalCrossingGraph[GraphData[{"PermutationStar",{6,3}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[g,"OuterFace"->#]&/@faces

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

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData[{"PermutationStar",{6,3}},"Circulant"]

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

Complement graph

GraphData[{"PermutationStar",{6,3}},"ComplementGraph","Name"]

Line graph

GraphData[{"PermutationStar",{6,3}},"Line"]

LineGraphQ[GraphData[{"PermutationStar",{6,3}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"PermutationStar",{6,3}}&]

RootGraph[GraphData[{"PermutationStar",{6,3}}]]

Halin

GraphData[{"PermutationStar",{6,3}},"Halin"]

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

Rigid

GraphData[{"PermutationStar",{6,3}},"Rigid"]

GraphData[{"PermutationStar",{6,3}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"PermutationStar",{6,3}},"Flexible"]

GraphData[{"PermutationStar",{6,3}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"PermutationStar",{6,3}},"LCF"]

GraphData[{"PermutationStar",{6,3}},"HamiltonianCycleCount"]

GraphData[{"PermutationStar",{6,3}},"LCFSignature"]

GraphData[{"PermutationStar",{6,3}},"LCFNotations"]

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

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

LCF compute random

FindRandomLCFNotation[GraphData[{"PermutationStar",{6,3}}],TimeConstraint->120]

LCF compute 10^5

Tally[(lcf=LCF[GraphData[{"PermutationStar",{6,3}}],10^5])[[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

BilateralGraphEmbeddingQ/@gs

LCF compute 10^6

Tally[(lcf=LCF[GraphData[{"PermutationStar",{6,3}}],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

BilateralGraphEmbeddingQ/@gs

LCF compute 10^7

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

MaxMemoryUsed[]/10.^9 "GB"

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

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

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

LCF compute all

Divisors[GraphData[{"PermutationStar",{6,3}},"V"]]

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

Tally[(lcf=LCF[GraphData[{"PermutationStar",{6,3}}],All])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName[{"PermutationStar",{6,3}},".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[{"PermutationStar",{6,3}},"UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"PermutationStar",{6,3}},"VertexList"],GraphData[{"PermutationStar",{6,3}},"EdgeList"]],MaxIterations->500]

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

UnitDistance by FindUnitDistanceEmbedding

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

FindUnitDistanceEmbedding[GraphData[{"PermutationStar",{6,3}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"PermutationStar",{6,3}},"Matchstick"]

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

3D default

Graph3D[GraphData[{"PermutationStar",{6,3}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"PermutationStar",{6,3}},"Polyhedral"]

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

{"PermutationStar", {6, 5}}

Names

GraphData[{"PermutationStar",{6,5}},"StandardName"]

GraphData[{"PermutationStar",{6,5}},"StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData[{"PermutationStar",{6,5}},"EdgeList"]]

Default embedding

GraphPlot@GraphData[{"PermutationStar",{6,5}},"Edges"]

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

RecognizeGraph[g]

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData[{"PermutationStar",{6,5}},"Graph","Degenerate"]

Perspective

GraphData[{"PermutationStar",{6,5}},"Graph","Perspective"]//StyleGraphs

Perspective construction

GraphData[{"PermutationStar",{6,5}},"Polyhedron"]

Bilateral

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

Circular

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

Planar

GraphData[{"PermutationStar",{6,5}},"Planar"]

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

MinimalCrossing

GraphData[{"PermutationStar",{6,5}},{"RCN","CN"}]

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

MinimalCrossing construction

(cn=CrossingNumber[GraphData[{"PermutationStar",{6,5}}],TimeConstraint->1])//AbsoluteTiming

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

(g=MinimalCrossingGraph[GraphData[{"PermutationStar",{6,5}}],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[g,"OuterFace"->#]&/@faces

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

Table[MinimalCrossingGraph[GraphData[{"PermutationStar",{6,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[{"PermutationStar",{6,5}},"Circulant"]

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

Complement graph

GraphData[{"PermutationStar",{6,5}},"ComplementGraph","Name"]

Line graph

GraphData[{"PermutationStar",{6,5}},"Line"]

LineGraphQ[GraphData[{"PermutationStar",{6,5}}]]//Timing

RootGraph

Select[GraphData[All],GraphData[#,"LineGraph","Name"]=== {"PermutationStar",{6,5}}&]

RootGraph[GraphData[{"PermutationStar",{6,5}}]]

Halin

GraphData[{"PermutationStar",{6,5}},"Halin"]

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

Rigid

GraphData[{"PermutationStar",{6,5}},"Rigid"]

GraphData[{"PermutationStar",{6,5}},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"PermutationStar",{6,5}},"Flexible"]

GraphData[{"PermutationStar",{6,5}},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"PermutationStar",{6,5}},"LCF"]

GraphData[{"PermutationStar",{6,5}},"HamiltonianCycleCount"]

GraphData[{"PermutationStar",{6,5}},"LCFSignature"]

GraphData[{"PermutationStar",{6,5}},"LCFNotations"]

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

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

LCF compute random

FindRandomLCFNotation[GraphData[{"PermutationStar",{6,5}}],TimeConstraint->120]

LCF compute 10^5

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

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs]

LCF compute all

Divisors[GraphData[{"PermutationStar",{6,5}},"V"]]

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

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

MaxMemoryUsed[]/10.^9 "GB"

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName[{"PermutationStar",{6,5}},".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[{"PermutationStar",{6,5}},"UnitDistance"]

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

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData[{"PermutationStar",{6,5}},"VertexList"],GraphData[{"PermutationStar",{6,5}},"EdgeList"]],MaxIterations->500]

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

FindUnitDistanceEmbedding[GraphData[{"PermutationStar",{6,5}}],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{{"PermutationStar",{6,5}},l=FindSubgraphUnitDistanceEmbedding[GraphData[{"PermutationStar",{6,5}}],TimeConstraint->300,"Results"->All]//Timing}

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

Matchstick

GraphData[{"PermutationStar",{6,5}},"Matchstick"]

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

3D default

Graph3D[GraphData[{"PermutationStar",{6,5}},"Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData[{"PermutationStar",{6,5}},"Polyhedral"]

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

n-Star == (n, n - 1)-Star

SwapQ[l1_,l2_]:=MemberQ[Swap[l2,#]&/@Range[Length[l1]],l1]
PermutationStarSlow[n_]:=MakeGraph[Permutations[n],#1=!=#2&&SwapQ[#1,#2]&,Type->Undirected]

Swap[l0_,j_]:=Module[{l=l0,tmp=l0[[1]]},
l[[1]]=l[[j]];
l[[j]]=tmp;
l
]

PermutationStar[n_]:=Module[{e=Union[Sort/@Flatten[Outer[{#1,Swap[#1,#2]}&,Permutations[n],Range[n],1],1]],
v},
v=Union[Flatten[e,1]];
FromUnorderedPairs[DeleteCases[e/.Thread[v->Range[Length[v]]],{x_,x_}]]
]

s=PermutationStar/@Range[6];//Timing

s=PermutationStar/@Range[7];//Timing

Figure

gs=SortBy[{("PermutationStar"/.GraphData[#,"NotationRules"]),#}&/@GraphData["PermutationStar"],First]

n-star

GraphicsGrid[{GraphPlot[Graph[{"PermutationStar",#}],Method->None,PlotLabel->Subscript[PS,#]]&/@Range[4]},ImageSize->400,Spacings->-20]

(n,k)-star

nicegs=Select[gs,GraphData[#[[2]],"Embeddings"]=!={}&]

GraphicsGrid[Partition[GraphPlot[Graph[#[[2]]],Method->None,BaseStyle->Italic,PlotLabel->TextCell[Column[{Subscript["S",Style[Row[Riffle[#[[1]],","]],Plain]],GraphData[#[[2]],"Name"]},Alignment->Center]]]&/@nicegs,3,3,{1,1},{}],ImageSize->450]

Properties (n) == (n, n - 1)

IndependentEdgeSetCount

A293242

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

IndependentVertexSetCount

A292991

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

MolecularTopologicalIndex

A192837

Table[GraphData[{"PermutationStar",n},"MolecularTopologicalIndex"],{n,6}]

Construct using:

A007799

a[n_,0]=1;a[n_,1]=n-1;a[n_,2]=(n-1)(n-2);a[n_,k_/;k≥2]:=a[n,k]=(n-1)a[n-1,k-1]+Sum[j a[j,k-3],{j,n-2}];

Sum[j a[j,k-3],{j,n-2}]

Table[a[n,k],{n,9},{k,0,Floor[3(n-1)/2]}]//Column

Take[seq=Table[n!(n-1)(n-1+Sum[k a[n,k],{k,Floor[3(n-1)/2]}]),{n,50}],20]

FindLinearRecurrence[seq]//Head//Timing

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

WienerIndex

A284039

Table[GraphData[{"PermutationStar",n},"WienerIndex"],{n,6}]

Do[Print[{n,WienerIndex[PermutationStarGraph[n]]//Timing}],{n,10}]

Construct using:

A007799

a[n_,0]=1;a[n_,1]=n-1;a[n_,2]=(n-1)(n-2);a[n_,k_/;k≥2]:=a[n,k]=(n-1)a[n-1,k-1]+Sum[j a[j,k-3],{j,n-2}];

Sum[j a[j,k-3],{j,n-2}]

Table[a[n,k],{n,1,9},{k,0,Floor[3(n-1)/2]}]//Column

Take[seq=Table[n!/2 Sum[k a[n,k],{k,Floor[3(n-1)/2]}],{n,50}],20]

FindLinearRecurrence[Rest@seq]//Head//Timing

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

Properties (n, k)

Special cases

Grid[Flatten[Table[{{n,k},RecognizeGraph[PermutationStarGraph[n,k]]},{n,2,6},{k,2,n-1}],1],Dividers->All,Alignment->Left]

Properties

gs=Table[PermutationStar[n,k],{n,3,5},{k,2,n-1}];//Timing

gs=Table[PermutationStar[n,k],{n,3,6},{k,2,n-1}];//Timing

gs=Table[PermutationStar[n,k],{n,3,7},{k,2,n-1}];//Timing

The (n, k) -star graph is regular of degree n - 1, the number of nodes n!/(n - k)!, and diameter 2k - 1 for k < =Floor[n/2] and Floor[(n - 1) /2] + k for k>= Floor[n/2]+1.

And@@Equal@@@Flatten[Table[{Union[Degrees[PermutationStar[n,k]]],{n-1}},{n,3,5},{k,2,n-1}],1]

And@@Equal@@@Flatten[Table[{V[PermutationStar[n,k]],((n!)/((n-k)!))},{n,3,5},{k,2,n-1}],1]

Vertices between 1000 and 200,000

{n,k}/.{ToRules[Reduce[1000≤FactorialPower[n,k]≤200000&&n (n-1)≤200000&&n>k≥2&&k≥n-3,{n,k},Integers]]}

FactorialPower[n, k] is better than a ratio of two factorials, since non-polynomial functions get replaced by new variables and one bounded variable is better than two unbounded variables...
The hint n*(n-1)<=200000 is also necessary, otherwise Reduce doesn’t figure out that the search region is bounded.

Reduce[1000≤Pochhammer[n-k+1,k]≤200000&&n (n-1)≤200000&&n>k≥2&&k≥n-3,{n,k},Integers]

hangs

((#1!)/((#1-#2)!))&@@@%39

1000<#<200000&/@%

And@@Equal@@@Flatten[Table[{Diameter[PermutationStar[n,k]],If[k<=Floor[n/2],2k-1,Floor[(n-1)/2]+k]},{n,3,5},{k,2,n-1}],1]

Vertex-transitive

VertexTransitiveQ/@Flatten[gs]//Timing

EdgeTransitiveQ/@Flatten[gs]//Timing

ArcTransitiveQ/@Flatten[gs]//Timing

Vertices

V/@s

Recognize

RecognizeGraph/@s

Degrees

RegularQ/@s

Union/@Degrees/@s

VertexConnectivity

Print[VertexConnectivity[#]//Timing]&/@s

Diameter

Diameter/@s

Table[Floor[3(n-1)/2],{n,6}]

Vertex-Tramsitive

VertexTransitiveQ/@s

Edge-Tramsitive

EdgeTransitiveQ/@s//Timing

Arc-Transitive

Print[ArcTransitiveQ[#]//Timing]&/@s

Print[ArcTransitivity[#]//Timing]&/@s

GraphData

GraphDataString

(n,k)-PermutationStar

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

Function[{n,k},WriteString[file,
GraphDataString[PermutationStar[n,k],
"StandardName"->{"PermutationStar",{n,k}},
"Name"->"("<>ToString[n]<>","<>ToString[k]<>")-permutation star graph",
"Vertices"->None,
"Information"->"PermutationStarGraph",
"Classes"->{"PermutationStar"},
"NotationRules"->{"PermutationStar"->{n,k}},
TimeConstraint->10,
Debug->True]]]@@@Flatten[Table[{n,k},{n,5,6},{k,2,n-2}],1];

Close[file]

n-PermutationStar

GraphData["PermutationStar*"]

file=OpenWrite["star.m"]

Do[WriteString[file,GraphDataString[PermutationStar[n],
"StandardName"->{"PermutationStar",n},
"Name"->ToString[n]<>"-permutation star graph",
"Vertices"->None,
"Information"->"StarGraph",
"Classes"->{"PermutationStar"},
"NotationRules"->{"PermutationStar"->n},
TimeConstraint->60,
Debug->True]],{n,5,6}];

Close[file]