Elect, Bead, & Star
Zonohedra

by
Russell Towle
March, 1998
rustybel@foothill.net

Discussion

Several forms related to the polar zonohedra are presented, some previously undiscovered. A polar zonohedron is a convex polyhedron bounded by rhombs with an axis of n-fold symmetry, n>=3. Evaluate the initialization cells and have a look:

Do[
	Show[PolarZonohedron[n,35.2643],
	ViewPoint->{0,-1,2}],
{n,3,7}]

The PolarZonohedron function accepts four arguments:
1. n, default, 12.
2. pitch, 0<pitch<90 degrees, default, 35.2643.
3. factor, an integer factor of n, 1<=factor<=n, default, 1.
4. ratio, a real number by which every factor-th vector is multiplied, default, 1.

A true polar zonohedron will always have factor=1 and ratio=1.

A polar zonohedron is a solid orthogonal shadow of an n-cube, when pitch=ArcTan[Sqrt[1/2]]. To see the effect of the pitch parameter, evaluate the following cell. The resulting series of images may be viewed as an animation.

Do[
	Show[PolarZonohedron[9,k],
	PlotRange->{{-4,4},{-4,4},{-5,5}},
	ViewPoint->{0,-3,0}],
{k,5,85,5}]

The related forms are:

1. ElectZonohedron. The zonohedron determined by a subset of the n vectors which determine a polar zonohedron, presented as a list of indices in ascending order. See example below.

2. BeadZonohedra. If an integer k is a factor of n, create a string of k-fold polar zonohedra disposed along the symmetry axis of the n-fold polar zonohedron. See examples below.

3. StarZonohedron. Use the same n vectors as would determine a polar zonohedron, but use a “jump” index. If the jump index does not divide n evenly, then a non-convex rhombic “sceptre” zonohedron results; if the jump index does divide n evenly, then a set of BeadZonohedra result. This is analogous to forming star polygons and compunds of convex polygons, from the vertices of a convex regular polygon. For instance, from an octagon we can form the true star polygon {8/3}, with a jump of 3; but a jump of 2 leads to a compound of two squares. See examples below. Note: it is usual to confine the term “zonohedron” to convex polyhedra bounded by centrally-symmetrical polygons. Thus the term “star zonohedron” is a bit of a misnomer.

Initialization

vectors[n_Integer,pitch_,factor_Integer,ratio_]:=
Block[{e},
Table[If[Mod[i,factor]==0,e=ratio,e=1];
	N[{e Cos[Degree pitch] Cos[2Pi i/n],
	e Cos[Degree pitch] Sin[2Pi i/n],
	e Sin[Degree pitch]}],
	{i,0,n-1}]]

vectors[n_:12,pitch_:35.2643,fact_:1,ratio_:1]:=
vectors[n, pitch, fact, ratio]
	
quad[x_,ref_]:={ref, ref+x[[1]], ref+x[[1]]+x[[2]], mark=ref+x[[2]]}

ElectZonohedron[n_Integer,pitch_,factor_Integer,ratio_,elect_List]:=
Block[{z=vectors[n,pitch,factor,ratio],w=Length[elect],q},
v=Table[z[[ elect[[i]] ]],{i,Length[elect]}];
h=((Plus @@ v))/2;

q=Table[mark=-h;
		Table[quad[{v[[j]],v[[1+Mod[i+j-1,w]]]},mark],{i,w-1}],{j,w}];
	Graphics3D[ Polygon /@ Flatten[q ,1] ]
]

PolarZonohedron[n_Integer,pitch_,factor_Integer,ratio_]:=
Block[{v=vectors[n,pitch,factor,ratio],h=(Plus @@ vectors[n,pitch,factor,ratio])/2, q},
	q=Table[mark=-h;
		Table[quad[{v[[j]],v[[1+Mod[i+j-1,n]]]},mark],{i,n-1}],{j,n}];
	Graphics3D[ Polygon /@ Flatten[q ,1] ]
]

PolarZonohedron[n_:12,pitch_:35.2643,fact_:1,ratio_:1]:=
PolarZonohedron[n, pitch, fact, ratio]

BeadZonohedra[n_Integer,pitch_,divis_Integer]:=
Block[{z=vectors[n,pitch],q,a,b,h,v,w},
a=n/divis;
b=Table[Table[1+Mod[i+(j*a)-1,n],{j,0,divis-1}],{i,a}];
h=Plus @@ z;
q=Table[
w=Length[ b[[k]] ];
v=Table[z[[ b[[k]][[i]] ]],{i,w}];
	Table[mark=(h/2)-(Plus @@ v)*(k);
		Table[quad[{v[[j]],v[[1+Mod[i+j-1,w]]]},mark],{i,w-1}],{j,w}],
		{k,a}];
		
	Graphics3D[ Polygon /@ Flatten[q ,2] ]
]

tors[n_Integer,pitch_, f_Integer]:=
Block[{e},Table[
	N[{Cos[Degree pitch] Cos[2Pi i/n],
	Cos[Degree pitch] Sin[2Pi i/n],
	-Sin[Degree pitch]}],
	{i,0,f*n-1,f}]]

StarZonohedron[n_Integer,pitch_,factor_Integer]:=
Block[{v=tors[n,pitch,factor],h=((Plus @@ tors[n,pitch,factor])[[3]])/2, q},
If[Mod[n,factor]==0,BeadZonohedra[n,pitch,(n/factor)],
	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] ]]
]

(*from Skiena's Combinatorica package*)
KSubsets[l_List,0] := { {} }
KSubsets[l_List,1] := Partition[l,1]
KSubsets[l_List,k_Integer?Positive] := {l} /; (k == Length[l])
KSubsets[l_List,k_Integer?Positive] := {}  /; (k > Length[l])

KSubsets[l_List,k_Integer?Positive] :=
	Join[
		Map[(Prepend[#,First[l]])&, KSubsets[Rest[l],k-1]],
		KSubsets[Rest[l],k]
	]

ElectZonohedron Examples

Elect zonohedra are determined by subsets of three or more of the n vectors which determine a polar zonohedron. The indices must be given in ascending order.

Show[ElectZonohedron[12,35.2643,1,1,{2,4,7,11}],
ViewPoint->{0,0,3},
Axes->True,
Boxed->True];

Show[ElectZonohedron[12,35.2643,1,1,{1,2,4,5,7,8,10,11}],
ViewPoint->{0,0,3},
Axes->True,
Boxed->True];

Suppose we wish to examine all possible rhombic dodecahedra which can arise from subsets of the vectors determining a polar 8-zonohedron. Any of these might arise during a dissection of the polar 8-zonohedron. We can use Steven Skiena’s KSubsets function to find the indices into the twelve vectors, as follows.

dodeca=KSubsets[Range[6],4]

Do[
Show[ElectZonohedron[6, 35.2643, 1, 1, dodeca[[k]] ],
ViewPoint->{0,0,3},
Axes->True,
Boxed->True],
{k, Length[dodeca]}];

I invite anyone interested to supply a method, to extract from the k-subset-zonohedra associated with a given polar zonohedron, a list of the topologically distinct k-subset zonohedra. For instance, in the example above, the dodecahedra {1,2,3,4}, {2,3,4,5}, {3,4,5,6}, {1,4,5,6}, {1,2,5,6} and {1,2,3,6} are equivalent.

BeadZonohedra Examples

Bead zonohedra illustrate one tiny portion of the puzzle presented by the dissection of zonohedra into smaller zonohedra; a set of bead zonohedra, strung along the symmetry axis of a polar zonohedron, represent the beginnings of a dissection.

Show[BeadZonohedra[12,35.2643,3],
Axes->True,
ViewPoint->{0,-3,0}];

n=12;
d=Select[Divisors[n],#>2 && #<n&];
Do[
Show[BeadZonohedra[n, 35.2643, d[[k]] ],
Axes->True,
ViewPoint->{0,-3,0}],
{k,Length[d]}];

n=24;
a=BeadZonohedra[n,35.2643,4];
b=PolarZonohedron[n,35.2643,1,1];
pr=7.5;

Show[{a,b},
PlotRange->{{-pr,pr},{pr,-1.75},{pr,-pr}},
ViewPoint->{0,-3,0}];

StarZonohedron Examples

Because Mathematica's 3D rendering engine has problems handling intersecting polygons, caution should be exercised, and n should be held less than 10. If RealTime3D is used, this limit may be ignored.

Admissible n and k (jump) numbers, within the above limit, are {5,2}, {7,2}, {7,3}, {8,3}, {9,2}, and {9,4}.

(*a true star zonohedron, with n=5, k=2*)
Show[StarZonohedron[5,35.2643,2],
Axes->True,
ViewPoint->{0,0,3}];
Show[StarZonohedron[5,35.2643,2],
Axes->True,
ViewPoint->{0,-3,0}];

(*a compound of zonohedra, with n=6, k=2*)
Show[StarZonohedron[6,35.2643,2],
Axes->True,
ViewPoint->{0,0,3}];
Show[StarZonohedron[6,35.2643,2],
Axes->True,
ViewPoint->{0,-3,0}];