Pentatope

Author

Eric W. Weisstein
October 20, 2006

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polyhedra/Pentatope.nb.

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

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

Code

Simplex[n_]:=Module[{a,k,r},
a=Flatten/@Table[Through[{Cos,Sin}[2 Pi k r/(n+1)]],{k,0,n},{r,Floor[n/2]}];
If[OddQ[n],Table[Join[a[[k]],{((-1)^k)/Sqrt[2]}],{k,n+1}],a]
]

Pentatope:=Simplex[4]

Vertices

Pentatope//RootReduce

ToRadicals[Root[5-20 ((#1)^2)+16 ((#1)^4)&,#]]&/@Range[4]

Length[Pentatope]

Circumradius

Max[FullSimplify[Norm/@Pentatope]]

Edge Length

Min[FullSimplify[Norm[#-Pentatope[[1]]]&/@Rest[Pentatope]]]//Timing

Edges

((5!)/(2!3!))

(edges=Select[Subsets[Range[5],{2}],Abs[Norm[Subtract@@Pentatope[[#]]]-(Sqrt[5.])]<.001&])//Length//Timing

edges

edges==Subsets[Range[5],{2}]

Union[N[Norm/@(Subtract@@@(Cell120[[#]]&/@Edges[Cell120Graph])),20]]//Timing

Distances

Numeric

Union[N[Norm/@(Subtract@@@Subsets[Pentatope,{2}]),20],SameTest->(Abs[#1-#2]<.0001&)]//Length//Timing

Symbolic

Union[RootReduce[FunctionExpand[Norm/@(Subtract@@@Subsets[Pentatope,{2}])]]]//Length//Timing

Graph

Quit[]

PentatopeGraph:=Graph[List/@Subsets[Range[5],{2}],CircularEmbedding[5]]

ShowGraph[PentatopeGraph,ImageSize->200]

ShowGraph[RecognizeGraph[PentatopeGraph]]

GraphData

GraphDataString["PentatopeGraph",PentatopeGraph]

Graph Properties

Through[{V,M,Girth,Diameter,RegularQ,RegularParameters}[PentatopeGraph]]//Timing

Spectrum

Spectrum[PentatopeGraph]//SpectrumForm

Numbers of Vertices at Distance n

{First[#],Length[#]}&/@Split[Distances[PentatopeGraph,1]]

Last/@%

Automorphism Group

Length[Automorphisms[PentatopeGraph]]//Timing