Hexahedral Dissection
of
Polar Zonohedra

The "Shells of Translation" Dissection

by
Russell Towle
rustybel@foothill.net

Discussion

Polar zonohedra are bounded by n*(n-1) rhombic faces, where n is the number of directions in which edges occur.  Simple instances include the cube (n=3) and Kepler's rhombic dodecahedron (n=4); both of these exist in nature as crystals.  For any n >= 3, an infinite variety of polar zonohedra may be constructed, ranging from oblate, squashed forms, to prolate, spindle-like forms; the determining parameter is the angle between edges and a plane orthogonal to the polar zonohedron's symmetry axis, which I call "pitch," 0<=pitch<=90 degrees.  Curiously, when pitch equals arc tan .5^.5 or 35.2643+ degrees, a polar zonohedron is an isometric, orthogonal "shadow" of an n-cube (See §13 of H.S.M. Coxeter's Regular Polytopes, Dover, 1973).

(*A polar projection, and two equatorial projections,
of n=12 polar zonohedra.*)
Show[PolarZonohedron[12,35.2643],
PlotLabel->"n=12, pitch=35.2643",
ViewPoint->{0,0,3}];
Show[PolarZonohedron[12,15],
PlotLabel->"n=12, pitch=15",
ViewPoint->{0,-3,0}];
Show[PolarZonohedron[12,60],
PlotLabel->"n=12, pitch=60",
ViewPoint->{0,-3,0}];

We distinguish "shadows" from "projections" as follows:  a shadow is simply the boundary of a projection, with its interior.

Polar zonohedra have cyclic symmetry, and the axis of cyclic symmetry connects the two "poles."  A rotation of 360/n degrees carries the polar zonohedron into itself.  At each of the two poles, n edges and n equal rhombs meet at a single vertex.  Polar zonohedra also have central symmetry, so that every vertex, every edge, and every rhombic face has a counter-vertex, counter-edge, and counter-face, diametrically opposed on the opposite side of the zonohedron.  Fixing our attention upon any edge, we find that it is one of a "zone" of 2*(n-1) parallel edges, making a circuit around the zonohedron.

Polar zonohedra are said to be "determined" by a set of n vectors of equal magnitude, disposed like evenly-spaced generators of a right cone.  A rotation of 360/n degrees around the axis of the cone carries the vectors into themselves.

(*The determining vectors for an n=12, pitch=45
polar zonohedron.*)
Show[Graphics3D[Map[Line[{{0,0,0},#}]&,vectors[12,45]]]];

Any polar zonohedron may be dissected into the "tetrahedral" number, n things taken 3 at a time, of rhombic hexahedra.  In Mathematica we express this as Binomial[ n, 3].  When n is even moderately large, not only do a large number of hexahedra exist, of a variety of types, but the polar zonohedron may be dissected in a large number of different ways.  When n is a multiple of 3, n/3 of the hexahedra are in fact cubes.

As per above, a polar zonohedron of 35.2643+ degrees pitch is an orthogonal and isometric shadow of an n-cube; if dissected into hexahedra in every possible way, it is a projection.  The hexahedra themselves are foreshortened images of 3-cubes in the n-cube.  Suppose, however, that rather than being dissected in "every possible way," a polar zonohedron of 35.2643+ degrees pitch is dissected in only one particular way; any way, but only one.  In this case, I propose that it represents an isometric, orthogonal projection with hidden detail removed.

Whether or not that conjecture is in fact the case, this notebook presents one method of dissecting polar zonohedra into hexahedra.  It might be called the "shells of translation" method.  Tetrahedral numbers may be thought of as sums of triangular numbers, which in turn are sums of integers.  These "shells" form sets of 1, 3, 6, 10, ..., Binomial[ n-1, 2] hexahedra, which fit perfectly together to compose the entire zonohedron.

This dissection is perhaps the simplest which can be devised.  It treats the polar zonohedra as "solids of translation," that is, they are "traced out" by a series of just n translations.  These translations are in the directions of the n vectors which determine the zonohedron, taken in cyclic order.  The first translation makes an edge, the second a rhomb, the third a hexahedron, the fourth a dodecahedron, the fifth an icosahedron, and the nth translation makes the polar zonohedron itself.  Beginning with the first hexahedron, all the intermediate forms are themselves convex zonohedra, and if determined by k of the n vectors, are bounded by k*(k-1) rhombs.  The (k+1)th translation adds a shell of (k*(k-1))/2 new hexahedra to those which already exist.  Thus the hexahedra arise in sets triangular in number.

In my method the vectors are taken in cyclic order.  However, the hexahedra are created in reverse, as it were.  For instance, in an n=5 polar zonohedron, a rhombic icosahedron, instead of arising in the sequence {hexahedron, dodecahedron, icosahedron}, they arise as {icosahedron, dodecahedron, hexahedron}.  Several functions are brought to bear upon the problem:

1.  vectors[ n_Integer, pitch] creates n vectors of equal magnitude, of the specified pitch, measured between the vectors and the xy plane.
2.  quad[x_, ref_] takes a list of two vectors and makes a rhomb, placing a "mark" at one vertex to begin the next rhomb at.
3.  trans[poly_, x_] takes a polygon as first argument, and applies a vector to it, creating a hexahedron bounded by six rhombs, wrapped in Graphics3D.

The algorithms below are far from "robust."  The procedure is somewhat as follows:  define n and pitch, and create a connected sheet of rhombic faces which form the exterior faces of the largest shell of hexahedra.  Apply the trans function to these, creating the first, largest shell.

Then, with this first shell, discover its "interior" or concave faces, which are the convex faces of the next shell smaller.  Repeat until a single hexahedron is constructed.

Various examples are set forward.  A method of exploding the hexahedra outward from the center of the zonohedron is demonstrated.  While viewing such figures from this or that ViewPoint I recognized certain symmetries which were quite a surprise, considering the nature of the shells.  These symmetries are perhaps most visible in the "Explode the hexahedra away from the origin" example, when ViewPoint is directly above the z axis, at, say, {0,0,3}.  I was taken entirely surprised by the helical rings of hexahedra which appear in the "northeast" quadrant of the figure.  This is most evident when n is large, at least 12, perhaps 20.  However, a lot of hexahedra are involved; Binomial[20, 3] is 1140!   I am still not even convinced that these "symmetries" exist; perhaps some mistake in the way I translate the hexahedra has imparted a spurious symmetry.

Initialization

(*Polar zonohedra as surfaces of polygons.*)
PolarZonohedron[n_Integer,pitch_]:=
Block[{v=vectors[n,pitch],h=((Plus @@ vectors[n,pitch])[[3]])/2, q},
	q=Table[mark={0,0,-h};
		Table[quad[{v[[j]],v[[1+Mod[i+j-1,n]]]},mark],{i,n-1}],{j,n}];
	Graphics3D[ Polygon /@ Flatten[q ,1] ]
]

(*These functions needed for hexahedral shells*)
vectors[n_Integer,pitch_]:=
Table[
	N[{Cos[Degree pitch] Cos[2Pi i/n],
	Cos[Degree pitch] Sin[2Pi i/n],
	-Sin[Degree pitch]}],
	{i,0,n-1}]
	
quad[x_,ref_]:={ref, ref+x[[1]], ref+x[[1]]+x[[2]], mark=ref+x[[2]]}
	
(*Accepts a rhomb and a vector as input, creates a hexahedron.*)
trans[poly_,x_]:=Block[
{a=poly[[1]],b=poly[[2]],c=poly[[3]],d=poly[[4]]},
Graphics3D[{
Polygon[poly],
Polygon[{a,a+x,b+x,b}],
Polygon[{b,b+x,c+x,c}],
Polygon[{c,c+x,d+x,d}],
Polygon[{d,d+x,a+x,a}],
Polygon[{d+x,c+x,b+x,a+x}]
}]
]

Needs["Graphics`Shapes`"]

mag[v_] := Sqrt[Plus@@(v^2)]
unit[v_] := v/mag[v]
cross[ {ax_, ay_, az_}, {bx_, by_, bz_} ] :=
	{ay bz - az by, az bx - ax bz, ax by - ay bx}
surfnorm[f_List] := unit[cross[ f[[2]] - f[[1]], f[[3]] - f[[2]] ]]

Procedures and Examples

The initial "template" of rhombic faces

(*Here we create and Show the faces of the outside
of the largest shell, as a point of beginning*)
n=7;
pitch=35.2643;
v=vectors[n,pitch];
h=((Plus @@ vectors[n,pitch])[[3]])/2;
k=n-1;
q=Table[mark={0,0,-h};
	Table[quad[{v[[j]],v[[1+Mod[i+j-1,n]]]},mark],{i,k-j}],{j,k}];
zaq=Graphics3D[ Polygon /@ Flatten[q ,1] ];
Show[zaq,
ViewPoint->{0,0,-3}];

Construct a polar zonohedron with Binomial[n, 3] hexahedra

The "zohexatope" function accepts two arguments, "n" and "pitch," and, as, above, creates a "template" of rhombic faces, and applies the "trans" function to them.  From this largest "shell" of hexahedra, the smaller ones are constructed in turn.  The set of shells is called "shellarray," and forms a list of n-2 lists of hexahedra, with {Binomial[n-1,2], Binomial[n-2,2], ... , Binomial[2,2]} in the sub-lists.  The variable "shellarray" is left global for use in the examples below.

zohexatope[n_Integer,pitch_]:=
Block[{v=vectors[n,pitch],h=((Plus @@ vectors[n,pitch])[[3]])/2,
k,q,zaq,taq},
k=n-1;
q=Table[mark={0,0,-h};
		Table[quad[{v[[j]],v[[1+Mod[i+j-1,n]]]},mark],{i,k-j}],{j,k}];
zaq=Graphics3D[ Polygon /@ Flatten[q ,1] ];

taq=q=Map[trans[#,v[[n]]]&,Level[zaq,{-3}]];
shellarray=Prepend[
	Table[q=Map[trans[#,v[[n-j]]]&,
		Table[Last[Level[q[[i]],{-3}]],{i,j,Binomial[j,2]}]],
		{j,n-1,3,-1}],
	taq]
]

Show[zohexatope[7,35.2643],
Axes->True,
ViewPoint->{0,-1.5,3}];

Show the shells, separated slightly

q=Table[
	TranslateShape[shellarray[[i]], -3*v[[ 1+Mod[i-1, n] ]] ],
	{i,Length[shellarray],1,-1}];
Show[q,
Boxed->False,
Background->GrayLevel[0],
ViewPoint->{0, -2, -2}];

Explode the hexahedra away from the origin

zaq=Flatten[shellarray];
q=Table[
	TranslateShape[zaq[[i]], 4*(Plus @@ Level[zaq[[i]],{-2}]/24) ],
	{i,Length[zaq]}];
Show[q,
Boxed->False,
Background->GrayLevel[0],
ViewPoint->{0, 0, 3}];

(*Flatten the array of Graphics3D objects into a list of
polygons, re-wrap under one Head; for export to POV-Ray.*)
explosion=Graphics3D[ Polygon /@ Level[q,{-3}]];

Select and Show only certain hexahedra

(*Select and Show those hexahedra less than or greater than
some distance from the center.*)
zaq=Flatten[shellarray];
b=Table[mag[Plus @@ Level[zaq[[i]],{-2}]/24],{i,Length[zaq]}];
c=Flatten[Position[b,x_ /; x<2.5]];(*set distance and inequality here.*)

Show[d=Table[zaq[[c[[i]]]],{i,Length[c]}],
ViewPoint->{0,-.5,3}];

Animation Examples

Techniques

The animation technique used here embeds Show in a Do loop.  ViewPoint remains fixed, and PlotRange is specified to hold the Graphics3D objects fixed in size.  Since the Graphics:Shapes package was read in in the initialization cell, the functions TranslateShape and RotateShape are available.

The most important action required by the user, is to display only one frame of the animation at first, and then manually crop and resize that frame.  The Do iterator may then be set to its end value, and the entire sequence of frames created.  This first frame acts as a "template" for all subsequent frames.  In animations of shell separation and explosion, this first template frame shows the figure in its most widely separated condition; thus, the frame may be cropped fairly closely.  PlotRange is left large, and depending upon how large n is, may need to be set larger.

When displaying a multitude of relatively small objects (such as rhombic hexahedra, or the faces of a complex polyhedron), I often prefer to turn off the display of edges (in the Graph menu), so that only the shaded polygons remain.  If this is done for the template frame, it will apply to all subsequent frames.

Shell Separation

(*Do iterator is left equal for cropping of initial frame.*)
a=5;(*Set PlotRange variable.*)
Do[
q=Table[
	TranslateShape[shellarray[[i]], -Abs[k]*v[[ 1+Mod[i-1, n] ]] ],
	{i,Length[shellarray],1,-1}];
Show[q,
PlotRange->{{-a,a},{-a,a},{-a,a}},
Boxed->False,
Background->GrayLevel[0],
ViewPoint->{0, -2, -2}],
{k,-2,-2(*1.9*),.1}];

Rotate Exploded Hexahedra around z axis

(*Do iterator is left equal for cropping of initial frame.*)
a=12;(*Set PlotRange variable.*)
zaq=Flatten[shellarray];
Do[
q=Table[
	TranslateShape[zaq[[i]], 3*(Plus @@ Level[zaq[[i]],{-2}]/24) ],
	{i,Length[zaq]}];
Show[RotateShape[q,Degree k,0,0],
Boxed->False,
Background->GrayLevel[0],
PlotRange->{{-a,a},{-a,a},{-a,a}},
ViewPoint->{0,-.5,3}],
{k,0,0(*356*),4}](*Caution:  90 frames require lots of RAM!*)

Looping Explosion of Hexahedra

(*Do iterator is left equal for cropping of initial frame.*)
a=12;
zaq=Flatten[shellarray];
Do[
q=Table[
	TranslateShape[zaq[[i]], Abs[k]*(Plus @@ Level[zaq[[i]],{-2}]/24) ],
	{i,Length[zaq]}];
Show[q,
Boxed->False,
Background->GrayLevel[0],
PlotRange->{{-a,a},{-a,a},{-a,a}},
ViewPoint->{0,-.5,3}],
{k,-2,-2(*1.9*),.1}]