(*^
::[ Information =
"This is a Mathematica Notebook file. It contains ASCII text, and can be
transferred by email, ftp, or other text-file transfer utility. It should
be read or edited using a copy of Mathematica or MathReader. If you
received this as email, use your mail application or copy/paste to save
everything from the line containing (*^ down to the line containing ^*)
into a plain text file. On some systems you may have to give the file a
name ending with ".ma" to allow Mathematica to recognize it as a Notebook.
The line below identifies what version of Mathematica created this file,
but it can be opened using any other version as well.";
FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2";
MacintoshStandardFontEncoding;
fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8, 24, "Times";
fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "Times";
fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6, 14, "Times";
fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 18, "Times";
fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 14, "Times";
fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 12, "Times";
fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times";
fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L-5, 12, "Courier";
fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier";
fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, L-5, 12, "Courier";
fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier";
fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, L-5, 12, "Courier";
fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, "Courier";
fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 10, "Geneva";
fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = leftheader, inactive, L2, 12, "Times";
fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 12, "Times";
fontset = leftfooter, inactive, L2, 12, "Times";
fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times";
fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
paletteColors = 128; automaticGrouping; currentKernel;
]
:[font = title; inactive; preserveAspect; startGroup]
Rhombic Spirallohedra
:[font = subtitle; inactive; preserveAspect]
Some new classes of non-convex zonohedra
:[font = subsubtitle; inactive; preserveAspect]
by
Russell Towle
April, 1997
rustybel@foothill.net
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Discussion
:[font = text; inactive; preserveAspect]
Rhombic Spirallohedra
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).
;[s]
23:0,1;21,0;23,2;54,3;55,2;57,3;60,2;83,3;84,2;171,3;172,2;211,3;212,2;269,3;270,2;536,3;541,2;547,3;552,2;583,3;588,2;729,4;746,2;762,-1;
5:1,13,9,Times,0,12,0,0,0;1,21,15,Times,3,20,0,0,0;11,16,12,Times,0,14,0,0,0;9,16,12,Times,1,14,0,0,0;1,16,12,Times,2,14,0,0,0;
:[font = input; preserveAspect]
(*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],(*oblate*)
PlotLabel->"n=12, pitch=15",
ViewPoint->{0,-3,0}];
Show[PolarZonohedron[12,60],(*prolate*)
PlotLabel->"n=12, pitch=60",
ViewPoint->{0,-3,0}];
:[font = text; inactive; preserveAspect]
The "rhombic spirallohedra" constructed in this notebook were discovered accidentally, while attempting to develop a function which created a rhombic hexahedron from a triple of vectors. Eventually, more types of spirallohedra were recognized, and the common elements in their construction were fused to make a Spirallohedron function. The function is by no means "robust," for it may only be applied to n>=6, and n not prime.
The complete syntax for the Spirallohedron function is
Spirallohedron[n, pitch, klim], where
1. n is the (integer) number of directions in which edges occur.
2. pitch is the angle, in degrees (0<= pitch <= 90), between edges and a plane orthogonal to the symmetry axis.
3. klim is an integer such that (n / klim) >= 3, and Mod[ n, klim] == 0.
Some of the forms below (when n is even and klim equals 2) are what result if, in a polar zonohedron, a shell of rhombic hexahedra is created such that only those hexahedra are made which share exterior faces of the polar zonohedron, and then this shell is removed, to reveal a "hidden" zonohedron. The routine fails for odd n and when n=4 (no "hidden" zonohedron exists). Perhaps the most striking forms arise when n/klim equals 3; I call these "cubic spirallohedra."
;[s]
35:0,1;312,2;326,1;406,2;407,1;416,2;417,1;458,2;472,1;496,2;526,1;550,2;551,1;616,2;621,1;652,2;657,1;729,2;733,1;759,2;760,1;763,2;767,1;779,2;792,1;830,2;831,1;844,2;848,1;1126,2;1127,1;1137,2;1138,1;1218,2;1224,1;1271,-1;
3:0,13,9,Times,0,12,0,0,0;18,16,12,Times,0,14,0,0,0;17,16,12,Times,1,14,0,0,0;
:[font = input; preserveAspect]
Show[Spirallohedron[21,35.2643,7],
Boxed->False,
ViewPoint->{0,0,3}];
:[font = text; inactive; preserveAspect; endGroup]
Quite a variety of other non-convex zonohedra can be made by choosing other values for klim. In fact, these other forms arose during the attempt to iterate methods used to construct the "hidden" zonohedron described above. The iterated routine is a table of tables of tables, with complicated and opaque constraints applied to the loops. Within these tables the quad function is invoked, which creates a rhomb from a list of two vectors. The (unit) vectors are created in the vectors function, which accepts two arguments, n and pitch. All the non-convex zonohedra ("spirallohedra") created represent types of "hidden" zonohedra which can arise by taking away certain sets of rhombic hexahedra from a polar zonohedron. They are bounded by n*(n-klim) rhombic faces.
Two constraints must be met: klim must divide n without remainder, and (n / klim) must be greater than or equal to 3. Hence n>=6, and n not prime. A method to discover all possible values for klim is as follows:
a=Table[{i,Mod[n,i]},{i,2,(n/2)-1}];
b=Select[a,#[[2]]==0&];
j=Transpose[b][[1]];(*the list of klims*)
This method is used in the Examples to create all the spirallohedra for n=24.
;[s]
33:0,1;87,2;91,1;365,2;369,1;480,2;487,1;527,2;528,1;533,2;538,1;745,2;755,1;802,2;806,1;819,2;820,1;845,2;846,1;849,2;853,1;898,2;899,1;908,2;909,1;967,2;971,1;988,3;1090,1;1119,2;1127,1;1164,2;1165,1;1170,-1;
4:0,13,9,Times,0,12,0,0,0;17,16,12,Times,0,14,0,0,0;15,16,12,Times,1,14,0,0,0;1,15,11,Courier,1,14,0,0,0;
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Initialization
:[font = input; initialization; preserveAspect; endGroup]
*)
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]]}
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] ]
]
Spirallohedron[n_Integer,pitch_,klim_Integer]:=
Block[{v=vectors[n,pitch],h=((Plus @@ vectors[n,pitch])[[3]])/2,q,t},
q=Table[Table[If[k==1,mark={0,0,-h},mark=({0,0,-h}+Sum[ v[[ 1+Mod[j+(t-2),n] ]],{t,k-1}])];
Table[quad[{v[[1+Mod[j+(k-2),n]]],v[[1+Mod[i+j+(k-2),n]]]},mark],
{i,klim-(k-1),n-k}],
{j,1,n-1,klim}],
{k,klim}];
Graphics3D[ Polygon /@ Flatten[q ,2] ]
]
(*
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Examples
:[font = input; preserveAspect]
(* n/klim = 6 *)
Show[Spirallohedron[12,35.2643,2],
Boxed->False,
ViewPoint->{0,0,3}];
:[font = input; preserveAspect]
(* n/klim = 3 *)
Show[Spirallohedron[21,35.2643,7],
Boxed->False,
Background->GrayLevel[0],
ViewPoint->{0,-.5,3}];
:[font = input; preserveAspect]
(* n/klim = 7 *)
Show[Spirallohedron[21,35.2643,3],
Boxed->True,
Axes->True,
ViewPoint->{0,0,3}];
:[font = input; preserveAspect; endGroup; endGroup]
(* The entire series of spirallohedra for specified n *)
(* Warning: n>=6 and n not prime!*)
n=24;
a=Table[{i,Mod[n,i]},{i,2,(n/2)-1}];
b=Select[a,#[[2]]==0&];
j=Transpose[b][[1]];(*the list of klims*)
Do[
Show[Spirallohedron[n,35.2643,j[[i]]],
Boxed->True,
Axes->True,
ViewPoint->{0,-1,3}],
{i,Length[j]}];
^*)