Crown Graph

Author

Eric W. Weisstein
May 7, 2026

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/CrownGraph.nb.

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

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

Figure

Graphs.m

GraphicsRow[
Table[
CrownGraph[n,PlotLabel->Style[Row[{Style["n",Italic]," == ",n}],Directive[LightDarkSwitched@Black,FontFamily->"Times"]]],
{n,5}
]//StyleGraphs[#,VertexSize->{"Scaled",.08}]&,
Dividers->All,Alignment->Top,ImageSize->400]

GraphData

GraphicsRow[
Table[
Annotate[GraphData[{"Crown",n},"Graph","Bipartite"][[1]],PlotLabel->Style[Row[{Style["n",Italic]," == ",n}],Directive[LightDarkSwitched@Black,FontFamily->"Times"]]],
{n,5}
]//StyleGraphs[#,VertexSize->{"Scaled",.08}]&,
Dividers->All,Alignment->Top,ImageSize->400]

Special cases

TextGrid[Sort[{"Crown"/.GraphData[#,"NotationRules"],#,GraphData[#,"Name"]}&/@DeleteCases[GraphData["Crown"],{"Crown",_}]],Dividers->All]

Definitions

Cartesian product (Subscript[K, n])□(Subscript[K, 2])

RecognizeGraph/@Table[GraphComplement@GraphCartesianProduct[CompleteGraph[2],CompleteGraph[k]],{k,10}]

GetGraphData[#,"File"]&/@%

GraphData[#,"VertexCount"]&/@%

Complement of {"Rook", {2, k}}

RecognizeGraph/@Table[GraphComplement[LineGraph[CompleteGraph[{2,k}]]],{k,10}]

ToEntity/@%

CompleteBipartite minus a matching

Table[With[{k=CompleteGraph[{n,n}]},EdgeDelete[k,FindIndependentEdgeSet[k]]],{n,6}]

RecognizeGraph/@%

Edge-deletion from CompleteBipartite

DeleteEdges[CompleteGraph[n,n],{#,#+n}&/@Range[n]]/;n≥3

Table[System`CompleteGraph[{n,n},VertexLabels->"Name"],{n,3}]

Table[EdgeDelete[System`CompleteGraph[{n,n}],UndirectedEdge[#,#+n]&/@Range[n]],{n,5}]

ToEntity/@%

Embeddings

<<MathWorld`Graphs`

{"Crown", 1} == {"Empty", 2}

Names

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

GraphData[{"Crown",1},"StandardNames"]

{"Crown", 2} == {"LadderRung", 2}

Names

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

GraphData[{"Crown",2},"StandardNames"]

{"Crown", 3} == {"Cycle" ,6}

Names

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

GraphData[{"Crown",3},"StandardNames"]

{"Crown", 4} == "CubicalGraph"

Names

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

GraphData[{"Crown",4},"StandardNames"]

{"Crown", 5}

Names

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

GraphData[{"Crown",5},"StandardNames"]

HouseOfGraphs

hogid=GraphData[{"Crown",5},"NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData[{"Crown",5},"WikidataID"]

GraphData[{"Crown",5},"WikidataID","URL"]

Primary

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

Read and Wilson construction

g=Graph[Range[10],UndirectedEdge@@@{{1,2},{1,3},{1,7},{1,10},{2,4},{2,8},{2,9},{3,4},{3,5},{3,8},{4,6},{4,7},{5,6},{5,7},{5,10},{6,8},{6,9},{7,9},{8,10},{9,10}},VertexCoordinates->(10^(-4)){{8448,-9985},{9952,-14618},{9952,-5352},{13890,-17481},{13890,-2488},{18759,-17481},{18759,-2488},{22697,-14618},{22697,-5352},{24201,-9985}}]

RecognizeGraph@g

All

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

Inexact

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

Embedding types

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

Default embedding

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

v=Join[UnitCirclePoints[6]];
v=Join[v,Subdivide[v[[6]],v[[4]],3][[2;;-2]],Subdivide[v[[1]],v[[3]],3][[2;;-2]]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,4,5,6,1,7,9,4,10,8,1],e[6,9,2,10,6],e[7,5,8,3,7]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

GraphPlot[GraphData[{"Crown",5},"Edges"],GraphLayout->"SpringEmbedding"]

v=Join[UnitCirclePoints[8],{0,Sqrt[2]#/2}&/@{-1,1}];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,4,6,5,3,9,8,7,6,9,1,4,10,7,1],e[8,5,10,2,8]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Degenerate

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

Bipartite

GraphData[{"Crown",5},"Bipartite"]

GraphData[{"Crown",5},"Graph","Bipartite"]//StyleGraphs

Bipartite construction

GraphData[{"Crown",5},"Bipartite"]

g=BipartiteGraph[GraphData[{"Crown",5}]]

RecognizeGraph@g

Bilateral

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

Circular

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

Planar

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

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

GraphPlot@

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

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

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

Halin

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

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

LCF

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

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

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

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

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

LCF compute

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

Tally[(lcf=LCF[GraphData[{"Crown",5}],All])[[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[{"Crown",5},"UnitDistance"]

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

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

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

3D default

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

3D All

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

3D UnitDistance

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

3D Polyhedron

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

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

{"Crown", 6}

Names

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

GraphData[{"Crown",6},"StandardNames"]

HouseOfGraphs

hogid=GraphData[{"Crown",6},"NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData[{"Crown",6},"WikidataID"]

GraphData[{"Crown",6},"WikidataID","URL"]

House of Graphs construction

GraphPlot@RotateGraph[CenterGraph@HouseOfGraphsGraph[hogid],.07]

v=Join[CirclePoints[{1,Pi/2},6],CirclePoints[{1/2,Pi/2},6]];
g=FindCorrespondingGraph[,v]

RecognizeGraph@g

Primary

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

All

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

CurvedEdge

GraphData[{"Crown",6},"Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Embedding types

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

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

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

IGraph

GraphData[{"Crown",6},"Graph","IGraph"]//StyleGraphs

CompleteKPartite

GraphData[{"Crown",6},"Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData[{"Crown",6},"Bipartite"]

GraphData[{"Crown",6},"Graph","Bipartite"]//StyleGraphs

Bipartite construction

GraphData[{"Crown",6},"Bipartite"]

g=BipartiteGraph[GraphData[{"Crown",6}]]

RecognizeGraph@g

Bilateral

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

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingTypes[#],GraphSymmetryGroup[#]}&/@GraphData[{"Crown",5},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]

Circular

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

Planar

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

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

MinimalCrossingNumber crossings.uos.de [verified 12]

CrossingNumber[GraphData[{"Crown",6}],Method->"WebCompute"]//AbsoluteTiming

DateString[]

MinimalCrossingNumber: "EmbeddingScheme" -> 1

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

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

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

(cn=CrossingNumber[GraphData[{"Crown",6}],"EmbeddingScheme"->1,TimeConstraint->3600])//AbsoluteTiming

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

(cn=CrossingNumber[GraphData[{"Crown",6}],"EmbeddingScheme"->1,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 2

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

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

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

(cn=CrossingNumber[GraphData[{"Crown",6}],"EmbeddingScheme"->2,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",6}],"EmbeddingScheme"->2,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",6}],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

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

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

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

(cn=CrossingNumber[GraphData[{"Crown",6}],"EmbeddingScheme"->3,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",6}],"EmbeddingScheme"->3,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",6}],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData[{"Crown",6},"CN"]

(gs=GraphData[{"Crown",6},"Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"Crown",6},"RCN"]

GraphData[{"Crown",6},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalCrossing construction Tutte

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

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

MinimalCrossing construction Random 1k [7027 s]

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"Crown",6}],
1000,
"CrossingNumber"->12,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph"]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph"]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 5k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"Crown",6}],
51000,
"CrossingNumber"->14,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph"]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph"]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 20k [XXX s]

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

Length[diagrams=DistinctMinimalCrossingDiagramData[
GraphData[{"Crown",6}],
20*^3,
"CrossingNumber"->14,
EdgeShapeFunction->"BezierEdge"
]]//AbsoluteTiming

No crossing points on the boundary:

Length[diagrams0=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==0&],"Graph"]]//Timing

One crossing point on the boundary:

Length[diagrams1=Lookup[Select[diagrams,MinimalCrossingOuterCrossingCount[#]==1&],"Graph"]]//Timing

graphs=#["Graph"]&/@diagrams;

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[#]
}&/@graphs;//AbsoluteTiming

MaxMemoryUsed[]/10^9.GB

Symmetric embeddings:

Length[SymmetricMinimalEmbeddingData=DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]
]//AbsoluteTiming

SymmetricMinimalEmbeddingData

SymmetricMinimalEmbeddingGraphs=SymmetricMinimalEmbeddingData[[All,1]]

GraphCrossingCount/@SymmetricMinimalEmbeddingGraphs

GraphCrossingDiagram/@SymmetricMinimalEmbeddingGraphs

MinimalCrossing construction Random 1k [old]

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

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"Crown",6}],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",6},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",6},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k [old]

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

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"Crown",6}],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",6},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",6},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData[{"Crown",6},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Crown",6},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData[{"Crown",6},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Crown",6},"Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Crown",6}],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Crown",6}],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

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

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

Line graph

GraphData[{"Crown",6},"Line"]

LineGraphQ[GraphData[{"Crown",6}]]//Timing

RootGraph

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

RootGraph[GraphData[{"Crown",6}]]

Halin

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

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

Rigid

GraphData[{"Crown",6},"Rigid"]

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

Flexible

GraphData[{"Crown",6},"Flexible"]

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

LCF

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

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

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

GraphData[{"Crown",6},"LCFNotations"]

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

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

LCF compute all

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

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

lcf

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[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

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

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

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

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

Matchstick

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

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

3D default

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

3D All

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

3D UnitDistance

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

3D Polyhedron

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

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

{"Crown", 7}

Names

GraphData[{"Crown",7},"StandardName"]

GraphData[{"Crown",7},"StandardNames"]

HouseOfGraphs

hogid=GraphData[{"Crown",7},"NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData[{"Crown",7},"WikidataID"]

GraphData[{"Crown",7},"WikidataID","URL"]

Primary

GraphData[{"Crown",7}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"Crown",7},"Graph","All"]//StyleGraphs

CurvedEdge

GraphData[{"Crown",7},"Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

GraphData[{"Crown",7},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Crown",7},"Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData[{"Crown",7}]]

Default embedding

g0=GraphPlot[Graph[GraphData[{"Crown",7},"VertexList"],GraphData[{"Crown",7},"Edges"]]]

GeneralizedPetersen

GraphData[{"Crown",7},"Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData[{"Crown",7},"Graph","IGraph"]//StyleGraphs

CompleteKPartite

GraphData[{"Crown",7},"Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData[{"Crown",7},"Bipartite"]

GraphData[{"Crown",7},"Graph","Bipartite"]//StyleGraphs

Bipartite construction

GraphData[{"Crown",7},"Bipartite"]

g=BipartiteGraph[GraphData[{"Crown",7}]]

RecognizeGraph@g

Bilateral

GraphData[{"Crown",7},"Graph","Bilateral"]//StyleGraphs

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingTypes[#],GraphSymmetryGroup[#]}&/@GraphData[{"Crown",7},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]//Quiet

Circular

GraphData[{"Crown",7},"Graph","Circular"]//StyleGraphs

Circular construction 1*^4 [ s]

Length[hc=FindHamiltonianCycle[GraphData[{"Crown",7}],1*^4][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData[{"Crown",7}],hc,ProgressReporting->True]]//Timing

GroupBy[SymmetricHamiltonianCycleGraph[GraphData[{"Crown",7}],#]&/@hcsym,GraphSymmetryGroup]

Circular construction 1*^5 [ s]

Length[hc=FindHamiltonianCycle[GraphData[{"Crown",7}],1*^5][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData[{"Crown",7}],hc,ProgressReporting->True]]//Timing

GroupBy[SymmetricHamiltonianCycleGraph[GraphData[{"Crown",7}],#]&/@hcsym,GraphSymmetryGroup]

Circular construction All

GraphData[{"Crown",7},"Hamiltonian"]

GraphData[{"Crown",7},"LCF"]

GraphData[{"Crown",7},"HamiltonianCycleCount"]

GraphData[{"Crown",7},"HamiltonianCycles"]

Length[hc=FindHamiltonianCycle[GraphData[{"Crown",7}],All][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData[{"Crown",7}],hc,ProgressReporting->True]]//Timing

GroupBy[SymmetricHamiltonianCycleGraph[GraphData[{"Crown",7}],#]&/@hcsym,GraphSymmetryGroup]

Planar

GraphData[{"Crown",7},"Planar"]

GraphData[{"Crown",7},"Graph","Planar"]//StyleGraphs

Planar construction

PlanarGraphEmbedding[GraphData[{"Crown",7}],GraphLayout->#]&/@{"TutteLayout","DavidsonHarelLayout"}

Table[PlanarGraphEmbedding[GraphData[{"Crown",7}]],10]

PlanarGraphEmbeddings

GraphData[{"Crown",7},"PlanarEmbeddingCount"]

(plemb=PlanarGraphEmbeddings[GraphData[{"Crown",7}],Debug->True])//Timing

Length[plemb]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"Crown",7}]]

Tally[ReverseSort[Length/@faces]]

gs=IGLayoutTutte[GraphData[{"Crown",7}],"OuterFace"->#]&/@faces

TextGrid[DeleteCases[{#,GraphSymmetryGroup[#]}&/@gs,{_,TransformationGroup[{}]}],Dividers->All]

Grid[DeleteCases[{#,Cases[GraphSymmetryGroup[#],r_Rotation:>r,∞]}&/@gs,{_,{}}],Dividers->All]

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

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

TutteLayoutManipulate[g_Graph]:=Manipulate[
With[{face=OuterFace[g]},
IGLayoutTutte[IGEdgeMap[(EuclideanDistance@@#)^pow&,EdgeWeight->IGEdgeVertexProp[VertexCoordinates],IGLayoutTutte[g,"OuterFace"->face]],"OuterFace"->face,ImageSize->Automatic]],{{pow,1},.1,2}]

TutteLayoutManipulate[]

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

RecognizeGraph[g]

MinimalCrossingNumber crossings.uos.de

CrossingNumber[GraphData[{"Crown",7}],Method->"WebCompute"]//AbsoluteTiming

DateString[]

MinimalCrossingNumber: "EmbeddingScheme" -> 1

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->1,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->1,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->1,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->1,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->1,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->1,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 2

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->2,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->2,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->2,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->2,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->2,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->3,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->3,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->3,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->3,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->3,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",7}],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData[{"Crown",7},"CN"]

(gs=GraphData[{"Crown",7},"Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"Crown",7},"RCN"]

GraphData[{"Crown",7},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalRectilinearCrossing construction order X [minimum RCN == ]

Length[gs=FindMinimalRectilinearCrossingGraph[GraphData[{"Crown",7}],Automatic,All,"Size"->Automatic,Method->"SubgraphIsomorphism",Debug->True]]//Timing

MaxMemoryUsed[]/10^9. GB

Tally[RectilinearCrossingCount/@gs]//Timing

Tally[RectilinearLocalCrossingCount/@gs]//Timing

GraphSymmetryGroup/@gs//Tally

Select[gs,GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]

Take[gs,UpTo[100]]

MinimalRectilinearCrossing construction order X [minimum RCN == ]

Length[gs=FindMinimalRectilinearCrossingGraph[GraphData[{"Crown",7}],Automatic,All,"Size"->XXX,Method->"SubgraphIsomorphism",Debug->True]]//Timing

MaxMemoryUsed[]/10^9. GB

Tally[RectilinearCrossingCount/@gs]//Timing

Tally[RectilinearLocalCrossingCount/@gs]//Timing

GraphSymmetryGroup/@gs//Tally

Select[gs,GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]

Take[gs,UpTo[100]]

MinimalCrossing construction Tutte

(cn=CrossingNumber[GraphData[{"Crown",7}],TimeConstraint->1])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"Crown",7}],"CrossingNumber"->cn])//PolyhedralGraphQ//AbsoluteTiming

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

TutteGraphs=BilateralGraph[CenterGraph@IGLayoutTutte[g,"OuterFace"->#],"ReturnNonbilateralGraph"->True]&/@faces

TutteGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",7},"V"]])]
}&/@TutteGraphs;

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

LocalCrossingNumberWithEmbeddings=
{1+Max[Length/@DeleteCases[
Drop[AdjacencyList[#],GraphData[{"Crown",7},"V"]],
_Integer?(LessEqualThan[GraphData[{"Crown",7},"V"]]),
{2}
]],#}&/@TutteGraphs

TutteGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",7},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@TutteGraphs;

SymmetricEmbeddingsWithOrientations=DeleteCases[
TutteGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]

Select[SymmetricEmbeddingsWithOrientations[[All,1]],Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",7},"V"]])]==0&]

MinimalCrossing construction Random 1k

(cn=CrossingNumber[GraphData[{"Crown",7}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"Crown",7}],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",7},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",7},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k

(cn=CrossingNumber[GraphData[{"Crown",7}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"Crown",7}],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",7},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",7},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData[{"Crown",7},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Crown",7},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData[{"Crown",7},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Crown",7},"Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Crown",7}],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Crown",7}],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

GraphData[{"Crown",7},"Circulant"]

GraphData[{"Crown",7},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"Crown",7},"NotationRules","Circulant"]

(ci=CirculantIndices[GraphData[{"Crown",7}]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData[{"Crown",7},"StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

compl=GraphData[{"Crown",7},"ComplementGraph","Name"]

GraphData[compl,"Graph","All"]

gs=GraphComplement/@%

Select[%,!DegenerateGraphEmbeddingQ[#]&]

Line graph

GraphData[{"Crown",7},"Line"]

LineGraphQ[GraphData[{"Crown",7}]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]==={"Crown",7}&]

RootGraph[GraphData[{"Crown",7}]]

RecognizeGraph[%]

GraphData[roots[[1]],"Graph","All"]

gs=LineGraph/@%

Halin

GraphData[{"Crown",7},"Halin"]

GraphData[{"Crown",7},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Crown",7},"Rigid"]

GraphData[{"Crown",7},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Crown",7},"Flexible"]

GraphData[{"Crown",7},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Crown",7},"LCF"]

GraphData[{"Crown",7},"HamiltonianCycleCount"]

GraphData[{"Crown",7},"LCFSignature"]

GraphData[{"Crown",7},"LCFNotations"]

GraphData[{"Crown",7},"Graph","LCF"]//StyleGraphs

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

LCF compute random

FindRandomLCFNotation[GraphData[{"Crown",7}],TimeConstraint->120]

LCF compute 10^5 [XX GB]

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

gs

BilateralGraphEmbeddingQ/@gs

LCF compute 10^6 [XX GB]

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

gs

BilateralGraphEmbeddingQ/@gs

LCF compute ssham_lcf

l1={
{{"Crown",7},{0,sig}}
};

PropertyReplace[l1,"LCFSignature"]

RenameGraphFiles[]

ReverseSort@Tally[(lcf=Import[FileNameJoin[{$GraphDataDirectory,"Properties","LCFNotations-Nice",GraphNameToFileName[{"Crown",7},".m.gz"]}]])[[All,2]]]

gs=NiceLCFGraphs[lcf,3,2]

Length[gs]

nicelcf=LCFNotation/@gs

l2={
{{"Crown",7},{0,Missing["External",nicelcf]}}
}

PropertyReplace[l2,"LCFNotations"]

RenameGraphFiles[]

Length[BilateralOrder1LCF=Get[FileNameJoin[{"/","Volumes","eww","mma","Graphs","Properties","LCFNotations-Nice",GraphNameToFileName[{"Crown",7},"_bilateral-order-1-reserve.log"]}]]]

BilateralLCFGraph@@@BilateralOrder1LCF//Length//Timing

BilateralLCFGraph@@@Take[BilateralOrder1LCF,10]

Length[bilat=SelectBilateralLCFs[BilateralOrder1LCF,"ProgressEvery"->500,Debug->True]]//Timing

LCF compute all

Divisors[GraphData[{"Crown",7},"V"]]

Length[FindHamiltonianCycle[GraphData[{"Crown",7}],All][[All,All,1]]]//Timing

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

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs=nicelcfgs]

gs

NiceLCFEmbeddingsWithSymmetryGroups={#,GraphSymmetryGroup[#]}&/@gs;

DeleteCases[NiceLCFEmbeddingsWithSymmetryGroups,{_,TransformationGroup[{Reflection[InfiniteLine[{0,0},{0,-1}]]}]}]

UnitDistance

GraphData[{"Crown",7},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Crown",7}],Debug->True]//Timing

GraphData[{"Crown",7},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement of default embeddings

Graph[edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"Crown",7},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"Crown",7},"VertexList"],GraphData[{"Crown",7},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData[{"Crown",7},"Graph",#]&/@{"All","UnitDistance"})

TextGrid[
gdata=SortBy[
{#,DegenerateGraphEmbeddingQ[#],GraphSymmetryGroup[#],Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
],
Dividers->All
]

Cases[gdata,{__,0.}]

Symmetric:

gs=Cases[
gdata,
{g_,_,sym:Except[TransformationGroup[{}]],diff_}:>{
HighlightGraph[g1=BilateralGraph[CenterGraph[g],"ReturnNonbilateralGraph"->True],Flatten[FindCoincidentVertices[g1]]],
sym,
diff
}]

UnitDistance by refinement of stored LCF embeddings

FileByteCount[file=FileNameJoin[{$PropertiesDir,"LCFNotations-Nice",GraphNameToFileName[{"Crown",7},".m.gz"]}]]

Tally[(lcf=Import[file])[[All,-1]]]//Timing//AbsoluteTiming

lcf=LCFNotation/@nicelcfgs;

gs=UnitDistanceEmbeddingRefine[LCFGraph@@#,MaxIterations->500]&/@lcf;//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

NondegenerateSymmetricGraphs=Select[
gdata,
And[
DegenerateGraphEmbeddingQ[#[[1]]]===False,
GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]
]&
]/.g_Graph:>CenterGraph[g]

UnitDistance by FindUnitDistanceEmbedding  (random embeddings returning on messages)

gs=FindUnitDistanceEmbedding[GraphData[{"Crown",7}],50,"ReturnWithMessage"->True];//Quiet//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

SymmetricEmebddings=Select[gdata,GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]&]

UnitDistance by FindUnitDistanceEmbedding  (random embedding waiting until UD is found)

FindUnitDistanceEmbedding[GraphData[{"Crown",7}],"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{$Version,DateString[]}

{{"Crown",7},l=FindSubgraphUnitDistanceEmbedding[GraphData[{"Crown",7}],TimeConstraint->300,"Results"->All]//Timing}

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

Select[IndexGraph/@gs,!DegenerateGraphEmbeddingQ[#]&&GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]//Timing

Matchstick

GraphData[{"Crown",7},"Matchstick"]

GraphData[{"Crown",7},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Crown",7},"Edges"]]

3D construction

3D All

GraphData[{"Crown",7},"Graph",{"3D","All"}]

3D UnitDistance construction Random

GraphData[{"Crown",7},"Dimension"]

(g=UnitDistanceEmbeddingRefine[
Graph3D[
GraphData[{"Crown",7},"VertexList"],
GraphData[{"Crown",7},"EdgeList"]
],
WorkingPrecision->25])//Timing

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

GraphData[{"Crown",7},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Crown",7},"Polyhedral"]

GraphData[{"Crown",7},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"Crown",7},"Polyhedron"]}]

3D Canonical

GraphData[{"Crown",7},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"Crown",7},"Polyhedron","Canonical"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"Crown",7}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->50,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->1000,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"Crown",7},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"Crown", 8}

Names

GraphData[{"Crown",8},"StandardName"]

GraphData[{"Crown",8},"StandardNames"]

HouseOfGraphs

hogid=GraphData[{"Crown",8},"NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData[{"Crown",8},"WikidataID"]

GraphData[{"Crown",8},"WikidataID","URL"]

Primary

GraphData[{"Crown",8}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"Crown",8},"Graph","All"]//StyleGraphs

CurvedEdge

GraphData[{"Crown",8},"Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

GraphData[{"Crown",8},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Crown",8},"Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData[{"Crown",8}]]

Default embedding

g0=GraphPlot[Graph[GraphData[{"Crown",8},"VertexList"],GraphData[{"Crown",8},"Edges"]]]

GeneralizedPetersen

GraphData[{"Crown",8},"Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData[{"Crown",8},"Graph","IGraph"]//StyleGraphs

CompleteKPartite

GraphData[{"Crown",8},"Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData[{"Crown",8},"Bipartite"]

GraphData[{"Crown",8},"Graph","Bipartite"]//StyleGraphs

Bipartite construction

GraphData[{"Crown",8},"Bipartite"]

g=BipartiteGraph[GraphData[{"Crown",8}]]

RecognizeGraph@g

Bilateral

GraphData[{"Crown",8},"Graph","Bilateral"]//StyleGraphs

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingTypes[#],GraphSymmetryGroup[#]}&/@GraphData[{"Crown",8},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]//Quiet

Circular

GraphData[{"Crown",8},"Graph","Circular"]//StyleGraphs

Circular construction 1*^4 [ s]

Length[hc=FindHamiltonianCycle[GraphData[{"Crown",8}],1*^4][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData[{"Crown",8}],hc,ProgressReporting->True]]//Timing

GroupBy[SymmetricHamiltonianCycleGraph[GraphData[{"Crown",8}],#]&/@hcsym,GraphSymmetryGroup]

Circular construction 1*^5 [ s]

Length[hc=FindHamiltonianCycle[GraphData[{"Crown",8}],1*^5][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData[{"Crown",8}],hc,ProgressReporting->True]]//Timing

GroupBy[SymmetricHamiltonianCycleGraph[GraphData[{"Crown",8}],#]&/@hcsym,GraphSymmetryGroup]

Circular construction All

GraphData[{"Crown",8},"Hamiltonian"]

GraphData[{"Crown",8},"LCF"]

GraphData[{"Crown",8},"HamiltonianCycleCount"]

GraphData[{"Crown",8},"HamiltonianCycles"]

Length[hc=FindHamiltonianCycle[GraphData[{"Crown",8}],All][[All,All,1]]]//Timing

Length[hcsym=SymmetricHamiltonianCycles[GraphData[{"Crown",8}],hc,ProgressReporting->True]]//Timing

GroupBy[SymmetricHamiltonianCycleGraph[GraphData[{"Crown",8}],#]&/@hcsym,GraphSymmetryGroup]

Planar

GraphData[{"Crown",8},"Planar"]

GraphData[{"Crown",8},"Graph","Planar"]//StyleGraphs

Planar construction

PlanarGraphEmbedding[GraphData[{"Crown",8}],GraphLayout->#]&/@{"TutteLayout","DavidsonHarelLayout"}

Table[PlanarGraphEmbedding[GraphData[{"Crown",8}]],10]

PlanarGraphEmbeddings

GraphData[{"Crown",8},"PlanarEmbeddingCount"]

(plemb=PlanarGraphEmbeddings[GraphData[{"Crown",8}],Debug->True])//Timing

Length[plemb]

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData[{"Crown",8}]]

Tally[ReverseSort[Length/@faces]]

gs=IGLayoutTutte[GraphData[{"Crown",8}],"OuterFace"->#]&/@faces

TextGrid[DeleteCases[{#,GraphSymmetryGroup[#]}&/@gs,{_,TransformationGroup[{}]}],Dividers->All]

Grid[DeleteCases[{#,Cases[GraphSymmetryGroup[#],r_Rotation:>r,∞]}&/@gs,{_,{}}],Dividers->All]

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

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

TutteLayoutManipulate[g_Graph]:=Manipulate[
With[{face=OuterFace[g]},
IGLayoutTutte[IGEdgeMap[(EuclideanDistance@@#)^pow&,EdgeWeight->IGEdgeVertexProp[VertexCoordinates],IGLayoutTutte[g,"OuterFace"->face]],"OuterFace"->face,ImageSize->Automatic]],{{pow,1},.1,2}]

TutteLayoutManipulate[]

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

RecognizeGraph[g]

MinimalCrossingNumber crossings.uos.de

CrossingNumber[GraphData[{"Crown",8}],Method->"WebCompute"]//AbsoluteTiming

DateString[]

MinimalCrossingNumber: "EmbeddingScheme" -> 1

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->1,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->1,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->1,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->1,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->1,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->1,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 2

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->2,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->2,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->2,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->2,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->2,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->3,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->3,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->3,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->3,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->3,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",8}],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData[{"Crown",8},"CN"]

(gs=GraphData[{"Crown",8},"Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"Crown",8},"RCN"]

GraphData[{"Crown",8},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalRectilinearCrossing construction order X [minimum RCN == ]

Length[gs=FindMinimalRectilinearCrossingGraph[GraphData[{"Crown",8}],Automatic,All,"Size"->Automatic,Method->"SubgraphIsomorphism",Debug->True]]//Timing

MaxMemoryUsed[]/10^9. GB

Tally[RectilinearCrossingCount/@gs]//Timing

Tally[RectilinearLocalCrossingCount/@gs]//Timing

GraphSymmetryGroup/@gs//Tally

Select[gs,GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]

Take[gs,UpTo[100]]

MinimalRectilinearCrossing construction order X [minimum RCN == ]

Length[gs=FindMinimalRectilinearCrossingGraph[GraphData[{"Crown",8}],Automatic,All,"Size"->XXX,Method->"SubgraphIsomorphism",Debug->True]]//Timing

MaxMemoryUsed[]/10^9. GB

Tally[RectilinearCrossingCount/@gs]//Timing

Tally[RectilinearLocalCrossingCount/@gs]//Timing

GraphSymmetryGroup/@gs//Tally

Select[gs,GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]

Take[gs,UpTo[100]]

MinimalCrossing construction Tutte

(cn=CrossingNumber[GraphData[{"Crown",8}],TimeConstraint->1])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"Crown",8}],"CrossingNumber"->cn])//PolyhedralGraphQ//AbsoluteTiming

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

TutteGraphs=BilateralGraph[CenterGraph@IGLayoutTutte[g,"OuterFace"->#],"ReturnNonbilateralGraph"->True]&/@faces

TutteGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",8},"V"]])]
}&/@TutteGraphs;

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

LocalCrossingNumberWithEmbeddings=
{1+Max[Length/@DeleteCases[
Drop[AdjacencyList[#],GraphData[{"Crown",8},"V"]],
_Integer?(LessEqualThan[GraphData[{"Crown",8},"V"]]),
{2}
]],#}&/@TutteGraphs

TutteGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",8},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@TutteGraphs;

SymmetricEmbeddingsWithOrientations=DeleteCases[
TutteGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]

Select[SymmetricEmbeddingsWithOrientations[[All,1]],Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",8},"V"]])]==0&]

MinimalCrossing construction Random 1k

(cn=CrossingNumber[GraphData[{"Crown",8}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"Crown",8}],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",8},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",8},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k

(cn=CrossingNumber[GraphData[{"Crown",8}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"Crown",8}],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",8},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",8},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData[{"Crown",8},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Crown",8},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData[{"Crown",8},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Crown",8},"Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Crown",8}],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Crown",8}],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

GraphData[{"Crown",8},"Circulant"]

GraphData[{"Crown",8},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"Crown",8},"NotationRules","Circulant"]

(ci=CirculantIndices[GraphData[{"Crown",8}]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData[{"Crown",8},"StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

compl=GraphData[{"Crown",8},"ComplementGraph","Name"]

GraphData[compl,"Graph","All"]

gs=GraphComplement/@%

Select[%,!DegenerateGraphEmbeddingQ[#]&]

Line graph

GraphData[{"Crown",8},"Line"]

LineGraphQ[GraphData[{"Crown",8}]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]==={"Crown",8}&]

RootGraph[GraphData[{"Crown",8}]]

RecognizeGraph[%]

GraphData[roots[[1]],"Graph","All"]

gs=LineGraph/@%

Halin

GraphData[{"Crown",8},"Halin"]

GraphData[{"Crown",8},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Crown",8},"Rigid"]

GraphData[{"Crown",8},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Crown",8},"Flexible"]

GraphData[{"Crown",8},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Crown",8},"LCF"]

GraphData[{"Crown",8},"HamiltonianCycleCount"]

GraphData[{"Crown",8},"LCFSignature"]

GraphData[{"Crown",8},"LCFNotations"]

GraphData[{"Crown",8},"Graph","LCF"]//StyleGraphs

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

LCF compute random

FindRandomLCFNotation[GraphData[{"Crown",8}],TimeConstraint->120]

LCF compute 10^5 [XX GB]

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

gs

BilateralGraphEmbeddingQ/@gs

LCF compute 10^6 [XX GB]

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

gs

BilateralGraphEmbeddingQ/@gs

LCF compute ssham_lcf

l1={
{{"Crown",8},{0,sig}}
};

PropertyReplace[l1,"LCFSignature"]

RenameGraphFiles[]

ReverseSort@Tally[(lcf=Import[FileNameJoin[{$GraphDataDirectory,"Properties","LCFNotations-Nice",GraphNameToFileName[{"Crown",8},".m.gz"]}]])[[All,2]]]

gs=NiceLCFGraphs[lcf,3,2]

Length[gs]

nicelcf=LCFNotation/@gs

l2={
{{"Crown",8},{0,Missing["External",nicelcf]}}
}

PropertyReplace[l2,"LCFNotations"]

RenameGraphFiles[]

Length[BilateralOrder1LCF=Get[FileNameJoin[{"/","Volumes","eww","mma","Graphs","Properties","LCFNotations-Nice",GraphNameToFileName[{"Crown",8},"_bilateral-order-1-reserve.log"]}]]]

BilateralLCFGraph@@@BilateralOrder1LCF//Length//Timing

BilateralLCFGraph@@@Take[BilateralOrder1LCF,10]

Length[bilat=SelectBilateralLCFs[BilateralOrder1LCF,"ProgressEvery"->500,Debug->True]]//Timing

LCF compute all

Divisors[GraphData[{"Crown",8},"V"]]

Length[FindHamiltonianCycle[GraphData[{"Crown",8}],All][[All,All,1]]]//Timing

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

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

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

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

Length[gs=nicelcfgs]

gs

NiceLCFEmbeddingsWithSymmetryGroups={#,GraphSymmetryGroup[#]}&/@gs;

DeleteCases[NiceLCFEmbeddingsWithSymmetryGroups,{_,TransformationGroup[{Reflection[InfiniteLine[{0,0},{0,-1}]]}]}]

UnitDistance

GraphData[{"Crown",8},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Crown",8}],Debug->True]//Timing

GraphData[{"Crown",8},"Graph","UnitDistance"]//StyleGraphs

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

UnitDistance by refinement of default embeddings

Graph[edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"Crown",8},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"Crown",8},"VertexList"],GraphData[{"Crown",8},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData[{"Crown",8},"Graph",#]&/@{"All","UnitDistance"})

TextGrid[
gdata=SortBy[
{#,DegenerateGraphEmbeddingQ[#],GraphSymmetryGroup[#],Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
],
Dividers->All
]

Cases[gdata,{__,0.}]

Symmetric:

gs=Cases[
gdata,
{g_,_,sym:Except[TransformationGroup[{}]],diff_}:>{
HighlightGraph[g1=BilateralGraph[CenterGraph[g],"ReturnNonbilateralGraph"->True],Flatten[FindCoincidentVertices[g1]]],
sym,
diff
}]

UnitDistance by refinement of stored LCF embeddings

FileByteCount[file=FileNameJoin[{$PropertiesDir,"LCFNotations-Nice",GraphNameToFileName[{"Crown",8},".m.gz"]}]]

Tally[(lcf=Import[file])[[All,-1]]]//Timing//AbsoluteTiming

lcf=LCFNotation/@nicelcfgs;

gs=UnitDistanceEmbeddingRefine[LCFGraph@@#,MaxIterations->500]&/@lcf;//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

NondegenerateSymmetricGraphs=Select[
gdata,
And[
DegenerateGraphEmbeddingQ[#[[1]]]===False,
GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]
]&
]/.g_Graph:>CenterGraph[g]

UnitDistance by FindUnitDistanceEmbedding  (random embeddings returning on messages)

gs=FindUnitDistanceEmbedding[GraphData[{"Crown",8}],50,"ReturnWithMessage"->True];//Quiet//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

SymmetricEmebddings=Select[gdata,GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]&]

UnitDistance by FindUnitDistanceEmbedding  (random embedding waiting until UD is found)

FindUnitDistanceEmbedding[GraphData[{"Crown",8}],"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance by FindSubgraphUnitDistanceEmbedding

{$Version,DateString[]}

{{"Crown",8},l=FindSubgraphUnitDistanceEmbedding[GraphData[{"Crown",8}],TimeConstraint->300,"Results"->All]//Timing}

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

Select[IndexGraph/@gs,!DegenerateGraphEmbeddingQ[#]&&GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]//Timing

Matchstick

GraphData[{"Crown",8},"Matchstick"]

GraphData[{"Crown",8},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Crown",8},"Edges"]]

3D construction

3D All

GraphData[{"Crown",8},"Graph",{"3D","All"}]

3D UnitDistance construction Random

GraphData[{"Crown",8},"Dimension"]

(g=UnitDistanceEmbeddingRefine[
Graph3D[
GraphData[{"Crown",8},"VertexList"],
GraphData[{"Crown",8},"EdgeList"]
],
WorkingPrecision->25])//Timing

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

GraphData[{"Crown",8},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Crown",8},"Polyhedral"]

GraphData[{"Crown",8},"Graph",{"3D","Polyhedron"}]

Graphics3D[{FaceForm[Green,Red],GraphData[{"Crown",8},"Polyhedron"]}]

3D Canonical

GraphData[{"Crown",8},"Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData[{"Crown",8},"Polyhedron","Canonical"],Yellow,Sphere[]}]

3D Canonical construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData[{"Crown",8}],1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->50,MaxIterations->50000,PrecisionGoal->20,"ProgressInterval"->1000,"TangentFactor"->1/10,"PlanarFactor"->1/10,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

3D Canonical construction from PolyhedralEmbedding

g=GraphData[{"Crown",8},"Graph","Planar"][[1]]

Show[g2=PolyhedralEmbedding[g,"Circular"->True,"Scale"->3],Boxed->True]//Quiet

With[
{faces=PlanarFaceList[Graph[EdgeList[g2]]],v=GraphEmbedding@g2},
Graphics3D[{Point[{0,0,0}],Opacity[.5],Sphere[],FaceForm[Green,Red],
poly=Polyhedron[1.2v,faces]}]]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->100,MaxIterations->20000,PrecisionGoal->20,"ProgressInterval"->100,"TangentFactor"->1/5,"PlanarFactor"->1/5,Debug->True])//Timing

SimplePolyhedronQ[can]

If[%===False,Quit[]]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

{"Crown", 9}

Names

GraphData[{"Crown",9},"StandardName"]

GraphData[{"Crown",9},"StandardNames"]

HouseOfGraphs

hogid=GraphData[{"Crown",9},"NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData[{"Crown",9},"WikidataID"]

GraphData[{"Crown",9},"WikidataID","URL"]

Primary

GraphData[{"Crown",9}]//StyleGraphs[#,ImageSize->Small]&

All

GraphData[{"Crown",9},"Graph","All"]//StyleGraphs

CurvedEdge

GraphData[{"Crown",9},"Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Degenerate

GraphData[{"Crown",9},"Graph","Degenerate"]//StyleGraphs

DegenerateGraphEmbeddingTypes/@GraphData[{"Crown",9},"Graph","Degenerate"]//Column

Embeddings

GraphDataEmbeddings[GraphData[{"Crown",9}]]

Default embedding

g0=GraphPlot[Graph[GraphData[{"Crown",9},"VertexList"],GraphData[{"Crown",9},"Edges"]]]

GeneralizedPetersen

GraphData[{"Crown",9},"Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData[{"Crown",9},"Graph","IGraph"]//StyleGraphs

CompleteKPartite

GraphData[{"Crown",9},"Graph","CompleteKPartite"]//StyleGraphs

Bipartite

GraphData[{"Crown",9},"Bipartite"]

GraphData[{"Crown",9},"Graph","Bipartite"]//StyleGraphs

Bipartite construction

GraphData[{"Crown",9},"Bipartite"]

g=BipartiteGraph[GraphData[{"Crown",9}]]

RecognizeGraph@g

Bilateral

GraphData[{"Crown",9},"Graph","Bilateral"]//StyleGraphs

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingTypes[#],GraphSymmetryGroup[#]}&/@GraphData[{"Crown",9},"Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]//Quiet

Circular

GraphData[{"Crown",9},"Graph","Circular"]//StyleGraphs

Circular construction All

GraphData[{"Crown",9},"Hamiltonian"]

GraphData[{"Crown",9},"LCF"]

GraphData[{"Crown",9},"HamiltonianCycleCount"]

GraphData[{"Crown",9},"HamiltonianCycles"]

Planar

GraphData[{"Crown",9},"Planar"]

GraphData[{"Crown",9},"Graph","Planar"]//StyleGraphs

MinimalCrossingNumber crossings.uos.de

CrossingNumber[GraphData[{"Crown",9}],Method->"WebCompute"]//AbsoluteTiming

DateString[]

MinimalCrossingNumber: "EmbeddingScheme" -> 1

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->1,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->1,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->1,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->1,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->1,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->1,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 2

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->2,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->2,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->2,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->2,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->2,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->3,TimeConstraint->1])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->3,TimeConstraint->10])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->3,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->3,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->3,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData[{"Crown",9}],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData[{"Crown",9},"CN"]

(gs=GraphData[{"Crown",9},"Graph","MinimalCrossing"])//StyleGraphs

GraphCrossingCount/@gs

GraphCrossingDiagram/@gs

MinimalRectilinearCrossing

GraphData[{"Crown",9},"RCN"]

GraphData[{"Crown",9},"Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalRectilinearCrossing construction order X [minimum RCN == ]

Length[gs=FindMinimalRectilinearCrossingGraph[GraphData[{"Crown",9}],Automatic,All,"Size"->Automatic,Method->"SubgraphIsomorphism",Debug->True]]//Timing

MaxMemoryUsed[]/10^9. GB

Tally[RectilinearCrossingCount/@gs]//Timing

Tally[RectilinearLocalCrossingCount/@gs]//Timing

GraphSymmetryGroup/@gs//Tally

Select[gs,GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]

Take[gs,UpTo[100]]

MinimalRectilinearCrossing construction order X [minimum RCN == ]

Length[gs=FindMinimalRectilinearCrossingGraph[GraphData[{"Crown",9}],Automatic,All,"Size"->XXX,Method->"SubgraphIsomorphism",Debug->True]]//Timing

MaxMemoryUsed[]/10^9. GB

Tally[RectilinearCrossingCount/@gs]//Timing

Tally[RectilinearLocalCrossingCount/@gs]//Timing

GraphSymmetryGroup/@gs//Tally

Select[gs,GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]

Take[gs,UpTo[100]]

MinimalCrossing construction Tutte

(cn=CrossingNumber[GraphData[{"Crown",9}],TimeConstraint->1])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData[{"Crown",9}],"CrossingNumber"->cn])//PolyhedralGraphQ//AbsoluteTiming

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

TutteGraphs=BilateralGraph[CenterGraph@IGLayoutTutte[g,"OuterFace"->#],"ReturnNonbilateralGraph"->True]&/@faces

TutteGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",9},"V"]])]
}&/@TutteGraphs;

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[TutteGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

LocalCrossingNumberWithEmbeddings=
{1+Max[Length/@DeleteCases[
Drop[AdjacencyList[#],GraphData[{"Crown",9},"V"]],
_Integer?(LessEqualThan[GraphData[{"Crown",9},"V"]]),
{2}
]],#}&/@TutteGraphs

TutteGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",9},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@TutteGraphs;

SymmetricEmbeddingsWithOrientations=DeleteCases[
TutteGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]

Select[SymmetricEmbeddingsWithOrientations[[All,1]],Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",9},"V"]])]==0&]

MinimalCrossing construction Random 1k

(cn=CrossingNumber[GraphData[{"Crown",9}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"Crown",9}],"CrossingNumber"->cn,RandomSeed->n],{n,1000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",9},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",9},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalCrossing construction Random 20k

(cn=CrossingNumber[GraphData[{"Crown",9}],TimeConstraint->1])//AbsoluteTiming

(RandomGraphs=Table[MinimalCrossingGraph[GraphData[{"Crown",9}],"CrossingNumber"->cn,RandomSeed->n],{n,20000}]//Union);//Timing

RandomGraphsWithOuterCrossingPointCounts={
#,
Count[OuterFace[#],_?(GreaterThan[GraphData[{"Crown",9},"V"]])]
}&/@RandomGraphs;

Small numbers of crossing points on the boundary:

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,0}:>g]

Cases[RandomGraphsWithOuterCrossingPointCounts,{g_,1}:>g]

Symmetric embeddings:

RandomGraphsWithSymmetryGroups={
#,
GraphSymmetryGroup[
#,
AdditionalData->Join[Table[True,GraphData[{"Crown",9},"V"]],Table[False,cn]],
SameTest->Equal
]
}&/@RandomGraphs;

MaxMemoryUsed[]/10^9.GB

DeleteCases[
RandomGraphsWithSymmetryGroups,
{_,TransformationGroup[{}]}
]/.g_Graph:>BilateralGraph[CenterGraph@g,"ReturnNonbilateralGraph"->True]

MinimalLocalCrossing

GraphData[{"Crown",9},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Crown",9},"Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData[{"Crown",9},{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData[{"Crown",9},"Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction 1000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Crown",9}],"CrossingNumber"->cn,RandomSeed->i],{i,1000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

MinimaRectilinearlLocalCrossing construction 20000

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData[{"Crown",9}],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Circulant

GraphData[{"Crown",9},"Circulant"]

GraphData[{"Crown",9},"Graph","Circulant"]//StyleGraphs

Circulant construction

GraphData[{"Crown",9},"NotationRules","Circulant"]

(ci=CirculantIndices[GraphData[{"Crown",9}]])//AbsoluteTiming

CirculantGraph1@@@ci

Cases[GraphData[{"Crown",9},"StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

compl=GraphData[{"Crown",9},"ComplementGraph","Name"]

GraphData[compl,"Graph","All"]

gs=GraphComplement/@%

Select[%,!DegenerateGraphEmbeddingQ[#]&]

Line graph

GraphData[{"Crown",9},"Line"]

LineGraphQ[GraphData[{"Crown",9}]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]==={"Crown",9}&]

RootGraph[GraphData[{"Crown",9}]]

Halin

GraphData[{"Crown",9},"Halin"]

GraphData[{"Crown",9},"Graph","Halin"]//StyleGraphs

Rigid

GraphData[{"Crown",9},"Rigid"]

GraphData[{"Crown",9},"Graph","Rigid"]//StyleGraphs

Flexible

GraphData[{"Crown",9},"Flexible"]

GraphData[{"Crown",9},"Graph","Flexible"]//StyleGraphs

LCF

GraphData[{"Crown",9},"LCF"]

GraphData[{"Crown",9},"HamiltonianCycleCount"]

GraphData[{"Crown",9},"LCFSignature"]

GraphData[{"Crown",9},"LCFNotations"]

GraphData[{"Crown",9},"Graph","LCF"]//StyleGraphs

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

LCF compute ssham_lcf

ReverseSort@Tally[(lcf=Import[FileNameJoin[{$GraphDataDirectory,"Properties","LCFNotations-Nice",GraphNameToFileName[{"Crown",9},".m.gz"]}]])[[All,2]]]

Length[NiceLCFGraphs[lcf,3,2]]

gs=NiceLCFGraphs[lcf,3]

Length[gs]

nicelcf=LCFNotation/@gs

Length[BilateralOrder1LCF=Get[FileNameJoin[{"/","Volumes","eww","mma","Graphs","Properties","LCFNotations-Nice",GraphNameToFileName[{"Crown",9},"_bilateral-order-1-reserve.log"]}]]]

BilateralLCFGraph@@@BilateralOrder1LCF//Length//Timing

BilateralLCFGraph@@@Take[BilateralOrder1LCF,10]

Length[bilat=SelectBilateralLCFs[BilateralOrder1LCF,"ProgressEvery"->500,Debug->True]]//Timing

UnitDistance

GraphData[{"Crown",9},"UnitDistance"]

UnitDistanceGraphQ[GraphData[{"Crown",9}],Debug->True]//Timing

GraphData[{"Crown",9},"Graph","UnitDistance"]//StyleGraphs

UnitDistance by refinement of default embeddings

Graph[edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"Crown",9},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

Graph[vertex list, edge list]

(g=UnitDistanceEmbeddingRefine[Graph[GraphData[{"Crown",9},"VertexList"],GraphData[{"Crown",9},"EdgeList"]],MaxIterations->500])//Timing

UnitDistanceGraphEmbeddingQ[g]

UnitDistance by refinement of existing embeddings

gs=UnitDistanceEmbeddingRefine[Graph[VertexList[#],EdgeList[#],VertexCoordinates->GraphEmbedding[#]],MaxIterations->500]&/@Complement@@(GraphData[{"Crown",9},"Graph",#]&/@{"All","UnitDistance"})

TextGrid[
gdata=SortBy[
{#,DegenerateGraphEmbeddingQ[#],GraphSymmetryGroup[#],Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
],
Dividers->All
]

Cases[gdata,{__,0.}]

Symmetric:

gs=Cases[
gdata,
{g_,_,sym:Except[TransformationGroup[{}]],diff_}:>{
HighlightGraph[g1=BilateralGraph[CenterGraph[g],"ReturnNonbilateralGraph"->True],Flatten[FindCoincidentVertices[g1]]],
sym,
diff
}]

UnitDistance by refinement of stored LCF embeddings

FileByteCount[file=FileNameJoin[{$PropertiesDir,"LCFNotations-Nice",GraphNameToFileName[{"Crown",9},".m.gz"]}]]

Tally[(lcf=Import[file])[[All,-1]]]//Timing//AbsoluteTiming

lcf=LCFNotation/@nicelcfgs;

gs=UnitDistanceEmbeddingRefine[LCFGraph@@#,MaxIterations->500]&/@lcf;//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

NondegenerateSymmetricGraphs=Select[
gdata,
And[
DegenerateGraphEmbeddingQ[#[[1]]]===False,
GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]
]&
]/.g_Graph:>CenterGraph[g]

UnitDistance by FindUnitDistanceEmbedding  (random embeddings returning on messages)

gs=FindUnitDistanceEmbedding[GraphData[{"Crown",9}],50,"ReturnWithMessage"->True];//Quiet//Timing

gdata=SortBy[
{#,Max[Abs[EdgeLengths[#]-1]]}&/@gs,
Last
]

Cases[gdata,{g_?UnitDistanceGraphEmbeddingQ,_}:>g]

SymmetricEmebddings=Select[gdata,GraphSymmetryGroup[#[[1]]]=!=TransformationGroup[{}]&]

UnitDistance by FindUnitDistanceEmbedding  (random embedding waiting until UD is found)

FindUnitDistanceEmbedding[GraphData[{"Crown",9}],"ReturnWithMessage"->False]//Quiet//Timing

Matchstick

GraphData[{"Crown",9},"Matchstick"]

GraphData[{"Crown",9},"Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData[{"Crown",9},"Edges"]]

3D construction

3D All

GraphData[{"Crown",9},"Graph",{"3D","All"}]

3D UnitDistance construction Random

GraphData[{"Crown",9},"Dimension"]

(g=UnitDistanceEmbeddingRefine[
Graph3D[
GraphData[{"Crown",9},"VertexList"],
GraphData[{"Crown",9},"EdgeList"]
],
WorkingPrecision->25])//Timing

EdgeLengths[g]

UnitDistanceGraphEmbeddingQ[g]

3D UnitDistance

GraphData[{"Crown",9},"Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData[{"Crown",9},"Polyhedral"]

GraphData[{"Crown",9},"Graph",{"3D","Polyhedron"}]

Embedding types

IntegerCoordinates

Table[GraphData[{"Crown",n},"Graph","IntegerCoordinates"],{n,3,20}]

Table[CrownGraph[n,GraphLayout->"Bipartite"],{n,20}]

LCF

Table[GraphData[{"Crown",n},"Graph","LCF"][[1]],{n,3,20}]

Table[CrownGraph[n,GraphLayout->"LCF"],{n,3,20}]

Properties

Acyclic

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

AdjacencyMatrix

a[n_]:=SparseArray[{i_,j_}:>1/;(Min[i,j]≤n&&Max[i,j]>n&&Abs[j-i]!=n),2n{1,1}]

Table[AdjacencyGraph[a[n]]//RecognizeGraph,{n,10}]

AdjacencyMatrixCount

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

FullSimplify[(((2n)!)/(2n!))]

Table[(((2n)!)/(2n!)),{n,20}]

Arboricity

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

Monitor[Table[Arboricity[CrownGraph[n]],{n,3,9}],n]//Timing

Table[Ceiling[n/2],{n,20}]

ArcTransitive

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

ArcTransitivity

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

AutomorphismCount

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

FindSequenceFunction[DeleteCases[seq,_Missing],n-2]//FunctionExpand

Table[2n!,{n,20}]

BalabanIndex

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

FindSequenceFunction[seq,n-2]//FullSimplify

Bandwidth

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

BridgeCount

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

BurningNumber

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

CharacteristicPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"CharacteristicPolynomial"],{n,k0=3,kmax=20}]/.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,k0,kmax}]

FullSimplify[poly2-poly]

Chordal

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

ChordCount

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

Chordless

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

ChordlessCycleCount

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

FindSequenceFunction[DeleteCases[seq,_Missing],n-2]//FullSimplify

Chords

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

ChromaticallyUnique

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

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

ChromaticInvariant

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

FindLinearRecurrence[DeleteCases[seq,_Missing]]

FindSequenceFunction[DeleteCases[seq,_Missing],n-2]

FindSequenceFunction[Rest@DeleteCases[seq,_Missing],n-2]

(x^3)FindGeneratingFunction[DeleteCases[seq,_Missing],x]

Do[Print[{n,Abs[Derivative[1][System`ChromaticPolynomial[CrownGraph[n]]][1]]//Timing}],{n,8}]

ChromaticNumber

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

ChromaticPolynomial

GraphData[{"Crown",9},"ChromaticPolynomial"][x]

(poly=DeleteCases[Factor@Table[GraphData[{"Crown",n},"ChromaticPolynomial"][x],{n,k0=3,kmax=9}],_Missing[x]])//Column

CoefficientList[Take[poly,4],x]

CoefficientList[Take[(poly/(x(x-1))),4],x]

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

FullSimplify[poly2-poly]

Circumference

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

FindSequenceFunction[seq,n-2]

Classes

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

CliqueCount

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

FindSequenceFunction[seq,n-2]//Factor

CliqueCoveringNumber

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

FindSequenceFunction[seq,n-2]

CliqueNumber

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

CliquePolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"CliquePolynomial"],{n,k0=3,kmax=20}]/.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,k0,kmax}]

FullSimplify[poly2-poly]

CochromaticGraphNames

Table[GraphData[{"Crown",n},"CochromaticGraphNames"],{n,20}]

Select[GraphData["Crown"],GraphData[#,"ChromaticallyUnique"]=!=False&]

ComplementOddChordlessCycleCount

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

ConnectedComponentCount

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

ConnectedDominatingSetCount

A287471

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

FindLinearRecurrence[DeleteMissing[seq]]

FindSequenceFunction[DeleteCases[seq,_Missing],n-2]

FindSequenceFunction[DeleteCases[Rest@seq,_Missing],n-3]

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

Table[((((2^n)-n-1))^2)-Binomial[n,2],{n,20}]

ConnectedDominationNumber

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

ConnectedDominationPolynomial

(poly=Factor@Table[GraphData[{"Crown",n},"ConnectedDominationPolynomial"],{n,k0=3,kmax=20}]/.f_Function:>f[x])//Column

CoefficientList[Take[poly,5],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,10}]

FullSimplify[poly2-poly]

ConnectedInducedSubgraphCount

A287592

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

FindLinearRecurrence[DeleteMissing@seq]

FindSequenceFunction[DeleteCases[seq,_Missing],n-2]//FullSimplify

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

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

FindGeneratingFunction[Table[(((-1+(2^n)))^2)-(1/2) n (-7+(2^(1+n))+n),{n,0,20}],x]//Simplify

StringReplace[ToString[%,InputForm]," "->""]

StringReplace[ToString[((((2^n)-1))^2)-(1/2) n ((2^(n+1))+n-7),InputForm]," "->""]

CoefficientList[Series[((x (2-16 x+59 (x^2)-94 (x^3)+52 (x^4)))/((((1-2 x))^2) (((-1+x))^3) (-1+4 x))),{x,0,20}],x]

seq=Table[((((2^n)-1))^2)-(1/2) n ((2^(n+1))+n-7),{n,0,30}]

FindLinearRecurrence[DeleteMissing@seq]

LinearRecurrence[{11,-47,101,-116,68,-16},{2,6,31,167,806,3588},{0,20}]

ConnectedInducedSubgraphPolynomial

(poly=Table[GraphData[{"Crown",n},"ConnectedInducedSubgraphPolynomial"],{n,k0=3,kmax=20}]/.f_Function:>f[x])//Column

CoefficientList[Take[poly,5],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,10}]

FullSimplify[poly2-poly]

CrossingNumber

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

CycleCount

A234618

seq=GraphData[{"Crown",#},"CycleCount"]&/@Range[3,20]

FindLinearRecurrence[seq]

FindSequenceFunction[DeleteCases[seq,_Missing],n-2]//FullSimplify

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

Table[Sum[Binomial[n,k]((-1)^k(k-1)!+Sum[(-1)^i i!(k-i)!(k-i-1)!Binomial[k,k-j]Binomial[n-k,j]Binomial[k-j,i]Binomial[2k-i-1,i]/2,{j,0,k},{i,0,k-1}]),{k,2,n}],{n,3,10}]

Table[Sum[Binomial[n,k]((-1)^k(k-1)!+Sum[(-1)^i i!(k-i)!(k-i-1)!Binomial[k,k-j]Binomial[n-k,j]Binomial[k-j,i]Binomial[2k-i-1,i]/2,{j,0,k},{i,0,k-1}]),{k,2,n}],{n,10}]

Sum[(-1)^i i!(k-i)!(k-i-1)!Binomial[k,k-j]Binomial[n-k,j]Binomial[k-j,i]Binomial[2k-i-1,i]/2,{j,0,k},{i,0,k-1}]

Sum[(-1)^i i!(k-i)!(k-i-1)!Binomial[k,k-j]Binomial[n-k,j]Binomial[k-j,i]Binomial[2k-i-1,i]/2,{j,0,k}]

RecurrenceTable[{(n-3)(180n^5-3462n^4+25685n^3-91106n^2+152414n-93847)a[n]==(360n^8-8904n^7+93172n^6-538135n^5+1875502n^4-4041070n^3+5268157n^2-3817934n+1189124)a[n-1]-(n-1)(180n^9-5262n^8+67445n^7-497202n^6+2321291n^5-7107149n^4+14233985n^3-17904305n^2+12741400n-3858611)a[n-2]-(n-2)(n-1)(180n^9-5442n^8+71807n^7-543239n^6+2598146n^5-8144697n^4+16705322n^3-21515171n^2+15619923n-4754598)a[n-3]+2(n-3)(n-2)(n-1)(540n^7-12585n^6+122039n^5-636205n^4+1920840n^3-3360924n^2+3186108n-1302080)a[n-4]+2(n-4)(n-3)(n-2)(n-1)(540n^7-13806n^6+145494n^5-814365n^4+2591726n^3-4628556n^2+4207415n-1449736)a[n-5]-(n-5)(n-4)(n-3)(n-2)(n-1)(1440n^6-28956n^5+230284n^4-915485n^3+1878786n^2-1811640n+577483)a[n-6]+3(n-6)(n-5)(n-4)(n-3)(n-2)(n-1)(180n^5-2562n^4+13637n^3-33023n^2+34309n-10136)a[n-7],
a[3]==1,a[4]==28,a[5]==586,a[6]==16676,a[7]==674171,a[8]==36729512,a[9]==2591431284},a[n],{n,20}]

RecurrenceTable[{(n-3)(180n^5-3462n^4+25685n^3-91106n^2+152414n-93847)a[n]==(360n^8-8904n^7+93172n^6-538135n^5+1875502n^4-4041070n^3+5268157n^2-3817934n+1189124)a[n-1]-(n-1)(180n^9-5262n^8+67445n^7-497202n^6+2321291n^5-7107149n^4+14233985n^3-17904305n^2+12741400n-3858611)a[n-2]-(n-2)(n-1)(180n^9-5442n^8+71807n^7-543239n^6+2598146n^5-8144697n^4+16705322n^3-21515171n^2+15619923n-4754598)a[n-3]+2(n-3)(n-2)(n-1)(540n^7-12585n^6+122039n^5-636205n^4+1920840n^3-3360924n^2+3186108n-1302080)a[n-4]+2(n-4)(n-3)(n-2)(n-1)(540n^7-13806n^6+145494n^5-814365n^4+2591726n^3-4628556n^2+4207415n-1449736)a[n-5]-(n-5)(n-4)(n-3)(n-2)(n-1)(1440n^6-28956n^5+230284n^4-915485n^3+1878786n^2-1811640n+577483)a[n-6]+3(n-6)(n-5)(n-4)(n-3)(n-2)(n-1)(180n^5-2562n^4+13637n^3-33023n^2+34309n-10136)a[n-7],
a[3]==1,a[4]==28,a[5]==586,a[6]==16676,a[7]==674171,a[8]==36729512,a[9]==2591431284},a,{n,20}]

RSolve[{(n-3)(180n^5-3462n^4+25685n^3-91106n^2+152414n-93847)a[n]==(360n^8-8904n^7+93172n^6-538135n^5+1875502n^4-4041070n^3+5268157n^2-3817934n+1189124)a[n-1]-(n-1)(180n^9-5262n^8+67445n^7-497202n^6+2321291n^5-7107149n^4+14233985n^3-17904305n^2+12741400n-3858611)a[n-2]-(n-2)(n-1)(180n^9-5442n^8+71807n^7-543239n^6+2598146n^5-8144697n^4+16705322n^3-21515171n^2+15619923n-4754598)a[n-3]+2(n-3)(n-2)(n-1)(540n^7-12585n^6+122039n^5-636205n^4+1920840n^3-3360924n^2+3186108n-1302080)a[n-4]+2(n-4)(n-3)(n-2)(n-1)(540n^7-13806n^6+145494n^5-814365n^4+2591726n^3-4628556n^2+4207415n-1449736)a[n-5]-(n-5)(n-4)(n-3)(n-2)(n-1)(1440n^6-28956n^5+230284n^4-915485n^3+1878786n^2-1811640n+577483)a[n-6]+3(n-6)(n-5)(n-4)(n-3)(n-2)(n-1)(180n^5-2562n^4+13637n^3-33023n^2+34309n-10136)a[n-7],
a[3]==1,a[4]==28,a[5]==586,a[6]==16676,a[7]==674171,a[8]==36729512,a[9]==2591431284},a[n],n]

Function[{\[FormalY],\[FormalN]},{-3 (1+\[FormalN]) (2+\[FormalN]) (3+\[FormalN]) (4+\[FormalN]) (5+\[FormalN]) (6+\[FormalN]) (163289+222462 \[FormalN]+117526 (\[FormalN]^2)+30101 (\[FormalN]^3)+3738 (\[FormalN]^4)+180 (\[FormalN]^5)) \[FormalY][\[FormalN]]+(2+\[FormalN]) (3+\[FormalN]) (4+\[FormalN]) (5+\[FormalN]) (6+\[FormalN]) (1608114+3460417 \[FormalN]+2899617 (\[FormalN]^2)+1222427 (\[FormalN]^3)+275224 (\[FormalN]^4)+31524 (\[FormalN]^5)+1440 (\[FormalN]^6)) \[FormalY][1+\[FormalN]]-2 (3+\[FormalN]) (4+\[FormalN]) (5+\[FormalN]) (6+\[FormalN]) (643362+2226611 \[FormalN]+2787090 (\[FormalN]^2)+1751306 (\[FormalN]^3)+613215 (\[FormalN]^4)+121302 (\[FormalN]^5)+12654 (\[FormalN]^6)+540 (\[FormalN]^7)) \[FormalY][2+\[FormalN]]-2 (4+\[FormalN]) (5+\[FormalN]) (6+\[FormalN]) (2845343+6318237 \[FormalN]+5868821 (\[FormalN]^2)+2952010 (\[FormalN]^3)+867885 (\[FormalN]^4)+149129 (\[FormalN]^5)+13875 (\[FormalN]^6)+540 (\[FormalN]^7)) \[FormalY][3+\[FormalN]]+(5+\[FormalN]) (6+\[FormalN]) (8118563+26362844 \[FormalN]+35383713 (\[FormalN]^2)+26313067 (\[FormalN]^3)+12098603 (\[FormalN]^4)+3596255 (\[FormalN]^5)+695040 (\[FormalN]^6)+84575 (\[FormalN]^7)+5898 (\[FormalN]^8)+180 (\[FormalN]^9)) \[FormalY][4+\[FormalN]]+(6+\[FormalN]) (17756122+46691995 \[FormalN]+53941665 (\[FormalN]^2)+35901834 (\[FormalN]^3)+15170211 (\[FormalN]^4)+4221896 (\[FormalN]^5)+774299 (\[FormalN]^6)+90293 (\[FormalN]^7)+6078 (\[FormalN]^8)+180 (\[FormalN]^9)) \[FormalY][5+\[FormalN]]+(-9255742-23404835 \[FormalN]-24851637 (\[FormalN]^2)-14528236 (\[FormalN]^3)-5134877 (\[FormalN]^4)-1127753 (\[FormalN]^5)-150796 (\[FormalN]^6)-11256 (\[FormalN]^7)-360 (\[FormalN]^8)) \[FormalY][6+\[FormalN]]+(4+\[FormalN]) (31810+63661 \[FormalN]+47851 (\[FormalN]^2)+16949 (\[FormalN]^3)+2838 (\[FormalN]^4)+180 (\[FormalN]^5)) \[FormalY][7+\[FormalN]]==0,\[FormalY][3]==1,\[FormalY][4]==28,\[FormalY][5]==586,\[FormalY][6]==16676,\[FormalY][7]==674171,\[FormalY][8]==36729512,\[FormalY][9]==2591431284}][a,n]

RecurrenceTable[{-3 (1+n) (2+n) (3+n) (4+n) (5+n) (6+n) (163289+222462 n+117526 (n^2)+30101 (n^3)+3738 (n^4)+180 (n^5)) a[n]+(2+n) (3+n) (4+n) (5+n) (6+n) (1608114+3460417 n+2899617 (n^2)+1222427 (n^3)+275224 (n^4)+31524 (n^5)+1440 (n^6)) a[1+n]-2 (3+n) (4+n) (5+n) (6+n) (643362+2226611 n+2787090 (n^2)+1751306 (n^3)+613215 (n^4)+121302 (n^5)+12654 (n^6)+540 (n^7)) a[2+n]-2 (4+n) (5+n) (6+n) (2845343+6318237 n+5868821 (n^2)+2952010 (n^3)+867885 (n^4)+149129 (n^5)+13875 (n^6)+540 (n^7)) a[3+n]+(5+n) (6+n) (8118563+26362844 n+35383713 (n^2)+26313067 (n^3)+12098603 (n^4)+3596255 (n^5)+695040 (n^6)+84575 (n^7)+5898 (n^8)+180 (n^9)) a[4+n]+(6+n) (17756122+46691995 n+53941665 (n^2)+35901834 (n^3)+15170211 (n^4)+4221896 (n^5)+774299 (n^6)+90293 (n^7)+6078 (n^8)+180 (n^9)) a[5+n]+(-9255742-23404835 n-24851637 (n^2)-14528236 (n^3)-5134877 (n^4)-1127753 (n^5)-150796 (n^6)-11256 (n^7)-360 (n^8)) a[6+n]+(4+n) (31810+63661 n+47851 (n^2)+16949 (n^3)+2838 (n^4)+180 (n^5)) a[7+n]==0,a[3]==1,a[4]==28,a[5]==586,a[6]==16676,a[7]==674171,a[8]==36729512,a[9]==2591431284},a,{n,20}]

CyclePolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"CyclePolynomial"][x],{n,k0=3,kmax=20}]/.f_Function:>f[x]])//Column

CoefficientList[Take[poly,4],x]

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]

CoefficientList[Take[poly,4],x]

Take[poly,4]//Column

Computed from the count formula:

poly2=Table[Factor@Sum[(x^(2k))Binomial[n,k]((-1)^k(k-1)!+Sum[(-1)^i i!(k-i)!(k-i-1)!Binomial[k,k-j]Binomial[n-k,j]Binomial[k-j,i]Binomial[2k-i-1,i]/2,{j,0,k},{i,0,k-1}]),{k,2,n}],{n,k0,kmax}];

FullSimplify[Take[poly2-poly,10]]

Cyclic

Table[GraphData[{"Crown",n},"Cyclic"],{n,20}]

CyclomaticNumber

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

FindSequenceFunction[seq,n-2]//Factor

DetourIndex

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

FindSequenceFunction[seq,n-2]

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

DetourMatrix

MatrixForm/@Table[GraphData[{"Crown",n},"DetourMatrix"],{n,20}]

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

DetourPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"DetourPolynomial"],{n,k0=3,kmax=20}]/.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,k0,kmax}]

FullSimplify[poly2-poly]

Diameter

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

DistanceMatrix

MatrixForm/@Table[GraphData[{"Crown",n},"DistanceMatrix"],{n,20}]

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

DistancePolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"DistancePolynomial"],{n,k0=3,kmax=20}]/.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,k0,kmax}]

FullSimplify[poly2-poly]

DistinguishingNumber

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

DomaticNumber

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

DominatingSetCount

A287063

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

FindLinearRecurrence[DeleteMissing[seq]]

FindSequenceFunction[DeleteMissing[seq],n-2]

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

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

Table[(4^n)-(2^n) (n+2)+(n^2)+n+3,{n,25}]

LinearRecurrence[{11,-47,101,-116,68,-16},{3,9,39,183,833,3629},25]

DominationNumber

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

DominationPolynomial

(poly=Table[GraphData[{"Crown",n},"DominationPolynomial"],{n,k0=3,kmax=20}]/.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]

EdgeChromaticNumber

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

FindSequenceFunction[seq,n-2]

EdgeConnectivity

Table[GraphData[{"Crown",n},"EdgeConnectivity"],{n,20}]

EdgeCount

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

FindSequenceFunction[DeleteCases[seq,_Missing],n-2]//FullSimplify

2Binomial[n,2]

EdgeCoverCount

A086193

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

sum((-1)^(n-r)*binomial(n,r)*(2^(r-1)-1)^r*(2^r-1)^(n-r),r=0..n)

Sum[(((-1))^(n-k))Binomial[n,k]((((2^(k-1))-1))^k)((((2^k)-1))^(n-k)),{k,0,n}]

seq=Table[Sum[(((-1))^(n-k))Binomial[n,k]((((2^(k-1))-1))^k)((((2^k)-1))^(n-k)),{k,0,n}],{n,20}]

FindLinearRecurrence[seq]

FindSequenceFunction[seq,n]

gf=x FindGeneratingFunction[seq,x]

Egf

Sum[((((2^(n-1))-1))^n)Exp[(1-(2^n))x]((x^n)/(n!)),{n,0,∞}]

EdgeCoverNumber

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

EdgeCoverPolynomial

poly=Table[GraphData[{"Crown",n},"EdgeCoverPolynomial"]/.f_Function:>f[x],{n,20}]

Take[Expand@poly,4]//Column

Should be possible to infer from formula for counts

(poly2=Table[Sum[(((-1))^(n-k))(x^k)Binomial[n,k]((((2^(k-1))-1))^k)((((2^k)-1))^(n-k)),{k,0,n}],{n,3,5}])//Column

EulerianCycleCount

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

FindSequenceFunction[Take[seq,7][[1;;All;;2]],n]

FaceCount

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

FlowPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"FlowPolynomial"],{n,k0=3,kmax=10}]/.f_Function:>f[x]])//Column

coef=Factor/@FindLinearRecurrence[DeleteMissing[poly]/(x-1)]

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]

FractionalChromaticNumber

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

FractionalEdgeChromaticNumber

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

Girth

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

Gonality

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

HamiltonConnected

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

HamiltonDecompositionCount

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

Hamiltonian

Table[GraphData[{"Crown",n},"Hamiltonian"],{n,20}]

HamiltonianCycleCount

DeleteCases[GraphData[{"Crown",#},"|HC|"]&/@Range[3,20],_Missing]

2 (((-1))^n) (n-1)!+n! (∑_(j=0)^(n-1))(((-1))^j) (-j+n-1)! (({{-j+2 n-1}, {j}}))

Table[2(((-1))^n)(n-1)!+n!Sum[(((-1))^j)(n-j-1)!Binomial[2n-j-1,j],{j,0,n-1}],{n,10}]

2(((-1))^n)(n-1)!+n!Sum[(((-1))^j)(n-j-1)!Binomial[2n-j-1,j],{j,0,n-1}]

V11

Sum[(((-1))^j)(n-j-1)!Binomial[2n-j-1,j],{j,0,n-1}]

bug(331882): Sum[(-1)^j (n - j - 1)! Binomial[2 n - j - 1, j], {j, 0, n - 1}] incorrectly returns 0

Table[Sum[(((-1))^j)(n-j-1)!Binomial[2n-j-1,j],{j,0,n-1}],{n,5}]

V7

2(((-1))^n)(n-1)!+n!Sum[(((-1))^j)(n-j-1)!Binomial[2n-j-1,j],{j,0,n-1}]

Sum[(((-1))^j)(n-j-1)!Binomial[2n-j-1,j],{j,0,n-1},Method->{"SequentialFirstToSucceed",Method->{"HypergeometricTermFinite","HypergeometricTermGosper","HypergeometricTermPFQ","HypergeometricTermZeilberger","LevelCounting","Logarithmic","PeriodicFunction","PolyGammaHypergeometricSeries","PolyGammaIntegralRepresentation","PolyGammaSumByParts","Polynomial","PolynomialExponential","PolynomialTrigonometric","Procedural","QHypergeometricTermGosper","QHypergeometricTermZeilberger","QRationalFunction","RationalExponential","RationalFunction","RationalTrigonometric","TableLookup"}}]

Sum[(((-1))^j)(n-j-1)!Binomial[2n-j-1,j],{j,0,n-1},Method->{"SequentialFirstToSucceed",Method->All}]

Sum[i,{i,n},Method->{"SequentialFirstToSucceed",Method->{"HypergeometricTermFinite","HypergeometricTermGosper","HypergeometricTermPFQ","HypergeometricTermZeilberger","LevelCounting","Logarithmic","PeriodicFunction","PolyGammaHypergeometricSeries","PolyGammaIntegralRepresentation","PolyGammaSumByParts","Polynomial","PolynomialExponential","PolynomialTrigonometric","Procedural","QHypergeometricTermGosper","QHypergeometricTermZeilberger","QRationalFunction","RationalExponential","RationalFunction","RationalTrigonometric","TableLookup"}}]

Sum[i,{i,n},Method->{"SequentialFirstToSucceed",Method->All}]

Table[2 (((-1))^n) (-1+n)!+n! DifferenceRoot[Function[{\[FormalY],\[FormalN]},{(-2-4 \[FormalN]+4 n) \[FormalY][\[FormalN]]+(1-(\[FormalN]^2)-2 n+\[FormalN] (2+2 n)) \[FormalY][1+\[FormalN]]+(1+(\[FormalN]^2)+\[FormalN] (2-2 n)-2 n) \[FormalY][2+\[FormalN]]==0,\[FormalY][0]==0,\[FormalY][1]==(-1+n)!}]][n],{n,10}]

FunctionExpand[%,n∈Integers&&n>0]

FullSimplify[%,n∈Integers&&n>0]

Table[2 (((-1))^n) Gamma[n]+((BesselI[-n,2] Gamma[1-n] Gamma[n] Gamma[1+n])/(E^2))-(((-1))^n) Gamma[n] HypergeometricPFQ[{(1/2),1},{1-n,1+n},-4],{n,10}]

FunctionExpand[(((-1))^j)(n-j-1)!Binomial[2n-j-1,j]]

Table[2(((-1))^n)(n-1)!+n!Sum[(((((-1))^j) (2^(1+2 j-2 n)) (Sqrt[π]) Gamma[-j+2 n])/(Gamma[1+j] Gamma[(1/2)-j+n])),{j,0,n-1}],{n,10}]

2(((-1))^n)(n-1)!+n!Sum[(((((-1))^j) (2^(1+2 j-2 n)) (Sqrt[π]) Gamma[-j+2 n])/(Gamma[1+j] Gamma[(1/2)-j+n])),{j,0,n-1}]

...Not defined at integers...

Table[2 (((-1))^n) (-1+n)!+n! ((((2^(1-2 n)) (Sqrt[π]) Gamma[2 n] Hypergeometric1F1[(1/2)-n,1-2 n,-4])/(Gamma[(1/2) (1+2 n)]))-((2 (((-1))^n) Gamma[n] HypergeometricPFQ[{(1/2),1},{1-n,1+n},-4])/(Gamma[1+n]))),{n,10}]

Table[2(((-1))^n)(n-1)!+n!Sum[(((((-1))^j) (2^(1+2 j-2 n)) (Sqrt[π]) Gamma[-j+2 n])/(Gamma[1+j] Gamma[(1/2)-j+n])),{j,0,n-1}],{n,10}]

Table[2(((-1))^n)(n-1)!+n!Sum[(((((-1))^j)(n-j-1)!(2n-j-1)!)/(j!(2n-2j-1)!)),{j,0,n-1}],{n,10}]

2(((-1))^n)(n-1)!+n!Sum[(((((-1))^j)(n-j-1)!(2n-j-1)!)/(j!(2n-2j-1)!)),{j,0,n-1}]

FullSimplify[2 (((-1))^n) (-1+n)!+n! (-((2 (E^(I n π)))/n)+Gamma[n] Hypergeometric1F1[(1/2)-n,1-2 n,-4]-((2 (((-1))^n) HypergeometricPFQ[{1,(3/2)},{2-n,2+n},-4])/(n (-1+(n^2))))),n∈Integers]

...Not defined at integers...

HamiltonianNumber

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

FindSequenceFunction[seq,n-2]

HamiltonianPathCount

A137886

seq=GraphData[{"Crown",#},"|HP|"]&/@Range[3,20]

FindLinearRecurrence[seq]

FindSequenceFunction[DeleteCases[seq,_Missing],n-2]//FullSimplify

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

Clear[a]

RSolve[{a[n]==(n-1)*n*a[n-1]+(n-1)^2*n*a[n-2]+(n-2)*(n-1)*n*a[n-3],a[3]==6,a[4]==72,a[5]==1920},a[n],n]

FunctionExpand[%]//FullSimplify

a[3]=6;
a[4]=72;
a[5]=1920;
a[n_]:=a[n]=(n-1)n a[n-1]+(n-1)^2n a[n-2]+(n-2)(n-1)n a[n-3]

Table[a[n],{n,20}]

FindSequenceFunction[{6,72,1920,69120,3402000,218252160,17708544000,1773002649600,214725759494400,30941575378560000,5231894853375590400,1025881591718766182400,230901375630648602880000,59127083048250564931584000,17091634972762948947148800000,5538749880817549472161333248000,1999812328992773161982336212992000,800035365939970207313091084779520000},n]

HamiltonianWalkCount

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

HararyIndex

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

FindSequenceFunction[seq,n-2]//Factor

HexagonCount

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

FindSequenceFunction[seq,n-2]//Factor

IdiosyncraticPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"IdiosyncraticPolynomial"],{n,k0=3,kmax=20}]/.f_Function:>f[x,y]])//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,k0,kmax}]

FullSimplify[poly2-poly]

IndependenceNumber

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

FindSequenceFunction[seq,n-2]

IndependencePolynomial

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

coef=Factor/@FindLinearRecurrence[poly]

p=.

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[-1+n (x^2)+2 (((1+x))^n),{n,k0,kmax}]

FullSimplify[poly2-poly]

IndependenceRatio

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

IndependentEdgeSetCount

A144085

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

Table[n! Sum[((((-1))^k)/(k!))Sum[((Binomial[n-k,j])/(j!)),{j,0,n-k}],{k,0,n}],{n,10}]

n! Sum[((((-1))^k)/(k!))Sum[((Binomial[n-k,j])/(j!)),{j,0,n-k}],{k,0,n}]

Sum[((Binomial[n-k,j])/(j!)),{j,0,n-k}]//FunctionExpand

n!Sum[(-1)^m/m!LaguerreL[-m+n,-1],{m,0,n}]//FullSimplify

seq=Table[n!Sum[(-1)^m/m!LaguerreL[-m+n,-1],{m,0,n}],{n,0,30}]

FindSequenceFunction[seq,n-1]

Function[{\[FormalY],\[FormalN]},{(\[FormalN]+(\[FormalN]^2)) \[FormalY][\[FormalN]]+(-1+(\[FormalN]^2)) \[FormalY][1+\[FormalN]]+(-3-2 \[FormalN]) \[FormalY][2+\[FormalN]]+\[FormalY][3+\[FormalN]]==0,\[FormalY][1]==1,\[FormalY][2]==1,\[FormalY][3]==4}][a,n]//Simplify

n (1+n) a[n]+(-1+(n^2)) a[1+n]+a[3+n]==(3+2 n) a[2+n]/.n->n+1

RecurrenceTable[{n (1+n) a[n]+(-1+(n^2)) a[1+n]+a[3+n]==(3+2 n) a[2+n],a[1]==1,a[2]==1,a[3]==4},a,{n,20}]

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

FindGeneratingFunction[DeleteMissing@seq,x]

IndependentVertexSetCount

A083706

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

FindSequenceFunction[seq,n-2]

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

FindLinearRecurrence[DeleteMissing@seq]

LinearRecurrence[{4,-5,2},{4,9,18},{0,20}]

gf=FindGeneratingFunction[DeleteMissing@seq,x]

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

IntersectionNumber

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

IrredundantSetCount

A290710

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

seq={24,77,178,373,724,1331,2364,4127,7186,12625,22558,41153,76680,145607,280792,547867,1078006,2133461,4238634,8442221,16841500,33630907,67199188,134323703,268559034,537014201,1073907094,2147673337,4295184016,8590181135};

coef=FindLinearRecurrence[Rest@DeleteMissing@seq]

Take[seq,Length@coef]

Join[{24},LinearRecurrence[{7,-20,30,-25,11,-2},{77,178,373,724,1331,2364},20]]

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

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

CoefficientList[Series[((24-91 x+119 (x^2)-53 (x^3)-37 (x^4)+44 (x^5)-12 (x^6))/((((-1+x))^5) (-1+2 x))),{x,0,20}],x]

Simplify[SeriesCoefficient[gf,{x,0,n}],n>3]

Table[If[n==3,24,2^(n+1)+n*(n^3-2n^2+3n+2)/4-1],{n,20}]

KirchhoffIndex

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

FindSequenceFunction[seq,n-2]//Factor

KirchhoffSumIndex

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

FindSequenceFunction[seq,n-2]//Factor

LaplacianMatrix

MatrixForm/@Table[GraphData[{"Crown",n},"LaplacianMatrix"],{n,20}]

LaplacianPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"LaplacianPolynomial"],{n,k0=3,kmax=20}]/.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,k0,kmax}]

FullSimplify[poly2-poly]

LeafCount

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

LongestCycleCount

Same as HC count

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

LovaszNumber

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

MatchingGeneratingPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"MatchingGeneratingPolynomial"],{n,k0=3,kmax=20}]/.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,k0,kmax}]

FullSimplify[poly2-poly]

MatchingNumber

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

MatchingPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"MatchingPolynomial"],{n,k0=3,kmax=20}]/.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,k0,kmax}]

FullSimplify[poly2-poly]

MaximalCliqueCount

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

FindSequenceFunction[seq,n-2]//Factor

MaximalIndependentEdgeSetCount

A212291

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

Table[Round[n!/E],{n,20}]

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

seq=Table[(((-1))^n) (HypergeometricPFQ[{1,-n},{},1]-n HypergeometricPFQ[{1,1-n},{},1]),{n,30}]

gf=x FindGeneratingFunction[seq,x]

MaximalIndependentVertexSetCount

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

MaximalIrredundantSetCount

A289121

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

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

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

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

coef=FindLinearRecurrence[DeleteMissing@seq]

Take[seq,Length@coef]

LinearRecurrence[{5,-10,10,-5,1},{3,4,5,12,37},20]

gf=x FindGeneratingFunction[DeleteMissing@seq,x]

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

MaximumCliqueCount

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

FindSequenceFunction[seq,n-2]//Factor

MaximumIndependentEdgeSetCount

A000166

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

FindSequenceFunction[seq,n-2]//FullSimplify

MaximumIndependentVertexSetCount

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

MaximumLeafNumber

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

FindSequenceFunction[seq,n-2]//Factor

MaximumVertexDegree

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

MatchingGeneratingPolynomial

A144089

(poly=Factor[Table[GraphData[{"Crown",n},"MatchingGeneratingPolynomial"],{n,k0=3,kmax=20}]/.f_Function:>f[x]])//Column

CoefficientList[Take[poly,4],x]

coef=Factor/@FindLinearRecurrence[DeleteMissing[poly]]

p=.

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]

Take[poly,4]//Expand//Column

Inferred from IndependentEdgeSetCount

poly2=Table[(x^n)n! Sum[((((-1))^k)/(k!))LaguerreL[n-k,-1/x],{k,0,n}],{n,k0,kmax}];

FullSimplify[Take[poly2-poly,10]]

CoefficientList[Table[(x^n)n! Sum[((((-1))^k)/(k!))LaguerreL[n-k,-1/x],{k,0,n}],{n,2,10}],x]

Sum[((((-1))^k)/(k!))LaguerreL[n-k,-1/x],{k,0,n}]//FunctionExpand

MatchingPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"MatchingPolynomial"],{n,k0=3,kmax=20}]/.f_Function:>f[x]])//Column

CoefficientList[Take[poly,4],x]

coef=Factor/@FindLinearRecurrence[DeleteMissing[poly]]

p=.

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]

Take[poly,4]//Factor//Column

poly2=Table[n! Sum[((((-1))^(k+n))/(k!))LaguerreL[n-k,(x^2)],{k,0,n}],{n,k0,kmax}];

Take[poly2,7]//Factor//Column

FullSimplify[Take[poly2-poly,10]]

MeanDistance

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

MinimalDominatingSetCount

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

FindLinearRecurrence[DeleteMissing@seq]

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

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

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

MinimalDominatingSetSignature

seq=Table[GraphData[{"Crown",n},"MinimalDominatingSetSignature"],{n,20}]//Column

Table[Piecewise[{{{{2,3},{3,2}},n==3},{{{2,4},{4,8}},n==4}},{{2,n},{4,6Binomial[n,4]},{n,2}}],{n,20}]//Column

FindSequenceFunction[{30,90,210,420,756,1260,1980,2970,4290},n-4]//Factor

6Binomial[n,4]

Factor[6Binomial[n,4]+n+2]

MinimalEdgeCoverCount

A290755

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

FindLinearRecurrence[DeleteMissing@seq]

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

Factor[6Binomial[n,4]+n+2]

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

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

MinimumCliqueCoveringCount

A000166

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

Table[Subfactorial[n],{n,20}]

MinimumConnectedDominatingSetCount

A033487

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

FindSequenceFunction[DeleteCases[seq,_Missing],n-2]//Factor

6Binomial[n+1,4]

Table[6Binomial[n+3,4],{n,0,20}]

MinimumDistinguishingLabelingCount

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

MinimumDominatingSetCount

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

MinimumEdgeCoverCount

A000166

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

Table[Subfactorial[n],{n,20}]

MinimumVertexDegree

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

MolecularTopologicalIndex

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

FindSequenceFunction[seq,n-2]//Factor

Nonhamiltonian

Table[GraphData[{"Crown",n},"Nonhamiltonian"],{n,20}]

NormalizedLaplacianMatrix

MatrixForm/@Table[GraphData[{"Crown",n},"NormalizedLaplacianMatrix"],{n,20}]

OddChordlessCycleCount

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

PathCount

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

FindLinearRecurrence[DeleteMissing@seq]

FindSequenceFunction[DeleteMissing@seq,n-2]

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

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

PathPolynomial

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

FullSimplify[poly2-poly]

PentagonCount

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

Perfect

Table[GraphData[{"Crown",n},"Perfect"],{n,20}]

ProjectivePlaneCrossingNumber

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

Radius

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

RankPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"RankPolynomial"],{n,k0=3,kmax=20}]/.f_Function:>f[x,y]])//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,k0,kmax}]

FullSimplify[poly2-poly]

RectilinearCrossingNumber

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

ReliabilityPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"ReliabilityPolynomial"],{n,k0=3,kmax=20}]/.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]

SigmaPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"SigmaPolynomial"],{n,k0=3,kmax=20}]/.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,k0,kmax}]

FullSimplify[poly2-poly]

SpanningTreeCount

A193133

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

FindSequenceFunction[seq,n-2]

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

SquareCount

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

FindSequenceFunction[seq,n-2]//Factor

StabilityIndex

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

FindSequenceFunction[seq,n-2]//Factor

TopologicalIndex

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

FindSequenceFunction[seq,n-2]//Factor

ToroidalCrossingNumber

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

Traceable

Table[GraphData[{"Crown",n},"Traceable"],{n,20}]

TriangleCount

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

TuttePolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"TuttePolynomial"],{n,k0=3,kmax=20}]/.f_Function:>f[x,y]])//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]

Untraceable

Table[GraphData[{"Crown",n},"Untraceable"],{n,20}]

VertexConnectivity

Table[GraphData[{"Crown",n},"VertexConnectivity"],{n,20}]

VertexCount

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

FindSequenceFunction[seq,n-2]

VertexCoverNumber

vertex cover number == vertex count - independence number

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

FindSequenceFunction[seq,n-2]

VertexCoverPolynomial

(poly=Factor[Table[GraphData[{"Crown",n},"VertexCoverPolynomial"],{n,k0=3,kmax=20}]/.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,k0,kmax}]

FullSimplify[poly2-poly]

VertexDegrees

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

VertexTransitive

Table[GraphData[{"Crown",n},"VertexTransitive"],{n,20}]

WienerIndex

A033428

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

FindSequenceFunction[seq,n-2]//Factor

FindLinearRecurrence[seq]

WienerSumIndex

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

FindSequenceFunction[seq,n-2]//Factor

GraphData

GraphClassString

GraphClassString[Select[GraphData["Crown"],GraphData[#,"V"]>0&]]

GraphDataString

Print[GraphDataString[{"Crown",#},CrownGraph[#],60]]&/@Range[3,20]