Hypercube

Author

Eric W. Weisstein
May 25, 2014

This notebook downloaded from http://mathworld.wolfram.com/notebooks/MultidimensionalGeometry/Hypercube.nb.

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

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

Code

edgefind::"usage"="edgefind[poly] returns the edges of equilateral regular polytopes."
mag::"usage"="mag[v_] returns the norm or magnitude of the n-vector 'v'."
nCube::"usage"="nCube[n] gives the 2^n vertices of an n-dimensional cube centered upon the origin, of edge length 2, and with its bounding hyperplanes parallel to the coordinate hyperplanes."
xyCube::"usage"="xyCube[n] gives the 2^n vertices of an n-dimensional cube centered upon the origin, of edge length Sqrt[2n], such that the projection into the {x,y} plane is isometric."
nCross::"usage"="nCross[n] gives the 2n vertices of an n-dimensional cross polytope or orthoplex, centered upon the origin, of edge length Sqrt[2], and unit circumradius."
xyCross::"usage"="xyCross[n] gives the 2^n vertices of an n-dimensional cross polytope centered upon the origin, of edge length Sqrt[n], such that the projection into the {x,y} plane is especially symmetrical."
nSimplex::"usage"="nSimplex[n] gives the (n+1) vertices of an n-simplex of edge Sqrt[n+1]."
zonotope::"usage"="zonotope[vectors] accepts a list of n-vectors 'vectors'. It returns 2^(Length[vectors]) n-vectors, which are the projection (possibly oblique) of the vertices of a (Length[vectors])-orthotope into the n-space.  Example: zonotope[{{1,0,0},{0,1,0},{0,0,1}}] returns the vertices of a 3-cube."

PolytopeGraph[poly_,opts___]:=Module[
{
a=Map[#[[{1,2}]]&,poly],
b=Map[#[[{1,2}]]&,edgefind[poly],{2}]
},
Graphics[{Line/@b,RGBColor[1,0,0],AbsolutePointSize[4],opts,Point/@a},AspectRatio->Automatic]
]

edgefind[poly_]:=Block[{a,b},b=First@Union[Map[mag[First@poly-#]&,Rest@poly],SameTest->(Chop[#1-#2]==0&)];
Flatten[Table[a=Drop[poly,i-1];
{First@a,#}&/@Select[Rest@a,Abs[mag[First@a-#]-b]<.001&],{i,Length[poly]}],1]]

nCube[n_]:=Tuples[{-1,1},n]

xyCube[n_]:=zonotope[Take[xyCross[n],n]]

nCross[n_]:=Join[-IdentityMatrix[n],IdentityMatrix[n]]

xyCross[n_]:=Module[{a,r,k},(*section 13.4 of Regular Polytopes*)a=Table[Flatten[Table[Through[{Cos,Sin}[(2 r-1) Pi k/n]],{r,Floor[n/2]}]],{k,2 n}];
If[OddQ[n],Table[Join[a[[k]],{(-1)^k/Sqrt[2]}],{k,2 n}],(*Else*)a]]

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

mag[v_]:=N[Sqrt[v.v]]

zonotope[vectors_List]:=(nCube[Length[vectors]].vectors)

Isometric[poly_]:=Graphics[{Line/@Map[#[[{1,2}]]&,edgefind[poly],{2}],RGBColor[1,0,0],AbsolutePointSize[5],Point/@Map[#[[{1,2}]]&,poly]},AspectRatio->Automatic]

Graphic

GraphicsRow[Table[GraphData[{"Hypercube",n},"Image"],{n,5}]/.AbsolutePointSize[_]:>AbsolutePointSize[4]]

Special Views

xyCube[4]

v334=nCross[4]

Show[Isometric[v433=nCube[4]]]

HypercubeGraphIsometric[4]

Show[Isometric[xyCube[4]]]

Counts of Vertices, Faces, etc.

Nodes

Table[(2^n),{n,10}]

Edges

Table[(2^(n-1))n,{n,10}]

Squares

Table[(2^(n-3))n(n-1),{n,10}]

Cubes

Table[(2^(n-4))n(n-1)(n-2)/3,{n,10}]

Points Maximizing Product of Distances to Vertices

MaximumProduct[n_]:=Module[{v=Flatten[Outer[List,Sequence@@Table[{0,1},{n}]],n-1],
vars=Array[x,n]},
Maximize[{Times@@(#.#&[vars-#]&/@v),And@@(0≤#≤1&/@vars)},
vars]
]

NMaximumProduct[n_,opts___?OptionQ]:=Module[{v=Flatten[Outer[List,Sequence@@Table[{0,1},{n}]],n-1],
vars=Array[x,n]},
NMaximize[{Times@@(#.#&[vars-#]&/@v),And@@(0≤#≤1&/@vars)},
vars,
opts]
]

HypercubeProduct2[l_]:=Module[{n=Length[l],v},v=Flatten[Outer[List,Sequence@@Table[{0,1},{n}]],n-1];
Times@@(#.#&/@(l-#&/@v))
]

MaximumProduct[2]//Timing

HypercubeProduct2[{0,1/2}]

NMaximumProduct[3]//Timing

{#,N[#]}&@HypercubeProduct2[{0,0,1/2}]

MaximumProduct[3]//Timing

Uses > 1.7 GB after 2 hours

Runs out of memory...

NMaximumProduct[4]//Timing

{#,N[#]}&@HypercubeProduct2[{0,0,0,1/2}]

NMaximumProduct[5]//Timing

NMaximumProduct[5,WorkingPrecision->20]//Timing

{#,N[#]}&@HypercubeProduct2[{0,0,0,0,1/4}]

Through[{Numerator,Denominator}[{(25/256),(50625/65536),(1403336390625/4294967296),520121694537167720452513764834088049286462890625/340282366920938463463374607431768211456}]]