Rhombic Helicoids

by
Russell Towle
rustybel@foothill.net
March, 2000

The helicoid is the only ruled minimal surface, other than the plane. Its boundary is a helix. It is “minimal” because of all surfaces bounded by a given helix, the helicoid has least area. It seems that the helicoid surface was discovered by Meusnier in 1776. See Eric Weisstein's MathWorld at http://mathworld.wolfram.com/MinimalSurface.html.

The nHelicoid function accepts six arguments, of which the most important are n and pitch, where n dictates the fineness of the mesh of rhombs, while pitch determines the pitch or slope of the helicoid, 0<pitch<90 degrees. Additional arguments are factor, ratio, ilim, and jlim. The examples below illustrate the roles of these variables in the nHelicoid function.

Code

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,factor_:1,ratio_:1]:=
vectors[n, pitch, factor, ratio]
	
quad[x_,ref_]:={ref, ref+x[[1]], ref+x[[1]]+x[[2]], mark=ref+x[[2]]}

nHelicoid[n_Integer, pitch_, factor_, ratio_, ilim_, jlim_]:=
Block[{v=vectors[n,pitch,factor,ratio],h=1.5*(Plus @@ vectors[n,pitch,factor,ratio]),q},
	mark=-h;
	q=Table[
		a=Table[quad[{v[[ 1+Mod[j-1,n] ]],v[[ 1+Mod[i+j-1,n] ]]},mark],{i,ilim}];
		mark=First[a][[3]];(*Print["mark=",mark];*)a,
		{j,jlim}];
	Graphics3D[ Polygon /@ Cases[q ,{{_,_,_}..},Infinity] ]
]

nHelicoid[n_:12,pitch_:35.2643,factor_:1,ratio_:1, ilim_:11, jlim_:12]:=
nHelicoid[n, pitch, factor, ratio, ilim, jlim]

mag[v_]:=Sqrt[v.v](*magnitude of vector 'v'*)

unit[v_]:=v/mag[v](*unit vector in direction of 'v'*)

cent[v_List]:=Plus@@v/Length[v](*centroid of point list*)

mycross[ {ax_, ay_, az_}, {bx_, by_, bz_} ] :=
	{ay bz - az by, az bx - ax bz, ax by - ay bx}(*cross product*)

tosegs[gon_]:=Transpose[ {gon, RotateLeft[gon]} ](*polygon to edges*)

(*area of parallelogram*)
sz[f_List] := mag[mycross[ f[[2]] - f[[1]], f[[3]] - f[[2]] ]]

(* treat 4gons specially for efficiency *)
totalarea[v_List] /; Length[v] == 4 :=
	sz[v]

(* treat triangles specially for efficiency *)
totalarea[v_List] /; Length[v] == 3 :=
	sz[v]/2
	
(* general case: use polygon center as additional vertex *)
totalarea[v_List] :=
    Module[{bary = cent[v], circ, t},
        circ = tosegs[v];
        t=Apply[ {#1, #2, bary}&, circ, {1} ];
        Sum[sz[t[[i]]]/2,{i,Length[t]}]
    ]

(*break Graphics3D down into Headless polygons*)
parse[poly_] := Cases[Level[poly,{-3}],{{_,_,_}..}]

colorSort[poly_]:=(*~30* faster than old version*)
Block[{q1,q2,p},
p=parse[poly];
q1=Table[{p[[i]],totalarea[ p[[i]] ] },{i,Length[p]}];
q2=Split[Sort[q1,#1[[2]]<#2[[2]]&],
TrueQ[(Abs[#1[[2]]-#2[[2]]]<.0001)]&];
Print["You will need at least ",Length[q2],
" colors in the colorlist below."];(*how many colors?*)
Table[Cases[q2[[i]],{{_,_,_}..},Infinity],{i,Length[q2]}]
]

trans[shape_, vec_List] :=
Block[{t = N[vec]},
 shape /. {
  poly:Polygon[_] :> Map[(t + #)&, poly, {2}],
  ln:Line[_]    :> Map[(t + #)&, ln, {2}],
  pt:Point[_]  :> Map[(t + #)&, pt,{1}] }
    ]

vunion::usage = "vunion[v] returns the union of a list of n-vectors.";

vunion[v_]:=
Union[Chop[v],
SameTest->((Sign[#1]==Sign[#2]) && (Chop[#1-#2]==Table[0,{Length[v[[1]]]}]) &)]

Examples

A somewhat coarse mesh of rhombs (n=12) is used to compare low, medium, and high pitch angles. Since 12 is the default for n, the last four arguments to the nHelicoid function are not needed.

(*low pitch: 10 degrees*)
n=12;
Show[nHelicoid[n, 10],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-2,0}]];

(*medium pitch: 35 degrees*)
Show[nHelicoid[n, 35],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-2,0}]];

(*high pitch: 60 degrees*)
Show[nHelicoid[n, 60],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-2,0}]];

The third and fourth arguments, factor and ratio, are set by default to unity. Every factor-th of the n unit vectors is multiplied by ratio.

(*every 4th vector multiplied by 3*)
n=24;
Show[nHelicoid[n, 35, 4, 3, n-1, n],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-1,2}]];

(*every other vector multiplied by 3: lattice-like*)
n=24;
Show[nHelicoid[n, 35, 2, 3, n-1, n],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-1,1}]];

The fifth and sixth arguments, ilim and jlim, are set by default to n-1 and n. These limit the loops in which the helicoid surface is developed.

(*lengthen helicoid*)
n=24;
Show[nHelicoid[n, 35, 1, 1, n-1, 3n],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-1,2}]];

(*shorten helicoid*)
n=24;
Show[nHelicoid[n, 35, 1, 1, n-1, 12],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-1,2}]];

Here, we chop the helicoid so that it is confined within a range of z coordinates.

(*before chopping*)
n=24;
Show[a=nHelicoid[n, 35, 1, 1, n-1, n],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-1,0}]];

(*chop and display*)
allpoly=Cases[a,Polygon[x_]:>x,Infinity];
subpoly=Select[allpoly, Abs[Max[Map[#[[3]]&, #]]]<14&];
Show[Graphics3D[Polygon/@subpoly],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-1,0}]];

Here, we translate the helicoid so that it is centered upon the origin.

(*not centered*)
n=12;
Show[a=nHelicoid[n, 35, 1, 1, n-1, n],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,0,1}]];

v=vunion[ Flatten[ Cases[a,Polygon[x_]:>x,Infinity], 1 ] ];
c=Plus@@v/Length[v];
Show[trans[a,-c],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,0,1}]];

Colored Helicoids

The structure of the rhombic mesh is revealed if one colors the rhombs acording to surface area. This is done using the colorSort function. A list of random colors is then constructed, and the colored helicoid displayed.

(*every other vector multiplied by 3: lattice-like*)
n=36;
Show[a=nHelicoid[n, 35, 2, 3, n-1, n],
Axes->True,
Boxed->True,
ViewPoint->2.75*unit[{0,-1,1}]];

(*split the polygons into lists according to area*)
s=colorSort[a];

(*create a list of random colors of the proper length.*)
colorlist=Table[RGBColor[Random[Real,{0,1}],
		Random[Real,{0,1}],
		Random[Real,{0,1}]],{Length[s]}];

(*apply SurfaceColor specs to the polygon lists*)
xaq=Graphics3D[
{EdgeForm[],
	Table[ {SurfaceColor[colorlist[[i]],GrayLevel[1], 5 ],
		Polygon /@ s[[ i ]]}, {i,Length[s]}]
}];

(*display*)	
Show[xaq,
LightSources -> 
   {
   {{-1,3,0}, RGBColor[.5, .5, .5]},
   {{1,-1,2}, RGBColor[.75, .75, .75]}
   },
Boxed->False,
AmbientLight->GrayLevel[.25],
Background->GrayLevel[0],
ViewPoint->2.25*unit[ {0,-1, 2} ] ];