Apex Graph

Author

Eric W. Weisstein
December 10, 2021

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

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

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

ApexCount table

GraphDataCountTable["ApexCount"]

Classes

Antiprism

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

FindSequenceFunction[seq,n-2]

Circulant

GraphData["Circulant","ApexCount"]//Union

Complete

seq=Table[GraphData[{"Complete",n},"ApexCount"],{n,30}]

CompleteBipartite n×n

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

CompleteBipartite m×n

DeleteCases[Sort@Flatten[Table[{{m,n},GraphData[{"CompleteBipartite",{m,n}},"ApexCount"],
Piecewise[{{m+n,Min[m,n]<3},{6,m==n==3},{3,Min[m,n]==3}}]},{n,10},{m,n}],1],{_,x_,x_}]

CompleteTripartite n×n×n

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

CompleteBipartite k×m×n

DeleteCases[Sort@Flatten[Table[
{{k,m,n},
GraphData[{"CompleteTripartite",{k,m,n}},"ApexCount"],
Piecewise[{{k+m+n,k m n==Max[k,m,n]},{k+m+n,k+m+n<7},{3,k m n/Max[k,m,n]==2},{3,Min[k,m,n]==2&&Max[k,m,n]==3&&k m n/(Min[k,m,n]Max[k,m,n])==2}}]
},{n,10},{m,n},{k,m}],2],{_,x_,x_}]

CubeConnectedCycle

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

Cycle

seq=Table[GraphData[{"Cycle",n},"ApexCount"],{n,3,30}]

Empty

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

Grid m×n

DeleteCases[Sort@Flatten[Table[{{m,n},GraphData[{"Grid",{m,n}},"ApexCount"],m n},{n,10},{m,n}],1],{_,x_,x_}]

Grid n×n

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

Grid k×m×n

DeleteCases[Sort@Flatten[Table[
{{k,m,n},
GraphData[{"Grid",{k,m,n}},"ApexCount"],
k m n
},{n,5},{m,n},{k,m}],2],{_,x_,x_}]

Grid n×n×n

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

Hypercube

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

Keller

seq=Table[GraphData[{"Keller",n},"ApexCount"],{n,4}]

Knight m×n

DeleteCases[Sort@Flatten[Table[{{m,n},GraphData[{"Knight",{m,n}},"ApexCount"],Piecewise[{{Max[m,n],Min[m,n]==1},{m n,Min[m,n]==2||(Min[m,n]==3&&Max[m,n]<6)},{2,Min[m,n]==3&&Max[m,n]==6},{2,Min[m,n]==4&&Max[m,n]==5},{4,m==n==4}}]},{n,10},{m,n}],1],{_,x_,x_}]

Knight n×n

seq=Table[GraphData[{"Knight",{n,n}},"ApexCount"],{n,10}]

Ladder

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

MoebiusLadder

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

Mycielski

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

Odd

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

Path

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

Prism

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

Star

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

Transposition

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

Wheel

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

Apex

All

A215620

Total[Boole[Get[#]]]&/@FileNames["*.m",FileNameJoin[{$GraphDataDirectory,"Nodes","Apex"}]]

Table[Total[Boole[ApexGraphQ/@Graphs[n]]],{n,10}]//Timing

FindLinearRecurrence[{1,2,4,11,34,155,1026,11666,226916,6810525}]

FindSequenceFunction[{1,2,4,11,34,155,1026,11666,226916,6810525},n]

Table[Length@GraphData["Apex",n],{n,10}]

Connected

Not in OEIS as on 2017-10-29

Table[Total[Boole[Get[FileNameJoin[{$GraphDataDirectory,"Nodes","Apex","Apex_"<>If[n<10,"0",""]<>ToString[n]<>".m"}]][[ConnectedGraphIndices[n]]]]],{n,10}]

Table[Total[Boole[ApexGraphQ/@ConnectedGraphs[n]]],{n,10}]//Timing

Table[Length@GraphData[{"Apex","Connected"},n],{n,10}]

Disconnected

Not in OEIS as on 2017-10-29

Table[Total[Boole[Get[FileNameJoin[{$GraphDataDirectory,"Nodes","Apex","Apex_"<>If[n<10,"0",""]<>ToString[n]<>".m"}]][[DisconnectedGraphIndices[n]]]]],{n,10}]

Table[Length@GraphData[{"Apex","Disconnected"},n],{n,10}]

NonplanarApex

A215621

Table[Total[Boole[NonplanarApexGraphQ/@Graphs[n]]],{n,10}]//Timing

FindLinearRecurrence[{1,13,204,4700,147063,5669609}]

FindSequenceFunction[{1,13,204,4700,147063,5669609},n]

Table[Length@GraphData[{"Nonplanar","Apex"},n],{n,10}]

Graphics

GraphicsGrid[Table[Select[Graphs[n],ApexGraphQ],{n,4}]]

Select[Graphs[5],NonplanarApexGraphQ]

Apices[GraphData["K5"]]

gs=Select[Graphs[6],NonplanarApexGraphQ];

{RecognizeGraph[#],Complement[Range[6],Apices[#]]}&/@gs//Column

GraphicsGrid[
Partition[Show[GraphData[r=RecognizeGraph[#],"LabeledImage"],PlotLabel->GraphData[r,"Name"]]&/@
gs,4,4,{1,1},{}]]

Apices/@gs

Checks

<<MathWorld`Graphs`

Checking all n vertices

DeleteCases[
Monitor[{gn=#,ApexGraphQ[GraphData[#]],GraphData[#,"Apex"]}&/@GraphData[;;20],gn],
{_,x_,x_}]//Timing

Checking only symmetrically distinct vertices

DeleteCases[
Monitor[{gn=#,ApexGraphQ[GraphData[#]],GraphData[#,"Apex"]}&/@GraphData[;;20],gn],
{_,x_,x_}]//Timing