Zonogonal Tilings

by
Russell Towle
created in May 2000
version 2.3, February 27, 2005
rtowle@inreachcom

Preface

In the previous version of February 10, 2005, a new and expanded treatment of the classic Penrose tilings has been added, and problems with sign-patterns and offsets fixed. This version, of February 27, 2005, adds export of dragon designs to POV, and an improved function for taking the union of a set of edges.

Here you will find that an arrangement of lines leads to a zonogon tiled by smaller zonogons, or zonotile. A zonotile function was contrived, which accepts a list of lines as input. Terms will be defined in the Stars, Crosses, and Shadows subsection, below. To display the examples within this Preface, and throughout the notebook, you must first evaluate the “Initialization” section. One way to do so is to open the Kernel menu and, from the Evaluation sub-menu, choose Evaluate Initialization.

This notebook has evolved for years yet remains rough and unpolished. The guiding light has been experimentation, not cool and rational and mathematical exposition. In many ways, usually, an arrangement of lines may be resolved into subsets, which play varying roles in the derived tiling. Hence by all rights I should have designed functions for breaking sets into subsets, modifying and recombining them with transparent ease and dexterity. But I did not. Instead global variables are rampant, often with inscrutable names such as zaq and xaq, sometimes with evocative names like lns. Whenever I say to myself, “today I will clean up that code, make it right,” instead I find myself experimenting with tilings.

I hope you too will experiment.

Russell Towle, Dutch Flat, California, January, 2005.

A Personal Note

I confess at once, I am no mathematician. Nevertheless I have enjoyed a long struggle to understand zonohedra, a struggle which commenced around 1970. From the beginning, space-fillings and tilings by zonohedra and zonogons beckoned strongly. The famous Penrose tilings of the plane, using 36- and 72-degree rhombs, especially pleased me.

Living for many years without electricity, in a hexagonal mountain cabin, I developed a facility for drawing certain hidden-detail-removed projections of the polar zonohedra, in which regular polygons, of an even number of sides, are tiled by rhombs. Idle experimentation led to various schemes by which the same suite of rhombs within the projection, might be attached to the outside, building up larger and larger concentric 2n-gons. See Expansions of Polar Zonohedra in the Periodic and Quasi-Periodic Tilings section, below.

Simultaneously, a grappling with Professor H.S.M. Coxeter’s famous Regular Polytopes (Dover, 1973) revealed my beloved zonohedra to sometimes form orthogonal shadows of hypercubes, and my “expansions” to be related to close-packed arrays of hypercubes.

Years passed, and in the late 1980s, I gained access to a primitive computer, and wrote programs in BASIC which made these “expansions” of the polar zonohedra, using complicated nested loops.

In the middle 1990s I obtained Mathematica, and just so soon as possible, began trying to make Penrose tilings. I failed. Via the Internet, the outlines of the problem took shape. There were matching methods, substitution methods, a “generalized dual” or “multigrid” method, and a “generalized projection” method. The name of Nicolaas de Bruijn was often in view (see, among others, his Algebraic Theory of Penrose’s non-periodic tilings of the plane, Kon. Nederl. Akad. Wetensh., Proc. Ser. A 84, 1981).

I obtained some code implementing the generalized dual method, in the C programming language, and tried and failed to port it to Mathematica. So many hours, for nought. My greater interest was in the projection method, but no avenues opened to build upon someone else’s work. Starting from scratch led nowhere.

Finally, in 1999 I believe, I downloaded some PostScript code from the Internet. The file was named “multigrid.ps” and, sad to say, I can’t recall who wrote the thing. Wishing to credit the man, I searched again and again without ever finding the site from which it came. I think he was at a university in Europe. Thank you, sir.

By a rather fiendish process I ported the PostScript to Mathematica, and managed some small improvements along the way; my code returns a list of polygons, while the original gave only line segments.

Here, then, we have a version of the generalized dual, or multigrid, method. I can’t say I fully understand why it works, even to this day. In point of fact it does not always work, and the failures remain mostly a puzzle to me. How it does what it does will be considered below. Quite a wide variety of zonogons tiled by smaller zonogons will be met. For a time I called these things zonotiles, or 2D zonotiles. Perhaps it is better to call them plane zonotopal tilings. Or not: zonotile is one single word.

Stars, Crosses, and Shadows

A convex polygon with central symmetry is called a zonogon, and a convex polyhedron bounded entirely by zonogons is called a zonohedron. The generalization to space of n dimensions is a zonotope. An n-zonotope is bounded by (n-1)-dimensional zonotopes, in turn bounded by (n-2)-dimensional zonotopes, and so on. Only rarely are zonotopes regular, nor must they be equilateral. Almost all the tilings presented here are equilateral, and one loses little by this restriction, for every zonotope is isomorphic to an equilateral zonotope. A parallelogram is isomorphic to a rhomb, a parallelepiped to a rhombic hexahedron. Note that a square is a regular rhomb, a cube, a regular rhombic hexahedron. Hypercubes, or n-cubes, are especially simple and regular zonotopes.

Parallelism is an important attribute of zonotopes. Every edge, every zonogon, every zonohedron, has an equal and opposite counter-edge, counter-zonogon, counter-zonohedron, etc., similarly situated, and parallel. Take the tesseract, or 4-cube. It is bounded by eight 3-cubes, which occur in four parallel pairs. Every cube has an equal and opposite counter-cube.

At this point the reader might well wonder why an appeal is made to higher space, when the subject, after all, is plane tilings.

The answer is that zonotopes generally, and zonogons in particular, can be orthogonal shadows of hypercubes, cast into lower dimensions. The “shadow” of a convex polytope is the convex hull of its projection, with its interior. For instance, the regular 2n-gons, such as the square, regular hexagon, regular octagon, etc., are all zonogons, and all orthogonal plane shadows of n-cubes. The square we must count as the shadow of itself. The hexagon is an orthogonal shadow of a 3-cube, cast onto a plane perpendicular to any one of the cube’s long diagonals.

Now, hypercubes tile the n-space; it is natural to imagine that s-dimensional shadows of n-cubes might somehow tile the s-space. Here, s=2, and our s-zonotopes are zonogons, of an infinite variety, regular, irregular, always of 2k sides, where k is the number of independent vectors which determine some one tile. For now it is enough to remark upon the connection between zonogonal tilings and hypercubes.

We also look beyond Flatland because the “generalized dual” or “multigrid” method itself generalizes to higher space. From an arrangement of lines in the plane, and an arrangement of planes in three dimensions, the method generalizes to an arrangement of hyperplanes, of (n-1)-spaces in an n-space. One goes from tilings of zonogons, to tilings of zonohedra, to tilings of 4-polytopes bounded by zonohedra, and so on.

It is more than a curiosity that any regular 2n-gon can be dissected into the “triangular” number, n things taken two at a time, of rhombs (of the same edge length as the 2n-gon); that is, the square dissects into itself, the hexagon, into three rhombs, the octagon, into six rhombs, the decagon, into ten, the dodecagon, fifteen. Most usually, these dissections can occur in a large number of different ways, but in any case, the rhombs arise as orthogonal projections of squares bounding the n-cube.

Suppose we have n lines in general position, in the plane. “General position” means that no two lines are parallel, nor do any two coincide. Every line, then, intersects every other line. What is the number of intersection points? The triangular number of n things taken two at a time. Evaluate the cell below to see a sequence of triangular numbers.

Table[
Binomial[ n, 2],
{n,2,10}]

Now let’s look at some cyclically tiled 2n-gons. Be sure to have evaluated the Initialization section, first.

(*Display a series of rhombically tiled regular 2n-gons*)
arr=Partition[ Table[tiling[i],{i,2,7}], 3];
Show[GraphicsArray[arr]];

Parenthetically, and broadly speaking, every zonohedron can be dissected into the “tetrahedral” number, n things taken three at a time, of parallelepipeds. Quite a number of words would be needed to properly qualify this assertion. When a zonohedron is the orthogonal projection of a hypercube, the parallelepipeds arise as projections of 3-cubes bounding the hypercube.

Returning to the hexagonal shadow of a cube, cast onto a plane: suppose rather we make a wireframe projection, onto the same plane: we obtain the same hexagon, but it is filled with rhombs in two different ways. They appear to interpenetrate, appear to divide the hexagon into six equilateral triangles. Of course, in the cube, they do not interpenetrate. Wireframe projections can be confusing.

Now make the very same projection, but with hidden detail removed, as though the square faces of the cube were opaque. We obtain a hexagon neatly tiled by three equal rhombs.

One of the more abstruse questions bearing upon the tilings of zonogons by smaller zonogons, is whether a given tiling can or cannot arise as a hidden-detail-removed projection of a hypercube. I cannot speak to that. It is enough for now to remark that the tilings of zonogons by smaller zonogons are related to hidden-detail-removed projections of hypercubes and close-packed arrays of hypercubes.

A zonogon, zonohedron, or zonotope is said to be determined by a set of vectors which span the space. In an n-space, a set of n non-zero vectors is said to “span” the space if they do not all lie in an (n-1)-space. In the plane, this means that any two vectors which do not lie in the same line, span the 2-space. Before abandoning higher space and retreating to the safety of the plane, please consider the following construction of an n-cube, and its various shadows.

In space of n dimensions, we can have n mutually perpendicular vectors. Let all n of these be unit vectors, and add to these another n vectors, their opposites. We might obtain these 2n vectors from a Cartesian frame of coordinate axes, taking unit vectors in both directions, along each of the n axes. This cluster of perpendicular unit vectors is called a cross.

The orthogonal projection of a cross into a lower space is call a eutactic star. “Eutactic” means “well-ordered.” See Chapter 13 of H.S.M. Coxeter‘s Regular Polytopes, (Dover, 1973).

Select from the cross n perpendicular vectors, that is, from each pair formed by a vector and its opposite, choose one. Using these, we “trace out” the n-cube by a series of n translations along these chosen vectors, as follows.

A point, moved along the first vector, traces out a segment or 1-cube. The segment, moved along the second vector, traces out a square or 2-cube. The square, moved along the third vector, traces out a cube, or 3-cube; the cube traces out a tesseract, or 4-cube; and so on.

Note that every k-dimensional cube traces out a (k+1)-cube. When we move the incipient hypercube along a new vector, every existing vertex makes a new line segment, every segment, a new square, and so on.

Very well. Now consider the n-cross’s orthogonal projection into some lower space, say, an s-space. The vectors of the cross project into the vectors of the eutactic star, and are variously foreshortened. It is possible, for instance, that they are equally foreshortened; this is an “isometric” projection. Let this be the case, so that we will not be troubled by vectors which have foreshortened into points. So, while the n-cube is being traced out in the n-space, consider what happens in the s-space. A point traces out a segment, the segment, a rhomb, the rhomb, a projection of a 3-cube, that projection of a 3-cube traces out a projection of a 4-cube, and so on.

Consider the case where s=2, a plane, and now trace out orthogonal shadows instead of full-fledged projections: then the point traces out a segment, the segment, a rhomb, the rhomb, a hexagon, the hexagon, an octagon, the octagon, a decagon, and so on.

That is, a series of zonogons arises, each in turn the shadow of a square, 3-cube, 4-cube, 5-cube, and so on until at last, using the nth vector, an nth translation traces out a regular 2n-gon. Regular 2n-gons are orthogonal, isometric shadows of n-cubes.

It was noted above that the regular octagon is a plane shadow of a 4-cube. Projecting orthogonally and also isometrically, as before, in the 4-space the four perpendicular vectors trace out a segment, square, cube, and finally a tesseract or 4-cube. In the plane, the projections of those four vectors trace out a segment, rhomb (possibly a square), irregular hexagon, and finally, a regular octagon.

The essential idea here is that zonotopes and hypercubes alike are “traced out” by a set of vectors.

Not all zonotopes are shadows of hypercubes. Not all sets of vectors are eutactic stars. Any set of vectors at all, spanning an n-space, can be used to trace out an n-zonotope. In the plane, any two vectors not in the same line trace out a parallelogram, any three (no two in the same line) trace out a hexagon, any four (no two in the same line) trace out an octagon, any such five vectors, a decagon, any six, a dodecagon. If the vectors are of equal magnitude, these “2n-gons of translation” are equilateral. If the vectors are as symmetrically disposed as may be, these “2n-gons of translation” are regular.

It is quite a startling development, in Chapter 13 of Regular Polytopes, to find that the vectors from the center to the vertices of each and every regular polytope form isometric eutactic stars. Hence every regular polygon gives an isometric eutactic star. For instance, the five vectors from the center to the vertices of the regular pentagon, with their opposites, give an isometric eutactic star, the isometric projection into a plane of a 5-dimensional cross.

In almost every example of zonogons tiled by smaller zonogons in this notebook, we will use such symmetrically disposed vectors. We will use the vectors of isometric eutactic stars. We need not do so, but symmetry is appealing. We shall both exhibit and disguise these symmetries, enhance and disrupt them.

The Generalized Dual Method

I admit that, for my part, the zonotile function seems a mysterious machine. Exercising all due caution, one tips a barrel of lines into the hopper: there follows a whirring, a whistling, a clanking, a grinding of gears, and eventually, with a bit of luck, out pops a zonotile. I shall do my best to unveil the machine’s mysteries.

Duality

From an arrangement of lines, we obtain the tiling of a zonogon tiled by smaller zonogons. For simplicity, let us call such a tiling a “zonotile,” and admit the degenerate case when there is but one “tile,” a single zonogon.

Briefly, every point of intersection between lines corresponds to a tile, and every open region between lines corresponds to a vertex in the zonotile. Every individual segment cut out between lines, or infinite ray leading away from a point of intersection, corresponds to an edge in the zonotile.

That is, given an arrangement of lines, not all parallel, we distinguish 0-dimensional elements (points of intersection), 1-dimensional elements (segments or rays), and 2-dimensional elements (bounded or partially-bounded regions of the plane). To the 0-, 1-, and 2-dimensional elements of the line arrangement, correspond 2-, 1-, and 0-dimensional elements in the zonotile.

Hence the name, “generalized dual.” It is not quite the duality we are accustomed to, when we say that the dual of the Platonic Octahedron is the cube, or that the dual of a regular polygon is simply another similar regular polygon. It is a generalized duality.

Please consider the example below, in which an arrangement of five lines is shown on the left, and its corresponding zonotile on the right. Note that there are ten points of intersection in the line arrangement, and ten rhombs in the zonotile. Especially note that the right-hand-most point of intersection in the line arrangement corresponds to the right-hand-most rhomb in the zonotile. This “topological” correspondence is not always easy to see. In this simple example you should be able to identify each point of intersection between the lines of the arrangement, with a particular rhomb in the zonotile.

There are twenty-five segments and rays in the line arrangement, and twenty-five edges in the zonotile. There are sixteen open regions in the line arrangement, of which ten are infinite in extent, and sixteen vertices in the zonotile.

zpolar[5]

Try substituting other integers in the zpolar function, such as 3, 4, 6, 7, etc. A randomized coloring has been applied to the rhombs in the zonotiles; the rhombs are first divided into subsets according to surface area, then slightly varied shades or red or blue or green are applied.

Please note that the number of edges which meet at any one vertex in the zonotile, equal the number of segments or rays surrounding the corresponding open region in the line arrangement. By the same token, if some k lines intersect at any one point in the arrangement, a 2k-gon arises in the zonotile.

For example, if the five lines in the arrangement above intersected at one single point—the origin, perhaps—then the resulting zonotile would be one undivided regular decagon.

So much for the duality. Now for the method itself.

The Method in Outline

There are four steps in making a plane zonotile:

1. Select a set of non-zero vectors, no two in the same line.
2. Construct an arrangement of lines perpendicular to the chosen vectors.
3. Form a list of “sign vectors” from the line arrangement.
4. Use the sign vectors as an encoding to construct the zonotile.

Vectors and Lines

In space of n dimensions, given a non-zero vector, we can construct an infinite number of parallel “hyperplanes” or (n-1)-spaces, perpendicular to that vector. In the plane this reduces to the fact that, given a non-zero vector, we can construct an infinite number of parallel lines, perpendicular to the given vector. Here we appeal to the “canonical” equation for a line,

ax + by - c = 0.

We almost always insist that {a,b} is a unit vector, so that c is the distance of the line perpendicular to that unit vector, measured from the origin in the direction of {a, b}. We represent any line, then, as {a, b, c}. If c is negative, the line lies on the opposite side of the origin from {a,b}; if c is zero, the line passes through the origin.

Hence an arrangement of lines is passed to the zonotile function as a list, any one line having the form {a, b, c}.

The various zonogons which compose the zonotile itself are determined by subsets of the unit vectors {a, b}.

In Nicolaas deBruijn’s “multigrid” method, it is imagined that for any unit vector {a, b} an infinite series of parallel lines arises, spaced one unit apart. This he calls a “grid.” Each grid is then offset by some small real number, to ensure that no more than two lines intersect at any one point.

Here we use only a finite number of parallel lines, and they are not necessarily equally-spaced. Suppose, however, they are. Then for a unit vector {a, b} we might represent a set of five parallel lines perpendicular to {a, b} as

{{a, b, -2}, {a, b, -1}, {a, b, 0}, {a, b, 1}, {a, b, 2}}.

That is, there is a set of n directions, expressed by the unit vectors, and for any one direction, lines lie at one or more distances. We are not constrained to have the same number of distances, nor even the same distances, for each direction. If the number of distances, hence the number of perpendicular lines, varies from vector to vector among the n vectors, the bounding zonogon of the zonotile is not equilateral.

My own aim differs also from that of deBruijn, in that I actively seek arrangements in which more than two lines intersect at one or more points.

In practice, when designing and constructing zonotiles, the distances are everything. Often I create the distances as a separate list, and join them to the chosen unit vectors in a Table. Below, an example. There are five unit vectors, and two distances, 0 and 1. The list of lines, each in the form {a, b, c}, is named “lns” and is passed to the drawLines function, which forms the lines themselves, within a specified radius. Then “lns” is passed to the zonotile function, and the zonotile is created and displayed.

Please note that since one of the two distances is zero, five lines pass through one point, and a decagon arises within the zonotile.

n=5;(*five directions*)
dist={0,1};(*two distances*)

(*create the triples {x, y, distance}*)
lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1]
Print["There are ", Length[lns]," lines altogether"];

(*display line arrangement within suitable radius*)
radius=5;
Show[drawLines[lns, radius],
Frame->True];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

I have made much of eutactic stars, and symmetrical vectors. The unit vectors used above are just such; but the observant eye might detect that rather than being multiples of 2π/n, they are multiples of π/n. In this there is a certain subtlety.

Such symmetrically disposed vectors are not at all required by the zonotile function, but I almost always employ them, and the following discussion actually assumes that symmetrical vectors are needed. So have a care.

In the first place, for reasons I do not understand, it seems that all the vectors {a, b} must lie in a half-plane. We can never admit a vector and its opposite into the list; and by the same token, if we pass the five vectors from the center to the vertices of a regular pentagon to the zonotile algorithm, it will fail. An improper zonotile will arise, with intersecting tiles.

A graphical representation of the situation will help. Let us confront the seemingly simple challenge of making the line arrangement obtained by producing the sides of a regular pentagon.

First, we will construct the wrong kind of unit vectors {a, b}, leading from the center to the vertices of a regular pentagon, and then their line arrangement, setting distances at 1; we pause to examine the forms these improper vectors and lines take, and then Show them together. And finally, we construct the improper zonotile.

n=5;(*set how many sides to the regular polygon*)

(*make unit vectors, prepared for use as Line graphics*)
unitvecs=Table[
Line[ Chop[N[{{0,0},{Cos[2*i*Pi/n], Sin[2*i*Pi/n]}}]] ], {i,n}];
Print["The unit vectors, as Graphics Line objects, are as follows: \n", ColumnForm[unitvecs]]

(*make the perpendicular lines in the form {a,b,c}*)
lns=Table[
Chop[N[{Cos[2*i*Pi/n], Sin[2*i*Pi/n], 1}]], {i,n}];
Print["The perpendicular lines, in the form {a,b,c}, are as follows: \n", ColumnForm[lns]]

(*construct and display the unit vectors, colored red*)
g1=Show[ Graphics[ {AbsoluteThickness[2],RGBColor[1,0,0],unitvecs}],
PlotLabel->"The Unit Vectors",
Frame->True,
AspectRatio->Automatic];

(*display line arrangement within suitable radius*)
radius=5;
g2=Show[drawLines[lns, radius],
PlotLabel->"The Perpendicular Lines",
Frame->True];

(*combine the unit vectors and lines*)
Show[{g1,g2},
PlotLabel->"The Unit Vectors and the Lines",
Frame->True,
AspectRatio->Automatic];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

Very well. Passing the line arrangement created above to the zonotile function, an improper zonotile arose, with intersecting tiles. Everything would be ever so much simpler if we could use the unit vectors derived from the vertices of a regular polygon. We cannot.

Instead, we must confine our vectors to a half-plane, and then jump through yet other hoops to form a proper line arrangement.

Once again a graphical representation will help. We being by constructing five unit vectors and five perpendicular lines, but now we use multiples of π/n, not 2π/n, and to obtain the sides of a regular pentagon, produced, we make the distances c of the lines {a, b, c} alternately 1 and -1. And then finally, we construct the proper zonotile.

(*proper vectors and proper lines*)
n=5;(*set how many sides to the regular polygon*)

(*make unit vectors, prepared for use as Line graphics*)
unitvecs=Table[
Line[ Chop[N[{{0,0},{Cos[i*Pi/n], Sin[i*Pi/n]}}]] ], {i,n}];
Print["The unit vectors, as Graphics Line objects, are as follows: \n", ColumnForm[unitvecs]]

(*make the perpendicular lines in the form {a,b,c}*)
lns=Table[
Chop[N[{Cos[i*Pi/n], Sin[i*Pi/n], If[EvenQ[i],1,-1]}]], {i,n}];
Print["The perpendicular lines, in the form {a,b,c}, are as follows: \n", ColumnForm[lns]]

(*construct and display the unit vectors, colored red*)
g1=Show[ Graphics[ {AbsoluteThickness[2],RGBColor[1,0,0],unitvecs}],
PlotLabel->"The Unit Vectors",
Frame->True,
AspectRatio->Automatic];

(*display line arrangement within suitable radius*)
radius=5;
g2=Show[drawLines[lns, radius],
PlotLabel->"The Perpendicular Lines",
Frame->True];

(*combine the unit vectors and lines*)
Show[{g1,g2},
PlotLabel->"The Unit Vectors and the Lines",
Frame->True,
AspectRatio->Automatic];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

So far, so good. However, if you return to the cell above, beginning (*proper vectors and proper lines*), and set n even, say, to 4 or 6 or 8, note that we do not obtain the “sides, produced” of regular 4-, 6-, or 8-gons at all. To explain the changes necessary would only confuse matters.

Here it was quite enough to illustrate confinement of unit vectors to a half-plane, and offer an example of how distances can be manipulated, to obtain a symmetrical arrangement.

Howsoever, I cannot leave the subject of confinement quite so unfinished. In the Stars, Crosses, and Shadows subsection, hypercubes were constructed by translations along n perpendicular vectors. The complete n-dimensional cross contains these same vectors, and their opposites; it is useful to imagine the n-cross as arising from unit vectors taken in both directions along Cartesian axes in the n-space. For instance, a 2-cross would consist of the positive vectors {1, 0} and {0,1}, along with their opposites, {-1, 0} and {0, -1}. To trace out a square we select two of these four. We might select the two positive-valued vectors, or the two negative-valued vectors, or, for instance, one positive and one negative. So long as the selected vectors are perpendicular, the two translations trace out a square.

When we project the n-cross of 2n vectors orthogonally and isometrically into a lower s-space, say, a plane, or 2-space, we obtain a eutactic star of 2n vectors. The positive-valued vectors of the n-cross project into n vectors of the star, and the negative-valued vectors of the n-cross project into n other vectors of the star, the opposites of the first n.

Just as we are free to choose any n of the 2n vectors of the n-cross, to trace out an n-cube, so long as no two lie in the same line, so also we are free to choose any n of the 2n vectors of the (isometric) eutactic star, to trace out the orthogonal shadow of the n-cube, so long as no two lie in the same line. We will obtain the very same shadow, no matter which n vectors of the star are chosen. Hence we can select those n vectors, in a plane isometric eutactic star, which are confined to a half-plane. The situation when n=5 is depicted below. Note that several ways exist to separate the ten vectors (five red, and five dashed blue), by a line. The division will always give two red and three blue to one side, and three red and two blue on the other; but translations along any such subset of five vectors will trace out a regular decagon, an isometric, orthogonal shadow of a 5-cube, cast into a plane.

And five lines perpendicular to any one of these half-plane subsets, intersecting at a single point, lead to a regular decagon in the zonotile.

(*make unit vectors, prepared for use as Line graphics*)
unitvecs=Table[
Line[ Chop[N[{{0,0},{Cos[2*i*Pi/n], Sin[2*i*Pi/n]}}]] ], {i,n}];
(*make the opposites of the above*)
opps=Table[
Line[ Chop[N[{{0,0},-1*{Cos[2*i*Pi/n], Sin[2*i*Pi/n]}}]] ], {i,n}];


(*construct and display the unit vectors, colored red*)
Show[ Graphics[ {AbsoluteThickness[2],RGBColor[1,0,0],unitvecs,
AbsoluteDashing[{5,5}],RGBColor[0,0,1],opps}],
PlotLabel->"The Unit Vectors and Their Opposites",
Frame->True,
AspectRatio->Automatic];

Below, we form five lines in a half-plane (three blues and two reds, as it happens), intersecting at the origin, and then create the zonotile, a single regular decagon.

(*make the perpendicular lines in the form {a,b,0}*)
lns=Table[
Chop[N[{Cos[i*Pi/n], Sin[i*Pi/n], 0}]], {i,n}];
Print["The perpendicular lines, in the form {a,b,0}, are as follows: \n", ColumnForm[lns]]

(*display line arrangement within suitable radius*)
radius=5;
g2=Show[drawLines[lns, radius],
PlotLabel->"The Perpendicular Lines",
Frame->True];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

Sign Vectors

We recreate the same example as above: our line arrangement is simply the sides, produced, of a regular pentagon. Note that the distances are alternately -1 and 1. This is because the “unit vectors within the half-plane” are multiples of iπ / 5 for i={1, 2, 3, 4, 5}. The 5th vector is {-1, 0} and the 5th line is set at distance -1, that is, although the unit vector points to negative x, the line itself is in positive x, and parallel to the y axis. This is the “vertical” line in the arrangement.

n=5;(*a pentagon, its sides produced*)
(*make the perpendicular lines in the form {a,b,c}*)
lns=Table[
Chop[N[{Cos[i*Pi/n], Sin[i*Pi/n], If[EvenQ[i],1,-1]}]], {i,n}];
Print["The perpendicular lines, in the form {a,b,c}, are as follows: \n", ColumnForm[lns]]

(*display line arrangement within suitable radius*)
radius=5;
g2=Show[drawLines[lns, radius],
PlotLabel->"The Perpendicular Lines",
Frame->True];

Now we create the notorious “sign vectors,” their components either -1, 0, or 1. Each sign vector should correspond to one particular zonogon in the zonotile. Suppose there are n unit vectors, and for every vector, perpendicular lines are at j distances, j>=1. Then there are n*j lines altogether, and each sign vector will be of length n*j as well. Each component is the sign of the determinant of a 3-by-3 matrix made of the {a, b, c}s. I find this part of the code most suspicious; for one thing, it allows construction of degenerate zonogonal tiles, such as rhombs with zero area. For another thing, too many sign vectors arise, even after stripping away duplicates using Union. I have made many unsuccessful attempts to streamline and refine this part of the code.

Here, we use our existing set of five lines, each perpendicular to a unit vector {a, b}. In this simple example, no degenerate tiles arise, and no duplicates are removed; each sign vector corresponds to a particular, legitimate tile.

r=Length[lns];(*the total number of lines, and length of each sign vector*)
rawsgn=Table[
  Table[
    Table[
      Sign[Chop[Det[ {lns[[i]],lns[[j]],lns[[k]]} ] ] ],
    {i,r}],
  {j,k+1,r}],
{k,r-1}];

(*get rid of duplicate tiles*)
sgn=Union[Flatten[rawsgn,1]];
Print["The sign vectors are as follows: \n", ColumnForm[sgn]]

The sign vectors encode construction of the zonotile, as will be seen below. In essence, every zonogon in the zonotile is determined by some k vectors of the n*j {a, b}s; and we reach the “point of beginning” where a zonogon is created by adding (and subtracting) together the n*j {a, b}s. Note that in this line arrangement, each line intersects every other, and no more than two lines intersect at any one point. The numbers and positions of zeros in the sign vector show how many lines intersect, and which lines these are.

Here each sign vector contains two zeros; from this we deduce that no more than two lines intersect at any one point.

If all five lines intersected at one point, there would be but one unique sign vector, {0, 0, 0, 0, 0}.

After (unnecessarily, in this case) taking the Union of these sign vectors, the first of the (reordered) ten becomes {-1,-1,0,0,1}. We find zeros at the 3rd and 4th positions. Since there are two zeros, the corresponding tile is a rhomb, in particular, the rhomb determined by the 3rd and 4th of the unit vectors {a, b}.

The other components of the sign vector {-1,-1,0,0,1} include two -1s and one 1. The number and position of the 1s show which of the {a, b}s must be added to reach the “point of beginning” for construction of the zonogon, while all the rest of the vectors are subtracted.

However, the indexing of the {a, b}s does not depend on their original creation, which occurred more likely than not within a Table in which the iterator runs from i to n; instead, given the complete list of lines {a, b, c} perpendicular to the {a, b}s, of length, say, 25, the zonotile function merely takes the {a, b}s from the {a, b, c}s in the order of the line list itself.

The length of each and every sign vector equals the length of the line arrangement.

The ordering of the components of each and every sign vector equals the ordering of the line arrangement.

Perhaps things will become more clear by examining the next step in zonotile construction. We have made the list of ten sign vectors, now we shall construct the zonotile itself.

Constructing the Zonotile

The process begins by stripping {a, b}s from the lines, which are a list of {a, b, c}s of length r.

vecs=Map[#[[{1,2}]]&, lns](*we use the vectors {a, b}*)

Next, the “raw” zonotile is made in a Table and named, of all things, zaq. It is “raw” because it may contain degenerate zonogons of zero area. The Table runs through the list of sign vectors sgn.

Two “incrementing” functions are used within the Table: rmoveto[ point, vector] takes a global variable, “point,” and adds the vector “vector” to increment “point.” Similarly, rlineto[ point, vector] increments “point,” while creating one edge of a zonogon, the edge connecting “point” to “point + vector.”

Each iteration of the Table resets the global variable “point” (below, named pt) to the origin, {0,0}.

Then a Do loop runs through the r components of the kth sign vector. Let us see what happens to the global pt with one iteration of this Do loop. We will use sgn[[ 1 ]], the first sign vector. Note that within the Do is an If block. If the sign of the ith component is positive, we add the corresponding {a, b}; otherwise, we subtract the corresponding {a, b}.

sgn[[1]](*the sign vector we use for example*)

pt={0,0};(*before incrementing*)

(*first, move to proper spot to begin a zonogon*)
   Do[If[ sgn[[1,i]]==1,
     rmoveto[ pt, vecs[[i]] ],(*add the ith vector*)
     rmoveto[ pt, -vecs[[i]] ] ],(*subtract the ith vector*)
   {i,r}]

pt(*after incrementing*)

We have incremented pt. Now that we have the “point of beginning,” we construct a single zonogonal tile, in a terribly awkward piece of programming. We name the “raw” zonogon rawgon, and use one Table to create the first k sides, and a second Table for the second k sides; these are joined using Join. Again an If block is used, to add an edge to the zonogon only if the ith sign is zero. There is no “else” in the If, so to weed out the empty results, Cases wraps each Table to limit output to the form {{x1, y1}, ..., {xk, yk}}. That is, again, if the sign vector contains k zeros, the zonogon has 2k sides.

It is a mystery to me that the vectors are multiplied by two.

(*next, go up one side of the zonogon, down the other*)
   rawgon=Join[
   Cases[
    Table[
	 If[ sgn[[1,i]]==0, rlineto[ pt, 2*vecs[[i]] ] ],
    {i,r}],
   {{_,_}..}],(*end first Cases*)
   Cases[
    Table[
     If[ sgn[[1,i]]==0, rlineto[ pt, 2*-vecs[[i]] ] ],
    {i,r}],
   {{_,_}..}](*end second Cases*)
   ](*end Join*)
   
   zgon=toPoly[rawgon]

Finally, the vertices of the zonogonal tile are extracted from the list of edges, using a minor function, toPoly. This is the final output for each iteration of the outermost Table which loops through the sign vectors to construct the zonotile. Hence the output of the Table, and of the zonotile function, is a list of polygons, each polygon a list of vertices.

Show[Graphics[ Line/@ rawgon ],(*the edges of the tile*)
AspectRatio->Automatic,
Frame->True];

Show[Graphics[ Polygon[zgon] ],(*the tile as a Polygon*)
AspectRatio->Automatic,
Frame->True];

There were a variety of judgement calls made during the writing and refinement of the zonotile function. It is based upon PostScript code which returned a list of line segments, many segments duplicated several times over. So it seemed good to trim the output. Also, I have often found it useful, when modeling polyhedra, to sort the polygonal faces into sets of equal surface area, and assign a color to each area-set. These plane zonotiles seemed well-suited for such treatment. Hence I chose to create raw zonogons as the final output, not yet wrapped in the Graphics primitive Polygon. Leaving the polygons unwrapped not only slims down the data structure, but facilitates sorting by surface area, and the recreation of their bounding line segments, should that be desired.

The colorsort function was set up to discard the degenerate tiles of zero surface area. This could have been done within the zonotile function, but so far I have not done so. I have never been satisfied with the zonotile function, and have always been sure that much optimization is possible.

Initialization

Off[General::spell]
Off[General::spell1]

Zonotile code

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*)
tosegs[gon_]:=Transpose[ {gon, RotateLeft[gon]} ](*polygon to edges*)

toPoly[e_]:=Drop[Join[First@e,Map[#[[2]]&, Rest@e]],-1]

(*Carl Woll's vector union*)
tol=.000001;
vunion1[v_]:= Union[v, SameTest->(Max[Abs[#1 - #2]] < tol &)] 
vunion[v_]:= Module[{r},
r = Split[Sort[Chop[v,.000001]], (Abs[#1[[1]] - #2[[1]]] < tol &)];
Flatten[vunion1 /@ r, 1]]

linestostar[lns_]:=
Block[{posvecs, negvecs, possegs, negsegs},
posvecs=vunion[ Map[#[[{1,2}]]&, lns] ];
negvecs=-1*posvecs;
possegs=Map[Line[{{0,0}, #}]&, posvecs];
negsegs=Map[Line[{{0,0}, #}]&, negvecs];
Graphics[ {AbsoluteThickness[2],RGBColor[1,0,0],possegs,
AbsoluteDashing[{6,6}],RGBColor[0,0,1],negsegs},
Frame->True,
AspectRatio->Automatic]
]

(*tests two rhombs to see if they share a common edge*)
(*if so, the union of their eight vertices is six vertices*)
edgeTest[r1_,r2_]:=
Block[{t=Join[r1,r2]},
Length[t]-Length[vunion[t]]
]

parse[poly_] := Cases[poly,Polygon[x_]:>x,Infinity]

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

notextcolorSort[poly_]:=(*~30* faster than old version*)
Block[{q1,q2,q3},
q1=Table[{poly[[i]], hullarea[ poly[[i]] ] },{i,Length[poly]}];
q2=Select[q1,Last[#]>.00001&];(*changed from !=0&*)
q3=Split[Sort[q2,#1[[2]]<#2[[2]]&],
TrueQ[(Abs[#1[[2]]-#2[[2]]]<.0001)]&];
Table[Cases[q3[[i]],{{_,_}..},Infinity],{i,Length[q3]}]
]

hullarea[poly_]:=
Block[{a,c,t},
c=cent[poly];
t=Map[-c+#&, poly ];
(*divide into triangles*)
a=toTriangles[t];
(*sum one-half the areas of the determined parallelograms*)
Chop[N[Plus @@ Flatten[Map[(Abs[Minors[#, 2]]/2)&, a]]]]
]

(*find indices of faces into list of vertices*)
facedex[vertlist_, hedron_] := 
  Table[Flatten[
  (Position[vertlist, x_ /; Chop[x-#, .001]=={0,0},{1}] & ) /@ hedron[[i]]], 
   {i, Length[hedron]}]

rmoveto[pt1_,pt2_]:= (pt=pt1+pt2)
rlineto[pt1_,pt2_]:= {pt1,(pt=pt1+pt2)}

drawLines[lns_, rad_]:=
Block[{ortho},
ortho=Table[ Line[Join[
(*(vector * distance) +/- radius * orthogonal vector*)
{lns[[k,{1,2}]]*lns[[k,3]]-rad*First@NullSpace[ N[{lns[[k,{1,2}]]}] ]},
{lns[[k,{1,2}]]*lns[[k,3]]+rad*First@NullSpace[ N[{lns[[k,{1,2}]]}] ]}
] ],
{k,Length[lns]}];
Graphics[ortho,AspectRatio->Automatic]
]

zonotile[lns_]:=
Block[{a,b,lns2,pt,r,t,gon,temp},
r=Length[lns];
a=Table[
  Table[
    Table[
      Sign[Chop[Det[ {lns[[i]],lns[[j]],lns[[k]]} ] ] ],
    {i,r}],
  {j,k+1,r}],
{k,r-1}];

(*gets rid of duplicate tiles*)
b=Union[Flatten[a,1]];

lns2=Map[#[[{1,2}]]&, lns];

(*polygons, with degenerates removed*)

Cases[
Table[
pt={0,0};

   Do[If[ b[[k,i]]==1,
     rmoveto[ pt, lns2[[i]]/2 ],
     rmoveto[ pt, -lns2[[i]]/2 ] ],
   {i,r}];

   t=Join[
   Cases[
    Table[
	 If[ b[[k,i]]==0, rlineto[ pt, lns2[[i]] ] ],
    {i,r}],
   {{_,_}..}],
   Cases[
    Table[
     If[ b[[k,i]]==0, rlineto[ pt, -lns2[[i]] ] ],
    {i,r}],
   {{_,_}..}]
   ];

gon=toPoly[t]; 
If[ Chop[ hullarea[ gon ] ]>0, gon],
{k,Length[b]}],
{{_,_}..}]
]

(*fixed list of 56 colors*)
defaultcolorlist=Join[
{
RGBColor[0,0,1],
RGBColor[1,1,0],
RGBColor[1,0,0],
RGBColor[0,.5,0],
RGBColor[0,0,.5],
RGBColor[.5,0,0]},
Table[
	RGBColor[
	  Random[Real,{0,1}],
	  Random[Real,{0,1}],
	  Random[Real,{0,1}]],
{50}]
];

(*takes a list of five -1s and 1s and converts it to full-plane equivalent*)
halftoFull[sgn_]:=sgn[[{2,4,1,3,5}]]*{1,1,-1,-1,-1}

(*takes a list of five -1s and 1s and converts it to half-plane equivalent*)
fulltoHalf[sgn_]:=sgn[[{3,1,4,2,5}]]*{-1,1,-1,1,-1}

pentagrid[max_, s_, d_]:=
Block[{n, sgn, val, offset, dist},
n=5;
(*convert sign patterns to half-plane equivalents*)
sgn=fulltoHalf[ If[ Length[s]!=5, Table[s,{n}], s] ];
val=If[ Length[d]!=5, Table[d,{n}], d];
offset=sgn*val;
dist=Table[ offset[[i]] + Range[-max, max, 1],{i,n}];
lns = Flatten[Table[Chop[N[{Cos[i*(Pi/n)], Sin[i*(Pi/n)], dist[[i,j]]}]],
{i, n}, {j, Length[dist[[i]]]}], 1];
Share[zaq = zonotile[lns]]; 
srt = notextcolorSort[zaq];
col=defaultcolorlist;
xaq=Graphics[
	Table[ {col[[i]],Polygon /@ srt[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, srt[[i]] ]}, {i,Length[srt]}],
	PlotLabel->StringJoin["Offset = ", ToString[ Chop[N[s*val]] ] ],
	AspectRatio->Automatic
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];
]

showtile[n_Integer,distances_List]:=
Block[{lns,zaq,a1,a2},
lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], distances[[j]] }
]],
{i,n}, {j, Length[distances]}],1];

Share[zaq=zonotile[lns]];

With[{colorlist={
RGBColor[1,1,0],
RGBColor[0,0,1],
RGBColor[1,.3,.3],
RGBColor[0,1,0],
RGBColor[.5,.5,1]}
},
s=notextcolorSort[ zaq ];

xaq=Graphics[
	Table[ {colorlist[[ 1+Mod[i,5] ]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];
](*end With*)
](*end Block*)

zpolar[n1_]:=
Block[{n,dist,lns,sgn,z,vaq,xaq,a1,a2},
n=If[EvenQ[n1],n1/2,n1];
dist=If[EvenQ[n1],{-1,1},{1}];
lns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

vaq=drawLines[lns, 10];

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[GraphicsArray[{vaq,xaq}],
Background->GrayLevel[1],
AspectRatio->Automatic];
]

zpolarexpand[n1_]:=
Block[{n,dist,lns,sgn,z,vaq,xaq,a1,a2},
n=If[EvenQ[n1],n1/2,n1];
dist=If[EvenQ[n1],{-5,-.5,.5,5},{.5,5}];
lns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

vaq=drawLines[lns, 10];

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[GraphicsArray[{vaq,xaq}],
Background->GrayLevel[1],
AspectRatio->Automatic];
]

(*Create the vectors which determine a 2n-gon*)
star[n_Integer]:=
Table[
	N[{Cos[Pi/(2*n) + Pi + Pi*i/n],
	Sin[Pi/(2*n) + Pi + Pi*i/n]}],
	{i,0,n-1}]
	
(*A function which makes the edges bounding a rhomb*)
quad[x_,ref_]:={ref, ref+x[[1]], ref+x[[1]]+x[[2]], mark=ref+x[[2]], ref}

(*A function which creates a 2n-gon filled with rhombs*)
tiling[n_Integer]:=
Module[{v,q},
v=star[n];
q=Table[mark={0,0};
	Table[quad[{v[[j]],v[[1+Mod[i+j-1,n]]]},mark],{i,n-j}],{j,n-1}];
Graphics[{AbsoluteThickness[2],Line /@ Flatten[q ,1]},
	AspectRatio->Automatic,
	PlotLabel->StringForm["n=``, rhombs=``",n,Binomial[n,2] ]]
]

Grout & 3D code

(*split polygon into triangles*)
totrigons[vlist_List] :=
    Module[{bary = (Plus @@ vlist)/Length[vlist], circ},
        circ = Partition[ Append[vlist, First[vlist]], 2, 1 ];
        Apply[ {#1, #2, bary}&, circ, {1} ]
    ]

(*shrink polygon by its edges by "dist"*)
grout[poly_, dist_]:=
Block[{c,t,s,a,ta,tb,th,rat,st},
c=cent[poly];(*find center*)
t=Map[-c+#&, poly ];(*translate to origin*)
a=totrigons[t];(*split into triangles*)
ta=Flatten[ First /@ Chop[N[Map[(Abs[Minors[#, 2]])&, a]]] ];(*areas*2*)
tb=Map[ mag[ #[[2]]-#[[1]] ]&, a];(*edge lengths*)
th=MapThread[ #1/#2&, {ta,tb}];(*heights from edge as base*)
rat=Map[(#-dist)/#&, th];(*subtract dist and form ratio*)
st=MapThread[#1*#2&, {rat,t}];(*scale vertices*)
Map[c+#&, st](*translate back to original center*)
]

(*Wouter Meussen's convex hull code*)
myOrdering[z_List]:=(Sort[Transpose[{z,Range[Length[z]]}]]//Transpose) [[2]]

ang2[{v1_List,v2_List},v2_]:=1.
ang2[{v1_List,v2_List},v1_]:=-1.
ang2[{v1_List,v2_List},v3_List]:= (v2-v1).(v3-v2)/mag[v2-v1]/(mag[v3-v2]+.0000001)

ang[{v1_List,v2_List},v2_|v1_]:=1.
ang[{v1_List,v2_List},v3_List]:=(v2-v1).(v3-v2)/mag[v2-v1]/(mag[v3-v2]+.0000001)

convexhull2D[pts_]:=
Block[{cen,dis,idx,xfar,far,xsec,hull},
cen=cent[pts];
dis=mag[#-cen]& /@ pts;
idx=myOrdering[dis];
xfar=Last[idx];
far=pts[[xfar]];
xsec=Sort[{10+  ang2[{cen,far},pts[[#]] ]-10.,
	mag[(far-pts[[#]])] ,#} &/@idx][[-2,-1]];
hull={xfar,xsec};

FixedPoint[Last[AppendTo[hull, 
Sort[ {10+ang[  pts[[Take[hull,-2] ]],
pts[[#]] ]-10.,
mag[(pts[[ Last[hull] ]] -pts[[#]])] ,#} &/@idx] [[-3,-1]] ] ]&,0,
SameTest->(First[hull]==#2 &)];
pts[[ Drop[hull,-1] ]]
]

(*shrink polygon by its edges by "dist" and lift by "height"*)
loft[poly_, dist_, height_]:=
Block[{c,t,s,a,ta,tb,th,rat,st,small,high,base,lats},
c=cent[poly];(*find center*)
t=Map[-c+#&, poly ];(*translate to origin*)
a=totrigons[t];(*split into triangles*)
ta=Flatten[ First /@ Chop[N[Map[(Abs[Minors[#, 2]])&, a]]] ];(*areas*2*)
tb=Map[ mag[ #[[2]]-#[[1]] ]&, a];(*edge lengths*)
th=MapThread[ #1/#2&, {ta,tb}];(*heights from edge as base*)
rat=Map[(#-dist)/#&, th];(*subtract dist and form ratio*)
st=MapThread[#1*#2&, {rat,t}];(*scale vertices*)
small=Map[c+#&, st];(*translate back to original center*)
high=Map[ Join[#,{height}]&, small];(*lift up*)
base=Map[ Join[#,{0}]&, poly];(*z=0 in 3D*)
lats=MapThread[ Join[#1,Reverse[#2]]&, {tosegs[base],tosegs[high]}];(*lateral faces of frustrum*)
Polygon /@ Join[{high},lats](*the laterals and the top face*)
]

(*rhombic tilings only!*)
(*accepts as inputs lns, the lines of an arrangement*)
(*k1, the gridrange number*)
(*ind, the indices into Range[5] of negative signs*) 
(*and z, the magnitude of the z coordinate*)
(*creates globals poly3D and xaq3D*)

loft3D[lns_, k1_, ind_, z_]:=
Block[{rng,s1,s2,lns2,sgn,a,b,pt,t1,t2,zaq3D},
rng=2*k1+1;(*how many lines per grid*)
s1=ind[[1]];s2=ind[[2]];(*indices of two negatives in the sign pattern*)
(*and all that to restore the original sign pattern in the z coordinates of the roof*)
lns2=Table[sgn=If[ (i>(s1-1)*rng && i<s1*rng+1) || (i>(s2-1)*rng && i<s2*rng+1), -1, 1];
Join[lns[[i,{1,2}]], sgn*{z}], {i,Length[lns]}];


Share[

(*make list of sign vectors*)
a=Table[
  Table[
    Table[
      Sign[Chop[Det[ {lns[[i]],lns[[k]],lns[[j]]} ] ] ],
    {i,Length[lns]}],
  {j,k+1,Length[lns]}],
{k,Length[lns]-1}];

b=Union[Flatten[a,1]];


(*find polygons, some degenerate*)
zaq3D=Table[
pt={0,0,0};
Do[ If[ b[[k,j]]==1,
     rmoveto[pt, -lns2[[j]]/2 ],
     rmoveto[pt, lns2[[j]]/2 ]
    ],
{j,Length[lns]}];

t1=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt, -lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
   
t2=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt, lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
 
toPoly[Join[t1,t2]],
{k,1,Length[b]}]
];(*end Share*)

(*discard degenerate polygons*)
poly3D=Select[Cases[zaq3D,{{_,_,_},{_,_,_},{_,_,_}..},Infinity],
Length[#]==4&];
Print["There are ",Length[poly3D]," rhombs in the roof"];


Graphics3D[{EdgeForm[],Polygon /@ poly3D}]
](*end loft3D*)


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

(*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]}]
    ]
    
(*get Headless polygons from Graphics3D object or List*)
parse[x_]:= Cases[ x, {{_,_,_}..}, Infinity]

(*sort polygons by area*)
colorSort3D[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]}]
]


(*from Graphics:Shapes: translate a polyhedron, etc.*)
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}] }
    ]

Bitten and Stellation Code

(*given ordered vertices of a polygon, returns edges*)
toedges[poly_]:=Partition[Join[poly,{First@poly}],2,1]

(*from Graphics:Shapes: translate a polyhedron, etc.*)
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}] }
    ]

(*makes an array of ij points, translations for close-packing*)
make2Darray[{inum_,jnum_},trans_]:=
Block[{ir,jr,f1,f2},
ir=(inum-1)/2;
jr=(jnum-1)/2;
Flatten[Table[
f1=i*trans[[1]];
f2=j*trans[[2]]+f1;
f2,
{i,-ir,ir,1},
{j,-jr,jr,1}
],1]
]

hemi[n_Integer]:=
	Block[{i,j},Flatten[Table[{i,j},{i,n-1},{j,i+1,n}],1]]

(*adds index numbers to lines*)
newdrawLines[lns_, rad_]:=
Block[{ortho,p1,p2},
ortho=Table[ {Line[Join[
(*(vector * distance) +/- radius * orthogonal vector*)
p1={lns[[k,{1,2}]]*lns[[k,3]]-rad*First@NullSpace[ N[{lns[[k,{1,2}]]}] ]},
p2={lns[[k,{1,2}]]*lns[[k,3]]+rad*First@NullSpace[ N[{lns[[k,{1,2}]]}] ]}
] ],
Text[ToString[k], p1[[1]] ],
Text[ToString[k], p2[[1]] ]},
{k,Length[lns]}];
Graphics[ortho,AspectRatio->Automatic]
]

(*index numbers in disks, colors to lines*)
mynewdrawLines[lns_, color_, rad_]:=
Block[{ortho,p1,p2},
ortho=Table[ {color,Line[Join[
(*(vector * distance) +/- radius * orthogonal vector*)
p1={lns[[k,{1,2}]]*lns[[k,3]]-rad*First@NullSpace[ N[{lns[[k,{1,2}]]}] ]},
p2={lns[[k,{1,2}]]*lns[[k,3]]+rad*First@NullSpace[ N[{lns[[k,{1,2}]]}] ]}
] ],
GrayLevel[1], Disk[p1[[1]], .5],GrayLevel[0],Circle[p1[[1]], .5],Text[ToString[k], p1[[1]] ],
GrayLevel[1], Disk[p2[[1]], .5],GrayLevel[0],Circle[p2[[1]], .5],Text[ToString[k], p2[[1]] ]},
{k,Length[lns]}];
Graphics[ortho,AspectRatio->Automatic]
]

(*this works with vectors {a,b} which are not unit vectors*)
newinter2lines[{{a1_,b1_,c1_},{a2_,b2_,c2_}}]:=
Block[{denom,a,b,c,d,e,f},
(*convert inputs to {{a,b,c},{d,e,f}}*)
{a,b}=unit[{a1,b1}];
{d,e}=unit[{a2,b2}];
c=c1*mag[{a1,b1}];
f=c2*mag[{a2,b2}];

denom=Chop[ a*e - b*d ];
If[denom==0,Null,
Chop[{ ((c*e - f*b)/denom), ((a*f - d*c)/denom) }]]
]

(*find all intersections, and find radius within which to draw lines*)
findpoints[lnlist_]:=
Block[{dex},
dex=hemi[ Length[ lnlist ] ];
vunion[
DeleteCases[
Table[
newinter2lines[ lnlist[[ dex[[k]] ]] ],
{k, Length[dex]}],
Null](*end DeleteCases*)
](*end vector union*)
]

(*assumes symmetry*)
(*given the distance of the center of the most-distant tile,*)
(*divide the zonotile into k concentric regions, with*)
(*separate colorlists*)
tilesplit[tile_List,k_]:=
Block[{},
fcents=vunion[ Map[ Chop[cent[#]]&, tile] ];
maxcent=Max[Map[mag[#]&, fcents] ];
{
Select[tile, mag[cent[#]]<=(.001+maxcent/k)&],
Select[tile, mag[cent[#]]>(maxcent/k)&]
}
]

(*removes duplicates and re-orders line list*)
fixLines[ln_List]:=
Block[{rawlns,newlns},
rawlns=Cases[ln, {_,_,_}, Infinity ];
Print["There are ", Length[rawlns]," lines at first"];
newlns=Sort[ Union[rawlns], (#1[[1]]>#2[[1]])&];
Print["There are ", Length[newlns]," lines altogether"];
newlns
]

POV export code

(*get unique vertices and edges for POV spheres and cylinders*)
vertedge[tile_]:=
Block[{v1,e1},
v1=vunion[Flatten[tile,1]];
e1=eUnion[tile];
Print["First member of list is 2D vertices, second, 2D edges"];
{v1, e1}
]

eUnion[tiling_]:=
Block[{edall,edrat,dex},
edall=Flatten[ Map[ tosegs[ # ]&, tiling],1];
edrat=Rationalize[ cent /@ edall, .01 ];
dex=Flatten[Map[ (First@Position[ edrat, # ])&, Union[ edrat ] ] ];
edall[[dex]]
]

make3D[gon_]:=Map[ Join[#,{0}]&, gon]

tected = Unprotect[Infix];
Infix[_[e_], h_:Null] := e;
Protect[ Evaluate[tected] ];

(* optional text followed by numbers, FortranForm with 5 digits *)

ndig = 8;
nForm[r_] := NumberForm[Chop[r,.000001], ndig];

writeNums[file_, txt_:"", r_?NumberQ] :=
    Write[file, txt, " ", nForm[r]]
writeNums[file_, txt_:"", r_List] :=
    Write[file, txt, " ", Infix[nForm /@ r, " "]]

(* turn n-gon into list of triangles *)

toTriangles[vlist_List] /; Length[vlist] == 3 := {vlist}

(* treat 4gons specially for efficiency *)

toTriangles[vlist_List] /; Length[vlist] == 4 :=
	{vlist[[{1, 2, 3}]], vlist[[{3, 4, 1}]]}

(* general case: use center of gravity as additional vertex *)
(* in this way, some nonconvex polygons can also be rendered correctly *)

toTriangles[vlist_List] :=
    Module[{bary = (Plus @@ vlist)/Length[vlist], circ},
        circ = Partition[ Append[vlist, First[vlist]], 2, 1 ];
        Apply[ {#1, #2, bary}&, circ, {1} ]
    ]
    
Ball[x_List,r_]:={x,r}

Rod[x_List,r_]:={x,r}

cyllmake[txt_:"", r_List] /; Length[r] == 2 :=
    SequenceForm[txt,"{", "<", Infix[nForm /@ r[[1,1]], ", "], ">",
    ",", "<", Infix[nForm /@ r[[1,2]], ", "], ">"," ",r[[2]],"}" ]
    
ballmake[txt_:"", r_List] /; Length[r] == 2 :=
    SequenceForm[txt,"{", "<", Infix[nForm /@ r[[1]], ", "], ">",
    " ",r[[2]],"}" ]
    
facemake[txt_:"", r_List] /; Length[r] == 3 :=
    SequenceForm[txt,"{", "<", Infix[nForm /@ r[[1]], ", "], ">",
    ",", "<", Infix[nForm /@ r[[2]], ", "], ">",
    ",", "<", Infix[nForm /@ r[[3]], ", "], ">","}" ]
    
colmake[txt_:"", r_]:=
    SequenceForm[txt,"{","color rgb", "<", Infix[nForm /@ r, ", "], ">","}" ]

(*send zonotile vertices, edges and polygons 
to POV spheres, cylinders, and triangles*)
TessToPOV[filename_String,fa_List,vert_List,edg_List]:=
Block[{poly,faces},

strm=OpenWrite[filename,
FormatType->OutputForm,
PageWidth->Infinity];
Write[strm,"#declare FACES = union{"];
	Do[
	Write[strm,"mesh{"];
	poly=Map[toTriangles[#]&,fa[[i]] ];
	faces=ColumnForm[Map[facemake["triangle",# ]&,Chop[Flatten[poly,1]]],Left];
	Write[strm,faces];
	Write[strm,colmake["pigment", colors[[i]] ]];
	Write[strm,"}"],
	{i,Length[fa]}];
Write[strm,"}"];

Write[strm,"#declare VERTS = union{"];
q1=Map[Ball[#,.15]&, verts ];
Write[strm,
ColumnForm[ Map[ ballmake["sphere",# ]&, q1 ] ]
];
Write[strm,"texture{T1}"];
Write[strm,"}"];

Write[strm,"#declare EDGES = union{"];
q1=Map[Rod[#,.1]&, sides ];
Write[strm,
ColumnForm[ Map[ cyllmake["cylinder",# ]&, q1 ] ]
];
Write[strm,"texture{T2}"];
Write[strm,"}"];

Close[strm]
]

(*send zonotile vertices, edges and polygons 
to POV spheres, cylinders, and polygons*)
UnDragonToPOV[filename_String,tile_List,verts_List,sides_List]:=
Block[{q1,strm},

strm=OpenWrite[filename,
FormatType->OutputForm,
PageWidth->Infinity];

Write[strm,"#declare FACES = union{"];
	Do[
	Write[strm,"union{"];
	Write[strm,ColumnForm[ Map[polymake[# ]&, Chop[ tile[[i]] ] ], Left]];
	Write[strm,colmake["pigment", colors[[i]] ]];
	Write[strm,"}"],
	{i,Length[tile]}];
Write[strm,"}"];

Write[strm,"#declare VERTS = union{"];
q1=Map[Ball[#,.15]&, verts ];
Write[strm,
ColumnForm[ Map[ ballmake["sphere",# ]&, q1 ] ]
];
Write[strm,"texture{T1}"];
Write[strm,"}"];

Write[strm,"#declare EDGES = union{"];
q1=Map[Rod[#,.1]&, sides ];
Write[strm,
ColumnForm[ Map[ cyllmake["cylinder",# ]&, q1 ] ]
];
Write[strm,"texture{T2}"];
Write[strm,"}"];

Close[strm]
]

(*send zonotile vertices, edges and polygons 
to POV spheres, cylinders, and prisms*)
DragonToPOV[filename_String,fa_List,vert_List,edg_List]:=
Block[{q1,strm},
strm=OpenWrite[filename,
FormatType->OutputForm,
PageWidth->Infinity];

Write[strm,"#declare FACES = "];	
	Write[strm,"union{"];
	Write[strm,ColumnForm[ Map[prismmake[# ]&, Chop[fa] ], Left]];
	Write[strm,"texture{T1}"];
	Write[strm,"}"];

Write[strm,"#declare VERTS = union{"];
q1=Map[Ball[#,.15]&, verts ];
Write[strm,
ColumnForm[ Map[ ballmake["sphere",# ]&, q1 ] ]
];
Write[strm,"texture{T2}"];
Write[strm,"}"];

Write[strm,"#declare EDGES = union{"];
q1=Map[Rod[#,.1]&, sides ];
Write[strm,
ColumnForm[ Map[ cyllmake["cylinder",# ]&, q1 ] ]
];
Write[strm,"texture{T3}"];
Write[strm,"}"];

Close[strm]
]

polymake[txt_:"", r_List]:= (*2D polygons to z=0 3D polygons*)
    ColumnForm[
    {
    "polygon","{", 
    StringJoin[ ToString[ Length[ r ] + 1 ], ","],
    
Sequence @@ Map[ SequenceForm["<", Infix[nForm /@ #, ", "], ">"]&, Join[r,{r[[1]]}]],
    
    "}"
    }
    ]

prismmake[txt_:"", r_List]:= (*2D polygons to 3D prisms, ZLO<=z<=ZHI*)
    ColumnForm[
    {
    "prism","{", 
    "linear_spline",
    "linear_sweep",
    StringJoin["ZLO,", "ZHI,", ToString[ Length[ r ] + 1 ], ","],
    
Sequence@@ Map[ SequenceForm["<", Infix[nForm /@ #, ", "], ">"]&, Join[r,{r[[1]]}]],
    
    "}"
    }
    ]

(*sample scene file for Dragon design export to POV*)
scenefile={"// Persistence of Vision Ray Tracer Scene Description File", "// File: dragonalia.pov", "// Vers: 3.1", 
  "// Desc: 2D zonotile", "// Date: 2/22/05", "// Auth: Russell Towle", "//", 
  "/* ----------------------------------------*/", "#version 3.1;", "#include \"colors.inc\"", 
  "#include \"shapes.inc\"", "#include \"textures.inc\"", "#include \"metals.inc\"", 
  "#default { texture { pigment {color rgb <1,1,1>} finish {phong 0.5 ambient 0.2 diffuse .6} }}", 
  "/* ----------------------------------------*/", "camera {", "\tlocation <-20, -15, 25>/3", 
  "\tdirection <0, 1, 0> //.75 wide angle", "\tup <0, 0, 1>", "\tright <4/3, 0, 0> //aspect ratio, w/h", 
  "\tsky <0., 0., 1.>", "\tlook_at <0.5, 0., 1>", "}", "/* ----------------------------------------*/", 
  "light_source {<-40, 10, 30>*4 color rgb <1, 1, 1>}", "light_source {<5, -25, 10>*20 color rgb <1, 1, 1>/2}", 
  "/* ----------------------------------------*/", "/*Begin Dragon*/", 
  "/*T1 for prism, T2 for spheres, T3 for cylinders*/", 
  "#declare T1 = texture { pigment {color rgb <1,1,0>} finish {phong 0.01 ambient 0.2 diffuse .6} }", 
  "#declare T2 = texture { pigment {color rgb <1,1,1>} finish {phong 0.01 ambient 0.2 diffuse .6} }", 
  "#declare T3 = texture { pigment {color rgb <1,1,1>} finish {phong 0.01 ambient 0.2 diffuse .6} }", 
  "#declare ZLO = 1;//base of prism", "#declare ZHI=2;//top of prism", "#include\"dragon1.inc\"", 
  "object{FACES rotate<90,0,0>}", "//object{VERTS}", "//object{EDGES}", "/*End  Dragon*/", 
  "/* ----------------------------------------*/", "/*Begin UnDragon*/", "/*T1 for spheres, T2 for cylinders*/", 
  "#declare T1 = texture { pigment {color rgb <1,1,1>} finish {phong 0.01 ambient 0.2 diffuse .6} }", 
  "#declare T2 = texture { pigment {color rgb <1,1,1>} finish {phong 0.01 ambient 0.2 diffuse .6} }", 
  "#include\"undragon.inc\"", "/*the faces, edges and vertices defined in the #include file*/", "object{FACES }", 
  "object{VERTS scale<1, 1, 1>}", "object{EDGES scale<1, 1, 1>}", "/*End UnDragon*/", 
  "/* ----------------------------------------*/", "plane{<0,0,1>, -2", "pigment{", "  checker", 
  "    color rgb <1, 1, 1>", "    color rgb <1, 1, 1>/2", "scale 20}", "}", 
  "/* ----------------------------------------*/", "sky_sphere", "{", "  pigment", "  {", "    gradient z", 
  "    color_map { [0.0 color rgb <0.7,0.7,0.7>] [1.0 color rgb <1.0,1.0,1.0>] }", "  }", "}", 
  "/* ----------------------------------------*/"};

Tutorial

Success and Failure

It is hoped that users of this notebook will experiment with their own line arrangements. There are a few things to keep in mind: foremost, however many “generating” vectors are chosen, from which the perpendicular lines of the arrangement follow, the vectors must all reside within a half-plane. There should be no duplicates. The vectors must be cyclically ordered.

Here we cover these points in turn. First, a “successful” set of vectors is created, all within a half-plane, the vectors and their opposites displayed, the line arrangement displayed, the zonotile displayed. Next we will consider various ways the zonotile function fails. Finally, we test the ordering of distances, the duplication of distances, and cyclically ordered random vectors within a half-plane.

Success

(*only n lines, displaced from the origin*)
n=5;
dist={1};

lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*construct and display the unit vectors, colored red*)
(*with their opposites dashed and colored blue*)
g1=Show[ linestostar[lns],
PlotLabel->"Vectors and Opposites",
Frame->True];

(*display line arrangement within suitable radius*)
radius=5;
g2=Show[drawLines[lns, radius],
PlotLabel->"The Perpendicular Lines",
Frame->True];

(*combine the unit vectors and lines*)
Show[{g1,g2},
PlotLabel->"Vectors and Lines",
PlotRange->{{-radius, radius},{-radius,radius}},
Frame->True,
AspectRatio->Automatic];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
g3=Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
PlotLabel->"The Zonotile",
Frame->True,
AspectRatio->Automatic];

(*Show vectors, lines, zonotile--drag out larger*)
Show[GraphicsArray[{g1,g2,g3}]];

Failure by Exceeding a Half-Plane

This failure is not as bad as half-plane violations are, usually. See the red code, where the iterator i is allowed to run past n.

n=5;
dist={1};

lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n+3},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*construct and display the unit vectors, colored red*)
(*with their opposites dashed and colored blue*)
g1=Show[ linestostar[lns],
PlotLabel->"Vectors and Opposites",
Frame->True];

(*display line arrangement within suitable radius*)
radius=5;
g2=Show[drawLines[lns, radius],
PlotLabel->"The Perpendicular Lines",
Frame->True];

(*combine the unit vectors and lines*)
Show[{g1,g2},
PlotLabel->"The Unit Vectors and the Lines",
PlotRange->{{-radius, radius},{-radius,radius}},
Frame->True,
AspectRatio->Automatic];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

Failure by Allowing Duplicates

Here the only apparent failure is that one zone of edges within the zonotile has twice the length of the others. The fifth vector was duplicated by adding it to the end of the list (see red code); hence no cyclic violation occurred.

(*only n lines, displaced from the origin*)
n=5;
dist={1};

lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

(*we have a pair of duplicates*)
lns=Join[lns, {lns[[5]]} ];
Print["There are ", Length[lns]," lines altogether"];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

Failure by Lack of Cyclic Ordering

If the generating vectors are not cyclically ordered (see red code), all hell breaks loose.

n=5;
dist={1};

lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*we violate cyclic order*)
lns=lns[[ {2,1,5,4,3} ]];

(*construct and display the unit vectors, colored red*)
(*with their opposites dashed and colored blue*)
g1=Show[ linestostar[lns],
PlotLabel->"Vectors and Opposites",
Frame->True];

(*display line arrangement within suitable radius*)
radius=5;
g2=Show[drawLines[lns, radius],
PlotLabel->"The Perpendicular Lines",
Frame->True];

(*combine the unit vectors and lines*)
Show[{g1,g2},
PlotLabel->"The Unit Vectors and the Lines",
PlotRange->{{-radius, radius},{-radius,radius}},
Frame->True,
AspectRatio->Automatic];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

Ordering of the Distances Does Not Matter

The distances need not be kept in ascending order (see red code).

n=5;
dist={2,-1,1,0,-2};

lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

Print["There are ", Length[lns]," lines altogether"];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

Duplication of Distances

If distances are duplicated (see red code), then so also are the generating vectors; so we again obtain a non-equilateral zonotile. I am accustomed to use other methods to build non-equilateral zonotiles (see the Examples section), which do not overload the zonotile function with unnecessary lines. It puzzles me that duplications such as these do not fail more badly.

n=5;
dist={-2,-2,-1,0,1,1,1};

lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

Print["There are ", Length[lns]," lines altogether"];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

Random Vectors, Cyclically Ordered

Keep them within a half-plane, and let them be cyclically ordered, and the vectors need not be equally-spaced. We rather neatly obtain “random” zonotiles (see red code), which change each time the code block is evaluated.

n=5;
dist={0,1};

randomfactors=Sort[Table[ Random[Real, {i-.9, i-.01}],{i,n}]]
Print["The random factors are ", randomfactors];

lns=Flatten[Table[
Chop[N[{ Cos[ randomfactors[[i]]*Pi/n], Sin[ randomfactors[[i]]*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*construct and display the unit vectors, colored red*)
(*with their opposites dashed and colored blue*)
g1=Show[ linestostar[lns],
PlotLabel->"Vectors and Opposites",
Frame->True];

(*create zonotile*)
zaq=zonotile[lns];
(*display edges of zonotile*)
Show[Graphics[{GrayLevel[0], Map[Line /@ tosegs[#]&, zaq]} ],
Frame->True,
AspectRatio->Automatic];

Comparison of Line Spacings

The showtile function allows easy comparison of line spacings; colors are predefined. In the first example, five sets of four lines and five sets of five lines (each 5-set containing a line through the origin) are compared. Each set contains two lines at unit distance, with the other two or three within these. We go from tightly bunched near the origin, to tightly bunched away from the origin, and pass through several “harmonic” ratios along the way, where the spacings are such that more than two lines intersect at certain points.

n=5;
dist={
Union[ Join[a={.1,1}, -a] ],
Union[ Join[a={N[Cos[3*Pi/n]],1}, -a] ],
Union[ Join[a={2*N[Cos[3*Pi/n]],1}, -a] ],
Union[ Join[a={N[Cos[4*Pi/n]],1}, -a] ],
Union[ Join[a={.9,1}, -a] ],
Union[ Join[a={0,.1,1}, -a] ],
Union[ Join[a={0,N[Cos[3*Pi/n]],1}, -a] ],
Union[ Join[a={0,2*N[Cos[3*Pi/n]],1}, -a] ],
Union[ Join[a={0,N[Cos[4*Pi/n]],1}, -a] ],
Union[ Join[a={0,.9,1}, -a] ]
};

Do[showtile[n, dist[[i]] ], {i, Length[dist]}]

By taking equal small steps we may avoid “harmonic” ratios along the way. Or not.

Do[showtile[6, Union[ Join[a={i,1}, -a] ] ],
{i,.1,.9,.1}]

Here we take a fixed line spacing, of {-1, -.3, 0, .3, 1}, and displace each set away from the origin in steps of .1, from 0 to 1.

Do[showtile[7, i+Union[ Join[a={0,.3,1}, -a] ] ],
{i,0,1,.1}]

The limit as we displace the line sets farther from the origin is an especially simple tiling of the bounding 14-gon. It is similar to the zonotile obtained with a set of seven lines at distance 1.

showtile[7, 25+Union[ Join[a={0,.3,1}, -a] ] ]
showtile[7, {1} ]

Penrose Tilings and Dragon Designs

Introduction

Around 1975 Sir Roger Penrose discovered certain aperiodic tilings of the plane, some involving kites and darts, others, 36- and 72-degree rhombs. One could translate from kites-and-darts to rhombs, or vice versa. In 1981 Nicolaas de Bruijn began publishing a series of papers on the algebraic underpinnings of these “Penrose” tilings. De Bruijn constructed the Penrose tiling of 36- and 72-degree rhombs using a “pentagrid,” in which an infinite “grid” of equally-spaced lines, one unit apart, was rotated 0, 72, 144, 216, and 288 degrees. De Bruijn showed how a pentagrid led to a tiling of zonogons, and if the five grids were properly offset from the origin, the zonogons were simply 36- and 72-degree rhombs.

He also extended the concept of a pentagrid to that of a multigrid, in which, rather than five directions, the grids were perpendicular to some n directions, n>=2 (see The Heptagrid, below). And he showed that this all generalized to higher space, where instead of arrangements of lines, we have arrangements of hyperplanes, and instead of a tiling of a 2n-gon by rhombs, we have a tiling of a zonotope by parallelotopes. For how arrangements of planes lead to the tilings of zonohedra by smaller zonohedra, not necessarily rhombic hexahedra, see my 3D_Zonotiles.nb, available on MathSource.

Professor Vince Matsko of Quincy University was so very kind as to send me his collection of de Bruijn’s papers. For a year I have puzzled over them, and to this day I do not follow his arguments and proofs. However, things have become somewhat clearer. This version of the 2D_Zonotiles.nb was prompted by my belated realization that random numbers have nothing to do with Penrose tilings. I fell into this serious error years ago, somehow connecting the aperiodicity of Penrose tilings, with random offsets of the grids.

In the course of experimentation, however, I began to obtain results better approximating the “classic” Penrose tiling of “arrowed rhombs.” These arose when I began confining my random-number offsets within narrow bounds. These in turn led to even narrower bounds, and at last random offsets were abandoned in favor of single, fixed, rational offsets. Immediately I obtained perfect arrowed-rhombus tilings, adorned with those marvelous runs of 72-degree rhombs I call “dragon designs.” A complete reorganization of my ideas followed, and more reading of those inscrutable papers of de Bruijn.

The subsections below contain various approaches to making “perfect” Penrose tilings. Some violate de Bruijn’s rules.

In an attempt to clarify the situation, let me state what little I do know about de Bruijn’s approach to Penrose tilings.

A grid is a set of parallel lines spaced one unit apart. For instance, consider the lines parallel to the x axis given by y=a, where a runs through the integers: these form a grid, and we represent any one line of this grid as {0, 1, a}. For de Bruijn’s purposes, a grid had infinitely many lines; here, we use a finite number of lines.

A pentagrid is the set of five grids obtained by rotating a grid 0, 72, 144, 216, and 288 degrees.

If no more than two lines intersect at any one point, a pentagrid is called regular, otherwise, singular. If five lines intersect at a point, the pentagrid is exceptionally singular.

A pentagrid is described by five offsets, which are real numbers. All can be equal, or all different, or some positive and some negative. If they are all zero, we obtain an exceptionally singular pentagrid. If they are all integers, and the number of lines is infinite, we once again obtain an exceptionally singular pentagrid, shifted away from the origin. De Bruijn insists that these five real numbers sum to zero: then we can refer to zero-sum pentagrids. Note that, if some four of the five offsets sum to zero, the fifth must be zero. For example, {0.1, -0.1, 0.1, -0.1, 0}.

De Bruijn writes: a regular [zero-sum] pentagrid determines an arrowed-rhombus pattern. Since the pentagrid is regular, no more than two lines intersect at any one point; hence only rhombs arise in the tiling, and these of two types, 36- and 72-degree rhombs. By a certain scheme the edges are marked with red and green arrows, and two rhombs can share an edge if and only if colors and directions match. This is the matching condition for the “classic” Penrose tiling (see, among others, his Algebraic Theory of Penrose’s non-periodic tilings of the plane, Kon. Nederl. Akad. Wetensh., Proc. Ser. A 84, 1981).

There is a broad spectrum of tilings which arise from pentagrids, spanning much variation, and whenever we focus on one little part of that spectrum, it seems to become indefinitely more complex. This behavior of the tilings is related, one senses, to Penrose’s operations on his tilings, inflation and deflation. But there are spectra of spectra, patterns of patterns, and various varieties of symmetry--how many varieties? Eight, as de Bruijn has it?

To model this spectrum, and, we hope, discover these symmetries, we shall keep some variables fixed, and let one thing alone, incrementally, change. We will create animations of tilings, for instance, in which we change the absolute value of the (single) offset, over some range, taking small steps. By doing so, we will find that all different tilings can be obtained within the range {0, .5}. Here we call two tilings which differ only by a rotation, or by a mirror flip, the same. So, we get the same tiling for offset = .4 as we do for offset = .6; the same for offset = -.1, as for offset = .1. Zero and one act as mirrors, with the same tilings to either side, in mirror pairs.

But let us immediately verify this.

Pentagrids: a Meandering Exploration

To facilitate comparison of many different pentagrids, a pentagrid function was formed, in which the messy details are hidden away. In particular, the problem of reconciling the use of five generating vectors in a half-plane, with the expression of offsets and sign patterns in a way consistent with pentagrids derived from regular pentagons, is solved behind the scenes. This was required, for we wish our results to agree with those of de Bruijn.

That is, to make this crucial step clear, we still must use the five unit vectors at 36, 72, 108, 144, and 180 degrees, but the pentagrid function automatically converts the sign-patterns of the offset magnitudes from full-plane form to half-plane form, behind the scenes. It is exactly as though we were using the more natural pentagrid generators at 72, 144, 216, 288, and 360 degrees. The details are far too obnoxious to reveal here.

Oh, what a headache the conversion from full- plane to half-plane sign patterns gave me! It adds one more level of complexity to something already well beyond my feeble mind.

The pentagrid function accepts three inputs, viz., pentagrid[ gridrange, signs, magnitudes ].

1. gridrange controls the number of lines in a grid, which, before being offset, are at the distances Range[ -gridrange, gridrange, 1 ] from the origin. Usually gridrange will be an integer, k, in which case there are 2*k+1 lines per grid (an odd number). In this case, the central line of each grid passes through the origin (this is how de Bruijn conceived an un-offset infinite grid). Sometimes we will set gridrange to some half of an odd integer, say, k/2, in which case there are k+1 lines per grid (an even number), and none pass through the origin. There are five grids; a gridrange of 10 gives 21 lines per grid, 105 lines altogether. That makes for a complicated, time-consuming tiling.

2. signs allows us to specify the signs of the five offsets, +1 or -1. We can either enter a single number, say, 1, in which case all five are taken to be positive, or five separate signs, for instance, {1, -1, 1, -1, 1}. Later we shall make special use of these sign-patterns.

3. magnitudes allows us to specify the magnitudes of the five offsets. We can either enter a single number, say, d, in which case all five are taken to be d, or five separate real numbers, for instance, {.1, .2, .2, .1, 0}.

We get our five offsets as the product of signs and magnitudes. In the example above, {1, -1, 1, -1, 1}*{.1, .2, .2, .1, 0}={.1, -.2, .2, -.1, 0}. Note that this gives a zero-sum pentagrid, since (.1 + -.2 + .2 + -.1 + 0) = 0.

Please note that typical usages of the pentagrid function might then take the forms

pentagrid[ 3, 1, 0 ] (seven lines per grid, 35 lines altogether; signs all positive; magnitudes all zero; hence offsets={0,0,0,0,0})
pentagrid[ 3, {1, -1, 1, -1, 1}, .4 ] (seven lines per grid, 35 lines altogether; signs alternate; magnitudes all .4; hence offsets={.4, -.4, .4, -.4, .4})
pentagrid[ 3, -1, {.1, .2, .3, .4, .5 ] (seven lines per grid, 35 lines altogether; signs all negative; five magnitudes; hence offsets={-.1, -.2, -.3, -.4, -.5})

First consider the case of the exceptionally singular pentagrid in which all offsets are zero. It is a zero-sum pentagrid. Five lines cross at the origin, {0,0}, and three lines intersect at a multitude of other places; a regular decagon, and two types of hexagon, are symmetrically disposed within the tiling. Note the ten “spokes” of hexagons, radiating from the decagon: between these spokes are patches of perfect, arrowed-rhombus, dragon-designed Penrose tiling. Setting maxdist larger will expand these intervals.

pentagrid[ 3, 1, 0 ]

Next consider the case of setting all five offsets to 1. In an infinite pentagrid, the pentagrid is carried into itself. In our finite pentagrid, the spokes of hexagons no longer reach to the edges of the tiling.. Try pentagrid[ 3, 1, 2 ] or pentagrid[ 3, 1, -1 ], and increasing gridrange.

pentagrid[ 3, 1, 1 ]

Next consider the case of setting four offsets to 0, the fifth to 1. In an infinite pentagrid, once again, the entire pentagrid is carried into itself. In fact, in an infinite pentagrid, the magnitudes could be an absolutely random set of five integers, without any effect on the tiling. Compare this tiling to the one above: the decagon is displaced, since only one of the five grids has been offset.

pentagrid[ 3, 1, {1,0,0,0,0} ]

In the example below, one might feel that some great new scheme of tiling has been discovered, where rhombs struggle to meet, ten at a vertex; and all we have done is make our grid lines run from -7/2 to 7/2, in steps of 1! There are eight lines per grid, forty altogether. We set signs all positive but the magnitudes are zero in any case. It is a zero-sum pentagrid, but not after the fashion of de Bruijn, for his gridlines, before offset, have integer distances from the origin.

pentagrid[ 7/2, 1, 0 ]

Note, however, that we could have achieved the same effect merely by setting magnitudes = 1/2. It is my intent here, in investigating symmetries of tilings, to call the tiling below the same as the tiling above. It is slightly more complicated, arising from 45 lines insread of 40.

pentagrid[ 4, 1, 1/2 ]

Here we visit another singular pentagrid, in which four lines intersect at the origin, giving an irregular octagon at the center of the tiling.

pentagrid[ 3, 1, {.4,0,0,0,0} ]

Now we keep signs positive, and animate offsets across the range 0 to 1 in steps of .1. Note that only k = 0 gives a zero-sum pentagrid. Here, we use a finite number of lines, and the effect is, in part, to move the center of symmetry slowly through the tiling.

Having created the sequence of tilings, each with its offset labeled at the top, scroll to the middle, and confirm for yourself that the tiling of offset = .4 is equivalent to the tiling of offset = .6, as .3 is to .7, .2 to .8, and .1 to .9, and 0 to 1.

Do[ pentagrid[ 4, 1, k ], {k, 0, 1, .1}]

Very well; we have seen that tilings mirror the offset of 1/2, that is, offset-r and offset+r give the same tiling, for all our purposes. The same is true for the offset of 0, which can be verified by changing the Do loop above to run from -.5 to .5 in steps of 0.1. This follows from unit spacing of the grid lines.

To get a sense of how gridrange can affect our enumeration of different tilings, compare the image sequence below, to that above. We are stepping through offsets from 0 to 1 in increments of 0.1 as before, but with only three lines per grid, rather than nine. Now sequences of identical tilings begin to arise, spanning more than one offset, rather than a different tiling for each offset. Also, the tilings do not perfectly mirror across 0.5, or rather, they appear not to mirror. Actually the same symmetry-type is mirrored, but for much the same reasons that the hexagon-spokes above, terminate before reaching the edge of the tiling, here the increasing offset, combined with small grids, is masking the mirrored equivalence.

Do[ pentagrid[ 1, 1, k ], {k, 0, 1, .1}]

From now on we often will confine our “spectral analysis” to the offsets between 0 and 1/2.

Here we examine the sign pattern {-1,-1,-1,-1,-1}. We have seven lines per grid, 45 altogether, and move through the interval {.01, .49} in steps of .02. This step is small enough, for these five grids of nine lines apiece, that some tilings repeat, but not small enough that all tilings repeat.

Two perfect, arrowed-rhomb, dragon-designed tilings arise within the spectrum: at offsets .19 and .21, we have the rounded “Madonna” dragon design; at offset .39, the spiky “Archangel” design is found.

Do[ pentagrid[ 3, {-1,-1,-1,-1,-1}, k ], {k, .01, .49, .02}]

Now we refine our march through a narrower range of offsets, using grids of thirteen lines, and a step of .005. We look in the vicinity of the Archangel motif, offset=.39, recalling that offsets .37 and .41, above, gave different tilings. We shall at least gain a better idea of the proper offset or “locus” for the Archangel tiling, for the sign-pattern {1, -1, 1, -1, 1} (it seems to fall around .395).

Do[ pentagrid[ 6, {-1,-1,-1,-1,-1}, k ], {k, .38, .41, .005}]

Compare what happens if magnitudes are fixed, and signs reversed: the tiling is identical except for a mirror flip.

pentagrid[ 3, {-1, -1, -1, -1, -1}, .39 ]
pentagrid[ 3, {1, 1, 1, 1, 1}, .39 ]

Please consider the following sign patterns. We will hold magnitudes fixed at .01, which allows easy comparison of the central decagon.. Our object is to exhaust all possibilities of setting two of the five signs negative, leaving three positive. The number of five things, taken two at a time, is ten. The hemi function returns indices into Range[ n ] (here n=5) of things taken two at a time, that is, {1,2}, {2, 3}, ..., {4,5}. These are not zero-sum pentagrids. We observe that the tilings, neglecting mirror flips, are of but four symmetry-types.

pairdex=hemi[5]
allsgn=Map[ ReplacePart[{1,1,1,1,1}, -1, {{#[[1]]},{#[[2]]}} ]&, pairdex]
Print["There are ", Length[allsgn], " non-zero-sum sign-pair patterns."]
r=.01;
Do[ pentagrid[ 3, allsgn[[k]], {r,r,r,r,r}], {k, Length[ allsgn ]}]

Experiment has shown that, neglecting rotations, the same tilings arise for these subsets of the ten combinations:

{1,2} and {1,5} and {2,3} and {3,4} and {4,5} lead to the “cyclic” central decagon, with four 36-degree rhombs at one vertex..
{1,3} and {1,4} and {2,4} and {2,5} and {3,5} lead to the “winged” tiled center. This gives an arrowed-rhombus, perfect Penrose tiling in which Archangel and Madonna motives are to either side of a line perpendicular to a line of bilateral symmetry.

We write down the indices of the signs for each type, and make the following list:

symm={ {{1,2}, {1,5}, {2,3}, {3,4}, {4,5}}, {{1,3}, {1,4}, {2,4}, {2,5}, {3,5}} }
Length /@ symm

Note that the subsets are of length 5. How does the situation look, graphically? We use the indices as coordinates and assign a different color to each symmetry type.

col={RGBColor[1, .5, .5],RGBColor[.5, .5, 1],
RGBColor[.5, 1, .5],RGBColor[.5, .5, .5]};

Show[ Graphics [{
Table[
	Map[ {col[[k]], Disk[ #, .2 ]}&, symm[[k]] ],
	{k, Length[symm]}],
Table[
	Map[ Text[ ToString[#], #, {0,0}]&, symm[[k]] ],
	{k, Length[symm]}]
}],
Frame->True,
AspectRatio->Automatic];

Was this an accident of the fixed magnitude, .39? Make the same ten tilings from the ten sign patterns, but with magnitude .39.

pairdex=hemi[5]
allsgn=Map[ ReplacePart[{1,1,1,1,1}, -1, {{#[[1]]},{#[[2]]}} ]&, pairdex]
Print["There are ", Length[allsgn], " non-zero-sum sign-pair patterns."]
r=.39;
Do[ pentagrid[ 3, allsgn[[k]], {r,r,r,r,r}], {k, Length[ allsgn ]}]

We see that the same four sets of sign-patterns correspond to two different tiling symmetries. If we were to look at the line arrangements using drawLines[ lns, 5], and use PlotRange to limit our look to a region around the very center of the arrangement, we would find that the two different symmetry-types correspond to two different decagonal tilings, which are seen at the very center, when the magnitudes are small and equal, as in the example above.

Now we recapitulate the above, but make zero-sum pentagrids. Note that if the first four magnitudes are fixed, and these first four offsets sum to zero, then the fifth offset must be zero. If two of the first four signs are negative, two positive, then these four sum to zero. Hence to exhaust all possibilities we need the six combinations of four things, taken two at a time. Now every tiling has just one line of bilateral symmetry.

pairdex=hemi[4]
allsgn=Map[ ReplacePart[{1,1,1,1,1}, -1, {{#[[1]]},{#[[2]]}} ]&, pairdex]
Print["There are ", Length[allsgn], " sign-pair patterns."]
r=.01;
Do[ pentagrid[ 3, allsgn[[k]], {r,r,r,r,0}], {k, Length[ allsgn ]}]

We write down the indices of the signs for each type, and make the following list:

symm={ {{1,2}, {1,3}, {2,4}, {3,4}}, {{1,4}, {2,3}} }
Length /@ symm

Note that the subsets are of length 4 and 2. How does the situation look, graphically? We use the indices as coordinates and assign a different color to each symmetry type.

col={RGBColor[1, .5, .5],RGBColor[.5, .5, 1],
RGBColor[.5, 1, .5],RGBColor[.5, .5, .5]};

Show[ Graphics [{
Table[
	Map[ {col[[k]], Disk[ #, .2 ]}&, symm[[k]] ],
	{k, Length[symm]}],
Table[
	Map[ Text[ ToString[#], #, {0,0}]&, symm[[k]] ],
	{k, Length[symm]}]
}],
Frame->True,
AspectRatio->Automatic];

Let us consider some final cases. Here we use a fixed magnitude and compare the five ways just one of the five offsets can be negative. These are not zero-sum pentagrids. All tilings are the same, differing only by rotation. The central decagon has a signature pattern I call “beaked.”

pentagrid[ 3, {-1, 1, 1, 1, 1}, .01 ]
pentagrid[ 3, {1, -1, 1, 1, 1}, .01 ]
pentagrid[ 3, {1, 1, -1, 1, 1}, .01 ]
pentagrid[ 3, {1, 1, 1, -1, 1}, .01 ]
pentagrid[ 3, {1, 1, 1, 1, -1}, .01 ]

The sixteenth sign-pattern governing the set of five equal magnitudes is simply all signs negative. The number 16 arises as 10 (five things taken two at a time) + 5 (five things taken one at a time) + 1 (five things taken 0, or 5, at a time).

pentagrid[ 3, {-1, -1, -1, -1, -1}, .01 ]

We look at all sixteen sign patterns, and find there are but four symmetry-types, arising as sets of 5, 5, 5, and 1. These are easily recognized by the four types of central decagon in the tilings.

pairdex=hemi[5];
allsgn=Join[
Map[ ReplacePart[{1,1,1,1,1}, -1, {{#[[1]]},{#[[2]]}} ]&, pairdex],
Table[ RotateRight[ {-1,1,1,1,1}, i], {i,0,4}],
{{1,1,1,1,1}}
]
Print["There are ", Length[allsgn], " sign patterns."];
r=.01;
Do[ pentagrid[ 3, allsgn[[k]], {r,r,r,r,r}], {k, Length[ allsgn ]}]

Note that by reversing signs we get thirty-two sign-patterns altogether; but reversing all five signs gives the same tiling, with a mirror flip. So the sixteen above are enough for our purposes.To complete this part of a methodical investigation of tiling spectra, we should pick out four sign-patterns representative of the four symmetry-types encountered, and animate changes in offset between 0.01 and 0.49, in steps of .08.

(*the {1,2} class*)
Do[ pentagrid[ 3, {-1,-1,1,1,1}, k ], {k, .01, .49, .08}]

(*the {1,3} class*)
Do[ pentagrid[ 3, {-1,1,-1,1,1}, k ], {k, .01, .49, .08}]

(*the {1} class*)
Do[ pentagrid[ 3, {-1,1,1,1,1}, k ], {k, .01, .49, .08}]

(*the {1,2,3,4,5} class*)
Do[ pentagrid[ 3, {-1,-1,-1,-1,-1}, k ], {k, .01, .49, .08}]

We have by no means exhausted all possible types of pentagrid.

Note: sometimes it is not easy to pick out changes from one tiling to the next. Double-click on any one image to animate the sequence of tilings, and the differences become apparent.

Do[ pentagrid[ 3, {-1,-1,1,1,1}, {k,k,0,k,k} ], {k, .01, .49, .08}]

Here we let three magnitudes become zero, which force three offsets to zero, which means that hexagons are inescapable.

Do[ pentagrid[ 3, {-1,1,1,1,-1}, {k,0,0,0,k} ], {k, .01, .49, .08}]

Here we let two magnitudes become zero, and set up the the other signs and magnitudes such that the offsets sum to zero: a zero-sum regular pentagrid. Yet—there seem to be places where four, or eight or ten, 36-degree rhombs arise; a violation of Penrose’s arrowed-rhombus pattern. We also increase gridrange to 5 and step through the magnitudes more slowly.

Do[ pentagrid[ 5, {1,1,-1,1,1}, {0, k, 2*k, k, 0} ], {k, .01, .49, .03}]

Such, then, is a first look at the varieties of tilings which arise from pentagrids.

Two Perfect Penrose Tilings

I think of a patch of Penrose as “perfect” when it not only meets matching conditions, but exhibits the largest possible “dragon” designs. I allow the term to apply to any set of 72-degree rhombs meeting edge-to-edge, within the matrix of 36-degree rhombs. The simplest of all these dragons, then, are the stars of five 72-degree rhombs. The most complicated are the “starry” and ”rounded” motifs, which scale larger and larger within the tiling, as the number of lines in the arrangement increases. I sometimes call the starry motif the ”Archangel,” and the rounded motif, the “Madonna.” Archangels and Madonnas interpenetrate in an Escherian luxury of symmetry.

The first pentagrid,with magnitudes all equal to 0.2, gives a tiling centered upon a rounded “Madonna” dragon motif; the latter, magnitudes equal to 0.4, gives a tiling centered upon a starry “Archangel” dragon motif.

pentagrid[ 3, {-1, -1, -1, -1, -1}, .2 ]

pentagrid[ 3, {-1, -1, -1, -1, -1}, .4 ]

Two More Perfect Penrose Tilings: bilateral symmetry

{1,3} and {1,4} and {2,4} and {2,5} and {3,5}

Here please compare an r-sum pentagrid and a zero-sum pentagrid which give the same tiling, divided by a horizontal line of symmetry. A vertical line divides the domains of the Madonnas (left) and Archangels (right).

r=.01;
pentagrid[ 5, {-1, 1, 1, -1, 1}, r ]
pentagrid[ 5, {-1, 1, 1, -1, 1}, {r,r,r,r,0} ]

In Search of Dragons

Within the classic arrowed-rhombus Penrose tiling of 36- and -72-degrees rhombs are “runs” or sequences of 72-degree rhombs which (to me) resemble “dragon designs.” We first make a “perfect” Penrose zonotile, color-sorted, with global sorted list srt. (Several global variables are saved when the pentagrid function is used, notably, xaq (the final graphic), and srt. This has two sublists, the 36- and 72-degree rhombs, as srt[[ 1 ]] and srt[[ 2 ]]. First we choose those of the 72s with centers within 20 units of the origin.

The method devised to find the dragons is slow and awkward.

pentagrid[ 5, {-1, -1, -1, -1, -1}, .4 ]

(*we name the 72-degree rhombs selected "q," an inspired choice.*)
q=Select[ srt[[2]], mag[cent[#]]<40&];
Print["There were ", Length[q], " rhombs selected."];

xa=Graphics[
	{defaultcolorlist[[2]],Polygon /@ q,
	GrayLevel[0],Map[Line /@ tosegs[#]&, q ]}
	];
Show[xa,
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

The search for dragons begins with a single rhomb. Note that one can command-click on the image above and choose Copy to obtain point coordinates, and then select some one rhomb with that point (call it pt) near its center, by writing mag [ cent[#] - pt ] < 1 in the top line of code, below, and find your own dragons.

(*this should work with the example*)
s1=First@Select[ srt[[2]], mag[cent[#]-{-3.55279, -9.47876}]<1&];(*looking for a rhomb near the center*)

xe=Graphics[
	{defaultcolorlist[[2]],Polygon @ s1,
	GrayLevel[0],Line /@ tosegs[s1]}
	];
Show[xe,
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

Now, we find all dragon rhombs to one side of the chosen rhomb, and then all to the other side; we join the two lists, and display. This may take a while. If the dragon forms a closed loop, then we find it twice over; but it is easy to change the code to find it just once.

alldex=Range[Length[q]];
seldex1=First@Position[ q, s1 ];
restdex1=Complement[ alldex, seldex1];


(*go in one direction*)
chosentile=s1;
seldex=seldex1;
restdex=restdex1;

nearest=Select[ q, mag[ cent[#]-cent[chosentile] ]<5&];
s2=Select[ nearest, edgeTest[chosentile, # ]==2& ];

While[Length[s2]>0,
nearest=Select[ q[[restdex]], mag[ cent[#]-cent[chosentile] ]<5&];
s3=Select[ nearest, edgeTest[chosentile, # ]==2& ];
If[s3!={},
seldex=Union[Flatten[ { Map[ First@Position[ q, # ]&, s3 ], seldex} ]];
restdex=Complement[ alldex, seldex];
chosentile=First@s3;(*for iteration*)
s2=s3,
s2={}];
]

(*indices into the list "q"*)
finaldex1=Select[seldex, IntegerQ[#]&]

(*
(*go in the other direction*)
chosentile=s1;
seldex=seldex1;
restdex=restdex1;

nearest=Select[ q, mag[ cent[#]-cent[chosentile] ]<5&];
s2=Select[ nearest, edgeTest[chosentile, # ]==2& ];

While[Length[s2]>0,
nearest=Select[ q[[restdex]], mag[ cent[#]-cent[chosentile] ]<5&];
s3=Select[ nearest, edgeTest[chosentile, # ]==2& ];
If[s3!={},
seldex=Union[Flatten[ { Map[ First@Position[ q, # ]&, s3 ], seldex} ]];
restdex=Complement[ alldex, seldex];
chosentile=Last@s3;(*for iteration*)
s2=s3,
s2={}];
]

(*indices into the list "q"*)
finaldex2=Select[seldex, IntegerQ[#]&]
*)

Length[bothdex=finaldex1];
dra=q[[ bothdex ]];
dragon=Graphics[
	{RGBColor[1,0,0],Polygon /@ dra,
	GrayLevel[0],Map[Line /@ tosegs[#]&, dra ]}
	];
Show[dragon,
Background->GrayLevel[1],
Frame->True,
AspectRatio->Automatic];


Show[{xaq,dragon},
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

restdex=Complement[ alldex, bothdex];
nondra=q[[ restdex ]];(*72ers not in the dragon*)
Print["There are ", Length[dra], " dragon rhombs."];
thra=Select[ srt[[1]], mag[cent[#]]<40&];(*36ers*)
undra=Join[nondra, thra];
Print["There are ", Length[undra], " non-dragon rhombs."];

Dragon Export to POV-Ray

It seemed an interesting challenge to export dragon designs to the free ray-tracer, POV-Ray. I decided to implement POV’s polygon and prism syntax, while retaining the usual spheres and cylinders, for the tiling’s vertices and edges. Two #include files are written, to be called from a sample POV scene file (dragonalia.pov), itself also written, below. To use these files, create a directory for them, and from the Input menu use Get File Path to fill in the SetDirectory function, below.

(*an example; creates global tile list 'zaq'*)
pentagrid[ 2, {-1, -1, -1, -1, -1}, .4 ]

(*we name the 72-degree rhombs selected "q," an inspired choice.*)
q=Select[ srt[[2]], mag[cent[#]]<40&];
Print["There were ", Length[q], " rhombs selected."];

xa=Graphics[
	{defaultcolorlist[[2]],Polygon /@ q,
	GrayLevel[0],Map[Line /@ tosegs[#]&, q ]}
	];
Show[xa,
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

The search for dragons begins with a single rhomb. Here one must command-click on the image above and choose Copy to obtain point coordinates near the center of any one dragon tile, and then paste the coordinates into the red text, below.

(*this should work with the example*)
s1=First@Select[ srt[[2]], mag[cent[#]-{0.535415, -3.2255}]<1&];(*looking for a rhomb near the center*)

xe=Graphics[
	{defaultcolorlist[[2]],Polygon @ s1,
	GrayLevel[0],Line /@ tosegs[s1]}
	];
Show[xe,
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

Now, we find a dragon design, and display. It must form a closed loop. This may take a while.

alldex=Range[Length[q]];
seldex1=First@Position[ q, s1 ];
restdex1=Complement[ alldex, seldex1];


(*go in one direction*)
chosentile=s1;
seldex=seldex1;
restdex=restdex1;

nearest=Select[ q, mag[ cent[#]-cent[chosentile] ]<5&];
s2=Select[ nearest, edgeTest[chosentile, # ]==2& ];

While[Length[s2]>0,
nearest=Select[ q[[restdex]], mag[ cent[#]-cent[chosentile] ]<5&];
s3=Select[ nearest, edgeTest[chosentile, # ]==2& ];
If[s3!={},
seldex=Union[Flatten[ { Map[ First@Position[ q, # ]&, s3 ], seldex} ]];
restdex=Complement[ alldex, seldex];
chosentile=First@s3;(*for iteration*)
s2=s3,
s2={}];
]

(*indices into the list "q"*)
dragondex=Select[seldex, IntegerQ[#]&]
dra=q[[ dragondex ]];
dragon=Graphics[
	{RGBColor[1,0,0],Polygon /@ dra,
	GrayLevel[0],Map[Line /@ tosegs[#]&, dra ]}
	];
Show[dragon,
Background->GrayLevel[1],
Frame->True,
AspectRatio->Automatic];


Show[{xaq,dragon},
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];


restdex=Complement[ alldex, dragondex];
nondra=q[[ restdex ]];(*72ers not in the dragon*)
Print["There are ", Length[dra], " dragon rhombs."];
thra=Select[ srt[[1]], mag[cent[#]]<40&];(*36ers*)
undra=Join[nondra, thra];
Print["There are ", Length[undra], " non-dragon rhombs."];

We discard duplicate vertices and edges and transform to 3D.

(*The Dragon's unique vertices and edges*)
ve=vertedge[dra];
Print["There are ", Length[ ve[[1]] ], " distinct vertices in the tiling"];
Print["There are ", Length[ ve[[2]] ], " distinct edges in the tiling"];
vaq=Graphics[{GrayLevel[0],Map[Line[#]&, ve[[2]] ]}];
Show[vaq,
AspectRatio->Automatic];

(*make vertices 3D*)
verts=make3D[ve[[1]] ];

(*make edges 3D*)
sides=Map[ make3D[#]&, ve[[2]] ];

Now assemble the rest of the tiling in POV format, as polygons, spheres, and cylinders.

(*The UnDragon's unique vertices and edges*)
ve=vertedge[undra];
Print["There are ", Length[ ve[[1]] ], " distinct vertices in the tiling"];
Print["There are ", Length[ ve[[2]] ], " distinct edges in the tiling"];
vaq=Graphics[{GrayLevel[0],Map[Line[#]&, ve[[2]] ]}];
Show[vaq,
AspectRatio->Automatic];

s=colorSort[ undra ];

(*make vertices 3D*)
verts=make3D[ve[[1]] ];

(*make edges 3D*)
sides=Map[ make3D[#]&, ve[[2]] ];

(*non-dragon colors*)
colors={{0,0,1},{.6,.6,1}};

One must choose a directory to write the #include file.

SetDirectory["Macintosh HD :Desktop Folder: povdragon:"]

Write the dragon file, undragon file, and sample scene file.

DragonToPOV["dragon1.inc",dra,verts,sides]
UnDragonToPOV["undragon.inc",s,verts,sides]
Export["dragonalia.pov", scenefile, "Lines"]

The Heptagrid

A “heptagrid” is a set of seven grids. Here again we animate offsets over the critical range, 0 < offset < .5, in steps of .04. We do not use a zero-sum heptagrid, but make the central region a regular heptagon.

Do[
n=7;
maxdist = 3;
rand = Table[
sgn=If[Mod[i,2]==0, 1, -1];
sgn*d,
{i, n}];
dist=Table[ rand[[i]] + Range[-maxdist, maxdist, 1],{i,n}];

lns = Flatten[Table[Chop[N[{Cos[i*(Pi/n)], Sin[i*(Pi/n)], dist[[i,j]]}]],
{i, n}, {j, Length[dist[[i]]]}], 1];

(*Show[drawLines[lns,10],
Frame->True,
PlotRange->{{-1,1},{-1, 1}}];*)
Share[zaq = zonotile[lns]]; 
s = notextcolorSort[zaq];
If[Length[s]<=Length[colorlist],
xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
PlotLabel->ToString[d],
AspectRatio->Automatic];,
Print["Not enough colors!"]
],
{d, 0.01, 0.49, .04}]

Periodic and Quasi-Periodic Tilings

Regular and Archimedean Zonotiles

Squares

Create two sets of k equally spaced lines parallel to the sides of a square. For all such sets the bounding zonogon of the zonotile is a square.

n=2;
dist=Range[-2,2];
lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*display lines within suitable radius*)
Show[drawLines[lns, 5]];

(*create and display*)
Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Regular Hexagons

Create three sets of k equally spaced lines parallel to the sides of an equilateral triangle, with one line in each set through the origin. For all such sets the bounding zonogon of the zonotile is a regular hexagon. If the distances run from 0 to k, a triangular region of hexagons occupies the center of the hexagonal zonotile. If the distances run from -k to k, a hexagonal region of hexagons arises.

n=3;
dist=Range[0,3];(*set to Range[-3,3] for hexagonal region*)
lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*display lines within suitable radius*)
Show[drawLines[lns, 10]];

(*create and display*)
Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Dodecagons, Hexagons, and Squares

Let the sets of lines be centered upon the origin, and of two different spacings, which alternate, to force intersections within a central region of the zonotile. Two “Archimedean” regions of tiles within the zonotile arise, when n=6 and n=4.

n=6;
a=2.0;
dist=Table[
	If[EvenQ[i],f=1,f=N[Sqrt[3]]];
	N[f*Range[-a,a,.5]],
	{i,n}];
lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Octagons and Squares

n=4;
a=2.0;
dist=Table[
	If[EvenQ[i],f=1,f=N[Sqrt[2]]];
	N[f*Range[-a,a,.5]],
	{i,n}];
lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Disguised Symmetry

This zonotile takes about a minute to develop. Since n=12, the bounding zonogon is a regular 24-gon. However, 8-fold symmetry is embedded within the structure of the zonotile (and the arrangement of lines). Try changing the Mod[ i, 3 ] in the definition of dist below.

n=12;
a=1.25;
dist=Table[If[Mod[i,3]==0,f=1,f=N[Sqrt[3]]];
N[f*Range[-a,a,.5]],{i,n}];

lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Stellation and Zonogonal Tilings, 2000

If the lines are chosen such that there are but n of them, like the produced sides of a regular n-gon, then we obtain a core convex n-gon surrounded by intersections marking the vertices of various stellations. These stellations may be regular star polygons or compounds of convex polygons. Associated with each such line set is a zonotile which may be regarded as a hidden-detail removed polar projection of an n-polar zonohedron, or as the “zonogonal completion” of the line set’s core convex n-gon. A special zpolar function was cobbed together to pair the line arrangement with the zonotile. Note the one-to-one correspondence between line intersections and rhombs in the zonotiles.

zpolar[5]

Expansions of Polar Zonohedra

In the middle 1980s, experiments with drawing “polar” projections of polar zonohedra, showed that the same suite of rhombs which composed the projection, could be added to its exterior in various ways, to close up another, larger bounding polygon. The simplest of the addition schemes gave what I came to call the “dodecahedral expansion” of polar zonohedra (because, when a physical model was made, there proved to be rhombic-dodecahedral ridges and valleys). To my surprise this same scheme of rhombic addition can be obtained using line arrangements. Using the zpolarexpand[ n] function below one can quickly review the line arrangements and induced dodecahedral expansions for n from 3 to 15.

First, note how the sides of a regular n-gon, produced, make a line arrangement which dualizes to the “polar projection” of an n-fold polar zonohedron (I call the projection of a polar zonohedron onto a plane orthogonal to its axis of n-fold symmetry the “polar projection”). Here n=9.

n=9;
zpolar[n]
zpolarexpand[n]

To explore other possibilities, and proceed in a more step-by-step manner, use the two code examples below. The essential idea of the line arrangements is as follows: If the lines are chosen such that there are but n of them, like the produced sides of a regular n-gon, then we obtain a core convex n-gon surrounded by intersections marking the vertices of various stellations. These stellations may be regular star polygons or compounds of convex polygons. Associated with each such line set is a zonotile which may be regarded as a hidden-detail removed polar projection of an n-polar zonohedron, or as the “zonogonal completion” of the line set’s core convex n-gon. If we add a second set of lines parallel to each of the first n, and far enough away so as to be beyond the most distant points of intersection of the inner set, we obtain the first dodecahedral expansion.

If we add a third and fourth or however many other sets, farther away yet, and beyond again the most distant previous points of intersection, we obtain the second, third, and so on, dodecahedral expansion of the n-polar zonohedron. All these “dodecahedral expansions” are related to building up hypercubes of edge 2, 3, 4, etc., from a hypercube of edge 1.

Second Dodecahedral Expansion for n=12

n=12;
dist={.5, 4, 15};
If[EvenQ[n],dist=Sort[Join[dist,-dist]] ];
If[ EvenQ[n], n=n/2];

lns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];


(*display lines within suitable radius*)
Show[drawLines[lns, 30]];
zaq=zonotile[lns];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];


z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Partly Perturbed Second Dodecahedral Expansion for n=13

n=13;
dist={.5, 5, 40};
If[EvenQ[n],dist=Sort[Join[dist,-dist]] ];
If[ EvenQ[n], n=n/2];

lns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
If[j>2, dist[[j]]+=j];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];


(*display lines within suitable radius*)
Show[drawLines[lns, 35]];
zaq=zonotile[lns];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];


colorlist={RGBColor[1, 1, 0],RGBColor[1, 0, 0],RGBColor[0, 0, 1],
RGBColor[0.5, 0, 0],RGBColor[0.2, 0.2, 0.6],RGBColor[0.8, 0.4, 1.],
RGBColor[0.6, 0.8, 1.],RGBColor[0.6, 0.2, 0.2],RGBColor[0, 0, 0.8],
RGBColor[0, 0.6, 0.6],RGBColor[1., 0.6, 0],RGBColor[1., 0.8, 1.]};

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Perturbed Third Dodecahedral Expansion for n=13

n=13;
dist={.5, 5, 35,222};
If[EvenQ[n],dist=Sort[Join[dist,-dist]] ];
If[ EvenQ[n], n=n/2];

lns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
If[j>2, dist[[j]]+=j];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];


(*display lines within suitable radius*)
Show[drawLines[lns, 35]];
zaq=zonotile[lns];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];


colorlist={RGBColor[1, 1, 0],RGBColor[1, 0, 0],RGBColor[0, 0, 1],
RGBColor[0.5, 0, 0],RGBColor[0.2, 0.2, 0.6],RGBColor[0.8, 0.4, 1.],
RGBColor[0.6, 0.8, 1.],RGBColor[0.6, 0.2, 0.2],RGBColor[0, 0, 0.8],
RGBColor[0, 0.6, 0.6],RGBColor[1., 0.6, 0],RGBColor[1., 0.8, 1.]};

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Central 2n-gon surrounded by rhombs

An alternation in sign is applied to the line distances, which go from 0 to 3 (or more). When n is odd, the n lines through the origin give a regular 2n-gon at the center of the zonotile, surrounded by rhombs.

n=7;
dist={0,1,2,3};
lns=Flatten[Table[
f=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], f*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*display lines within suitable radius*)
Show[drawLines[lns, 10]];

Create the zonotile and sort polygons by area; a randomized RGB coloring is applied.

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Central rhombs with higher zonogons at periphery

An alternation in sign is applied to the pairs of line distances, which are set to {-1,1+(N[2*Cos[Pi/n]])}. When n is odd, n “higher” zonogons (usually octagons) arise near the periphery of the zonotile, with rhombs near the center..

n=7;
dist={-1,1+(N[2*Cos[Pi/n]])}
lns=Flatten[Table[
f=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], f*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*display lines within suitable radius*)
Show[drawLines[lns, 15]];

Create the zonotile and sort polygons by area; a randomized RGB coloring is applied.

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Row of 2n-gons

These curious zonotiles arise for integers {n, k}, n>=2, k>=1, in which k lines are taken perpendicular to each of n unit vectors. A horizontal band of k regular 2n-gons bisects the zonotile. This works to best effect for n odd.

n=7;(*number of directions*)
linenumber=4;(*number of lines in each set*)
lns1=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], j*Cos[i*Pi/n] }]],
{i,n},{j,linenumber}],1];
Print["There are ", Length[lns1]," lines at first"];

(*crude crude sort into cyclical order*)
lns=Sort[vunion[lns1], (#1[[1]]>#2[[1]])&];

Print["There are ", Length[lns]," lines altogether"];

(*display lines within suitable radius*)
Show[drawLines[lns, 20]];


Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Row of 2n-gons II

n=5;
d=6;
dist=Table[If[Mod[i,2]==0, f=-1, f=N[((1+Sqrt[5])/2)] ];
N[f*Range[-d,d,1]],{i,n}];

lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];

colorlist=Table[
	RGBColor[
	  Random[Real,{0,1}],
	  Random[Real,{0,1}],
	  Random[Real,{0,1}]],
{Length[s]}];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Ring of  Regular 2n-gons

Added in late 2004. I especially like n=5, k=5; but by all means compare, say n=5, k=1, 2, 3, 4, 5, etc., with all due respect for the number of lines passed to the zonotile function. The 2*n*k 2n-gons divide the zonotile into a “flowery” interior and a “rhombic” exterior. A careful examination of the line arrangement (drag the graphic out larger, below) will show why the thirty regular decagons (in this example, n=5, k=3) make such a neat division of the zonotile into its flowery and rhombic kingdoms: only on or inside this boundary do all n directions come into play. Beyond the boundary, only subsets of the n directions can be involved in intersections, until at last, any one direction can meet but one other, and then even these rare matings end, and then away go the lines into infinite space, never to meet again.

n=5;(*n symmetrical unit vectors*)
k=3;(*a ring of 2*n*k 2ngons arises in the zonotile*)
t=n*k;(*number of 2ngon in ring*)
dist=Table[ N[Cos[i*Pi/t] ], {i,0,t}]
lns=Flatten[Table[
sgn=If[ EvenQ[i], -1, 1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"]

(*display lines within suitable radius*)
Show[drawLines[lns, 5],Frame->True];

Timing[ Share[zaq=zonotile[lns]] ][[1]]
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

(*Make 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]}];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Ring of  Regular 2k-gons

Added in late 2004. Much like the Ring of Regular 2n-gons subsection, above, except here we use divisors j of n, rather than multiples. A set of k=n/j independent vectors traces out, “determines,” a 2k-gon. If the vectors are of equal magnitude and symmetrically disposed, the 2k-gon may be regular. In the example, twenty-four regular octagons lie on a ring. Set j=4, and twenty-four regular hexagons would form a ring; set j=2, and twenty-four regular dodecagons would arise.

n=12;(*n symmetrical unit vectors*)
j=3;
k=n/j;(*a ring of 2*n (2*n*k)-gons arises in the zonotile*)
dist=Table[ N[Cos[i*Pi/k] ], {i,0,k}]
lns=Flatten[Table[
sgn=If[ EvenQ[i], -1, 1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"]

(*display lines within suitable radius*)
Show[drawLines[lns, 5],Frame->True];

Timing[ Share[zaq=zonotile[lns]] ][[1]]
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

(*Make 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]}];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Stars and Hexagons

This line arrangement gives a nice mixture of regular hexagons with stars of 60-degree rhombs.

n=3;
dist={-8,-7,-5, -4, -2, -1, 1, 2, 4, 5, 7, 8};

lns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

(*simple colors*)
colorlist={
RGBColor[1,0,0],
RGBColor[0,0,.5]
};

If[Length[s]<=Length[colorlist],
xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];,
Print["Not enough colors!"]
]

Spiralia

Here an attempt is made to make a line arrangement follow a spiral. A small amount of random offset is added to the distances.

n=12;
spi=4;
dist=Table[sgn=If[EvenQ[k],-1,1];
N[sgn*( Random[Real,{.01,.02}] + (i+(k-1)*n))],{i,n},{k,spi}]

lns=Flatten[Table[
Chop[N[ { Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] } ]],
{i,n}, {j, Length[dist[[i]]]}],1];

lns=fixLines[lns];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 50]];

Share[zaq=zonotile[lns]];
s=notextcolorSort[ zaq ];

(*Set up your own list of colors*)
colorlist1={
RGBColor[1,0,0],RGBColor[.3,.3,1],RGBColor[1,1,0],
RGBColor[0,0,1],RGBColor[1,.4,.4],RGBColor[.4,.4,.4],
RGBColor[.5,0,0],RGBColor[0,1,0]};

colorlist=If[Length[s]<=Length[colorlist1], colorlist1, Table[
RGBColor[Random[Real,{0,1}],Random[Real,{0,1}],Random[Real,{0,1}]],
{Length[s]}]];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Old and Odd Examples

Restless experimentation with line arrangements led to these odd and old examples.

Hexagonal Penrose

n=6;
dist=Table[If[i==4 || i==5, f=1, f=1.5 ];(*try 1.4, other numbers*)
N[f+Range[-2,2,1]],{i,n}];

lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

colorlist={RGBColor[1,1,0],RGBColor[1,.5,.5],RGBColor[1,0,0],RGBColor[0,0,1]};

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Hexagonal Penrose 2

n=6;
dist=Table[If[i==1 || i==2, f=1, f=Sqrt[2] ];
N[(f)+Range[-1,1,.5]],{i,n}];

lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

colorlist={RGBColor[1,1,0],RGBColor[.5,0,0],RGBColor[0,0,.75],RGBColor[.5,.5,1]};

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Hexagonal Penrose 3

n=12;
dist=Table[If[i==1 || i==2, f=1, f=Sqrt[2] ];
N[(f)+Range[-3,2,1]],{i,n}];

lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

colorlist={RGBColor[1., 0, 0],RGBColor[1., 1., 0],RGBColor[0, 0, 1.],RGBColor[0.4, 0.4, 0],RGBColor[0.2, 0.8, 0.6],RGBColor[0.8, 0.4, 1.],RGBColor[0.6, 0.8, 1.],RGBColor[0.6, 0.2, 0.2],RGBColor[0, 0, 0.8],RGBColor[0, 0.6, 0.6],RGBColor[1., 0.6, 0],RGBColor[1., 0.8, 1.],RGBColor[0.2, 0.2, 0.8]};

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Hexagonal Penrose 4

n=12;
dist=Table[If[i==3 || i==4, f=1, f=Sqrt[3] ];
N[(f)+Range[-5,5,1]],{i,n}];

lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i, 1,n,2}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

colorlist={RGBColor[1., 0, 0],RGBColor[1., 1., 0],RGBColor[0, 0, 1.],RGBColor[0.4, 0.4, 0],RGBColor[0.2, 0.8, 0.6],RGBColor[0.8, 0.4, 1.],RGBColor[0.6, 0.8, 1.],RGBColor[0.6, 0.2, 0.2],RGBColor[0, 0, 0.8],RGBColor[0, 0.6, 0.6],RGBColor[1., 0.6, 0],RGBColor[1., 0.8, 1.],RGBColor[0.2, 0.2, 0.8]};

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Disrupted Symmetry 1

Note red code. Try changing the Mod to 2 or 4 or 6. A somewhat remarkable hexagonal tiling arises.

n=12;
dist=Table[ f=If[Mod[i,3]==0, 1, Cos[Pi/n] ];
N[f*(Range[-1,1,1])],{i,n}];

lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

colorlist=Table[
	RGBColor[
	  Random[Real,{0,1}],
	  Random[Real,{0,1}],
	  Random[Real,{0,1}]],
{Length[s]}];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

A chance to create a different random colorlist.

colorlist=Table[
	RGBColor[
	  Random[Real,{0,1}],
	  Random[Real,{0,1}],
	  Random[Real,{0,1}]],
{Length[s]}];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Disrupted Symmetry 2

n=12;
d=4/2;
dist=Table[If[Mod[i-1,2]==0,f=-1,f=2];(*try Mod[i,3], Mod[i,4], etc.*)
N[f*Range[-d,d,1]],{i,n}];

lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n],
(*randomize line distances if away from center*)
If[Abs[ dist[[i,j]] ]>1, Random[Real,{-.1,.1}] + dist[[i,j]], dist[[i,j]] ] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Non-equilateral zonotiles

The distances of the lines, and thus the magnitudes of the vectors determining the zonotile, may be modified to give non-equilateral zonotiles.

n=5;
dist=Range[-2,2];
lns=Flatten[Table[
f=If[EvenQ[i],1,2];
f*Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*display lines within suitable radius*)
Show[drawLines[lns, 20]];

Create the zonotile and sort polygons by area; a randomized RGB coloring is applied.

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Non-equilateral zonotiles: gray strips

n=10;
factor=2;
r=5/2;
dist=Range[-r,r,1];
lns=Flatten[Table[
f=If[Mod[i,factor]==0,1,3];
f*Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], Random[Real,{-.2,.3}] + dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*display lines within suitable radius*)
Show[drawLines[lns, 20]];

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];

(*Set up your own list of colors*)
colorlist={
GrayLevel[1],
GrayLevel[.8],
GrayLevel[.6],
GrayLevel[.4],
GrayLevel[.2],
RGBColor[1,0,0],
RGBColor[0,0,1],
RGBColor[.7,.7,1],
RGBColor[1,1,0],
RGBColor[0,0,.5],
RGBColor[.3,.3,.3],
RGBColor[.5,0,0]};

If[Length[s]<=Length[colorlist],
xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];,
Print["Not enough colors!"]
]

Non-equilateral zonotiles: gray hexagons

n=6;
dist=Table[If[i==3 || i==4, f=1, f=3/2 ];(*try 1.4, other numbers*)
N[f+Range[-3,2,1]],{i,n}];

lns=Flatten[Table[
f=If[Mod[i,2]==0,1,2];
f*
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];

colorlist={RGBColor[1,1,0],RGBColor[.3,.3,1],RGBColor[1,0,0],RGBColor[0,0,1],RGBColor[.5,0,0],RGBColor[.7,.7,.7]};

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Beyond Flatland

Also see Bitten Wieringa Roofs in the Bitten Zonotiles section.

Lofting into the Third Dimension: Rhombic Roofs

When the sets of parallel lines are chosen such that no more than two lines intersect at any point, and only rhombs can arise, it is possible to “loft” the zonotile into three dimensions. After making the “sign vectors” we step through the list of lines, adding alternately positive and negative z coordinates. In the example below, z=.707. Spurious polygons arise around the edges of the zonotile, but these are stripped away by selecting only polygons of four sides (the rhombs). The method fails entirely if any “higher” zonogons (hexagons, octagons, etc.) arise within the zonotile.

Here a Penrose-like tiling is created, for the 3D surface. This seems much like what has been called a Wieringa roof.

Trying varying n and maxdist and the slope of the vectors, here .707, and also change Mod[ i - 1, k] (here k=2) to any of k=1, 2, 3, ..., n.

It is fruitful to settle upon an attractive set of lines, such as in the example, with n=5, maxdist=5, slope=.707, and then divide the cell below at the comment reading “divide cell here ... .” Then one can experiment freely with changing the signs of the z coordinates, using Mod or any other scheme.

n = 5; (*number of vectors*)
maxdist = 5; (* (2*maxdist+1) lines per vector *) 
dist = Table[sgn=If[EvenQ[i],-1,1];
N[ sgn* (Random[Real, {0.01, 0.02}] + Range[-maxdist, maxdist, 1]) ],
 {i, n}]; 
lns = Flatten[Table[Chop[N[{Cos[i*(Pi/n)], Sin[i*(Pi/n)], dist[[i,j]]}]],
  {i, n}, {j, Length[dist[[i]]]}], 1]; 
Print["There are ", Length[lns], " lines altogether"]
Show[drawLines[lns, 15]];


(*divide cell here for comparison of sign effects*) 
(*create and display 3D zonotile*)

(*from 2D homogenous to 3D Cartesian, z = +/- .707*)
lns2=Table[sgn=If[ Mod[i-1,2]==0,1,-1];
Join[lns[[i,{1,2}]],sgn*{.707}], {i,Length[lns]}];


Share[

(*make list of sign vectors*)
a=Table[
  Table[
    Table[
      Sign[Chop[Det[ {lns[[i]],lns[[k]],lns[[j]]} ] ] ],
    {i,Length[lns]}],
  {j,k+1,Length[lns]}],
{k,Length[lns]-1}];

b=Union[Flatten[a,1]];


(*find polygons, some degenerate*)
zaq=Table[
pt={0,0,0};
Do[ If[ b[[k,j]]==1,
     rmoveto[pt, lns2[[j]] ],
     rmoveto[pt, -lns2[[j]] ]
    ],
{j,Length[lns]}];

t1=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt,2*lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
   
t2=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt, 2*-lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
 
toPoly[Join[t1,t2]],
{k,1,Length[b]}]
];

(*discard degenerate polygons*)
poly=Select[Cases[zaq,{{_,_,_},{_,_,_},{_,_,_}..},Infinity],
Length[#]==4&];
Print["There are ",Length[poly]," rhombs in the zonotile"];

(*display*)
Show[Graphics3D[{EdgeForm[],Polygon /@ poly}],
ViewPoint->2.5*unit[{0,0,2}],
Boxed->False,
PlotRange->All,
Background->GrayLevel[0]];

Animation of 3D slope

Here a Do loop is used to change the z coordinate or slope of the 3D vectors, going from -1 to 1 in steps of 0.2. It is assumed that the input cell above has already been evaluated.

(*create animation of slope*)
Do[

(*from 2D homogenous to 3D Cartesian, z = +/- .707*)
lns2=Table[sgn=If[ Mod[i-1,2]==0,1,-1];
Join[lns[[i,{1,2}]],sgn*{slope}], {i,Length[lns]}];


Share[

(*make list of sign vectors*)
a=Table[
  Table[
    Table[
      Sign[Chop[Det[ {lns[[i]],lns[[k]],lns[[j]]} ] ] ],
    {i,Length[lns]}],
  {j,k+1,Length[lns]}],
{k,Length[lns]-1}];

b=Union[Flatten[a,1]];


(*find polygons, some degenerate*)
zaq=Table[
pt={0,0,0};
Do[ If[ b[[k,j]]==1,
     rmoveto[pt, lns2[[j]] ],
     rmoveto[pt, -lns2[[j]] ]
    ],
{j,Length[lns]}];

t1=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt,2*lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
   
t2=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt, 2*-lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
 
toPoly[Join[t1,t2]],
{k,1,Length[b]}]
];

(*discard degenerate polygons*)
poly=Select[Cases[zaq,{{_,_,_},{_,_,_},{_,_,_}..},Infinity],
Length[#]==4&];

(*display*)
Show[Graphics3D[{EdgeForm[],Polygon /@ poly}],
ViewPoint->2.5*unit[{0,-1,2}],
Boxed->False,
PlotRange->All,
Background->GrayLevel[0]],
{slope,-1,1,.2}];

Lofting II: Arrowed Rhombs

Can we make a true Weiringa roof from an arrowed-rhombus, perfect Penrose tiling? That is what is attempted here. In the subsection above, choice of which edges (vectors) have positive z and which negative, is not quite random, but might as well be. Here we match up the signs of the z coordinates with the signs of the grid offsets.

Like so many examples in this notebook, this one requires evaluating the input cells in sequence, from top to bottom.

A loft3D[ lns, k, dex, mag] function was contrived, which assumes that the tiling is rhombic, and that the five grids have an equal number of lines, and that two of the five offset signs are negative. It takes four inputs:

1. lns is the raw list of lines in an arrangement. It is left global in the pentagrid function, for instance.
2. k is the gridrange: before offset, the lines in a grid are at distances Range[ -k, k, 1].
3. dex is the indices into {1,2,3,4,5} of which two offsets are negative.
4. mag is the single fixed non-negative magnitude of offset.

The loft3D function is found in the Grout subsection of the Initialization section.

In the particular example used here, a perfect Penrose tiling of Madonna motif is made and then lofted. For the Archangel motif, use pentagrid[ k, sgn, .39 ]. Note that below we have loft3D[ lns, k, dex, .49 ]; if we set the magnitude of z = 0.5, then all rhombs in the roof have the same shape (being equivalent to the faces of an n=5 polar zonohedron whose edges make the angle arc tan 2 to the axis of 5-fold symmetry). Here we set z = 0.49 so that the rhombs of the roof have two very slightly different shapes, and thus can be easily separated and colored.

k=5;
sgn={1, -1, 1, -1, 1};
dex=Flatten[Position[ sgn, -1]];
pentagrid[ k, sgn, .2 ](*leaves "lns" global*)

Show[ xaq3D=loft3D[lns, k, dex, .49],
ViewPoint->2.5*unit[{0,0,2}],
Boxed->False,
PlotRange->All,
Background->GrayLevel[0]];

Next we loft the plane tiling into 3D with z=0, translate the “roof” ten units into positive z, and color-sort both polygon lists.

colorlist={RGBColor[0,0,1],RGBColor[1,0,0],RGBColor[1,1,0]};(*set up a few colors*)

rho2D=Select[Cases[zaq,{{_,_},{_,_},{_,_}..},Infinity],
Length[#]==4&];
tfloor=Table[ Map[ Join[#[[{1,2}]],{0}]&, rho2D[[i]] ], {i,Length[rho2D]}];
(*split the polygons into lists according to area*)
s1=colorSort3D[tfloor];

troof=trans[Polygon /@ poly3D, {0,0,10}];(*translate roof up ten units*)
s2=colorSort3D[troof];

Now, apply colors to the tiles of floor and roof , display each, and display both together.

xaq1=Graphics3D[
{EdgeForm[GrayLevel[0]],
	Table[ {SurfaceColor[colorlist[[i]],GrayLevel[.5], 5 ],
		Polygon /@ s1[[ i ]]}, {i,Length[s1]}]
}];
Show[xaq1,
LightSources -> 
   {
   {{-1,0,2}, RGBColor[1, 1, 1]},
   {{1,1,0}, RGBColor[1, 1, 1]}
   },
Boxed->False,
Background->GrayLevel[0],
ViewPoint->2.25*unit[ {0,-1,2} ] ];


xaq2=Graphics3D[
{EdgeForm[GrayLevel[0]],
	Table[ {SurfaceColor[colorlist[[i]],GrayLevel[.5], 5 ],
		Polygon /@ s2[[ i ]]}, {i,Length[s2]}]
}];
Show[xaq2,
LightSources -> 
   {
   (*{ {-1,1,1}, RGBColor[1, 1, 1] },*)
   { {0,-1,1}, RGBColor[1, 1, 1] }
   },
Boxed->False,
Background->GrayLevel[0],
ViewPoint->2.5*unit[ {0,0,3} ] ];


Show[{xaq1,xaq2},
LightSources -> 
   {
   (*{{-1,0,2}, RGBColor[1, 1, 1]},*)
   { {0,1,1}, RGBColor[1, 1, 1] }
   },
Boxed->True,
Axes->True,
Background->GrayLevel[0],
ViewPoint->2.5*unit[ {.3,-3,2.5} ] ];

3D Expansions of Polar Zonohedra

Note the three distances, {1, 10, 100}, chosen so that the outer sets of lines are beyond all points of intersection of any inner sets of lines. A fourth distance might be 1000 (try adding this). We could calculate what would be needed, but this works up to n=20 for “dodecahedral” expansions of polar zonohedra. However, the expansions are not quite the same as I originally imagined, in fact, a bewildering variety arise. Use of RealTime3D helps to visualize the peculiar surfaces.

n=11;
dist={1, 10, 100};
If[EvenQ[n],dist=Sort[Join[dist,-dist]] ];
If[ EvenQ[n], n=n/2];

lns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
(*If[j>1, dist[[j]]+=j];*)
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 20]];
(*create and display 3D zonotile*)

(*from 2D homogenous to 3D Cartesian, z = +/- .707*)
lns2=Table[f=If[ Mod[i,2]==0,1,-1];
Join[lns[[i,{1,2}]], f*{.5}], {i,Length[lns]}];


Share[

(*make list of sign vectors*)
a=Table[
  Table[
    Table[
      Sign[Chop[Det[ {lns[[i]],lns[[k]],lns[[j]]} ] ] ],
    {i,Length[lns]}],
  {j,k+1,Length[lns]}],
{k,Length[lns]-1}];

b=Union[Flatten[a,1]];


(*find polygons, some degenerate*)
zaq=Table[
pt={0,0,0};
Do[ If[ b[[k,j]]==1,
     rmoveto[pt, lns2[[j]] ],
     rmoveto[pt, -lns2[[j]] ]
    ],
{j,Length[lns]}];

t1=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt,2*lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
   
t2=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt, 2*-lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
 
toPoly[Join[t1,t2]],
{k,1,Length[b]}]
];

(*discard degenerate polygons*)
poly=Select[Cases[zaq,{{_,_,_},{_,_,_},{_,_,_}..},Infinity],
Length[#]==4&];
Print["There are ",Length[poly]," rhombs in the zonotile"];

(*display*)
Show[zaq=Graphics3D[Polygon /@ poly],
ViewPoint->2.5*unit[{0,0,2}],
Boxed->False,
PlotRange->All,
Background->GrayLevel[0]];

Bitten Zonotiles

Mod Experiment: “Bitten” Zonotiles

Discussion

These unusual zonotiles have a convoluted history. There are certain non-convex rhombic polyhedra I call k-armed spirallohedra, and when k=3 or k=4, these spirallohedra close-pack to fill space, much after the manner of cubes or rhombic dodecahedra, respectively. I experimented taking plane sections of packings of these two types of spirallohedra, and found special sections which induced tilings of the sectioning plane by congruent irregular non-convex polygons. These polygons had two or three shallow “bites” taken from them.

At almost the same time, while contriving strange new line arrangements for zonotiles, I stumbled upon the idea of setting the {x, y, distance} triples such that the distances were set to Mod[ i-1, kmod], where kmod was some divisor of n, and i was the iterator in the Table loop which creates the list of vectors. I noticed was that in some cases I obtained a zonotile with a neat little region of rhombs or mixed rhombs and hexagons, near its boundary, such that a smoothly curved bite could be taken out. I soon found how to make two such regions. Eventually I hit upon the following expression for the distance: Mod[i-1,kmod] - ((kmod-1)/2) } ]. Roughly speaking, this allows the creation of n/kmod exactly equal, adjacent, congruent regions along part of the periphery of the zonotile. The cases when two regions or three regions are removed closely resemble the “special sections” of the 3- and 4-armed spirallohedral arrays. The regions are convex and are bounded by series of edges corresponding to vectors taken in strict cyclic or anti-cyclic order; they are 2kmod-gons, tiled by smaller zonogons. In some cases such a region is merely a rhomb or a hexagon.

In one subsection below, we force line intersections to obtain bites as pure 2kmod-gons, rather than regions of rhombs, etc.

Suppose the n/kmod regions are in fact removed (as they are in examples, below). It occurred to me that, much in the way that the resulting non-convex polygon might be called a “bitten” zonogon, so also the spirallohedra themselves might be thought of as “bitten” zonohedra—for they may be constructed from polar zonohedra (dissected in a special way into rhombic hexahedra) by subtracting congruent regions of those hexahedra.

If this analogy has any merit, it might well generalize to higher spaces, to a whole class of bitten zonotopes. However, that is very uncertain! What is certain is that, when the bites are two or three, and all equal, and affect one-half the periphery of the zonogon (zonotile, here), the bitten figure tiles the plane. Examples are found below.

It is fruitful to compare odd, singly-even, and doubly-even n in the following cell. A coloring-by-area algorithm s applied to help pick out the congruent regions; since the colors are chosen at random, re-evaluation will give a different set of colors, which may be more pleasing. These pairs of {n, kmod} give representative results:

1. {24, 8} gives a 48-gon tiled by rhombs. Three regions are centered upon the “top” of the zonotile.
2. {12, 6} gives a 24-gon tiled by rhombs. Two regions.
3. {18, 9} gives a 36-gon tiled mostly by rhombs, but with hexagons within the two regions.
4. {25, 5} gives a 50-gon tiled by rhombs and many types of “higher” zonogons. Five regions.
5. {20, 5} gives a 40-gon tiled by rhombs and many higher zonogons. Four regions.
6. {20, 4} gives a 40-gon tiled by rhombs only. Five regions.

The smaller “legal” pairs of integers {n, kmod} are {4,2}, {6,2}, {6,3}, {8,2}, {8,4}, and {9,3}.

Example

(*the idea, get bilateral symmetry; n/kmod=number of subtractable regions*)
(*compare odd n, singly-even, and doubly-even n*)
n=12;(*bounded by a regular 2n-gon*)
kmod=4;(*the lines displaced mod kmod minus an offset*)
rot=((Pi/2)+(Pi/(2*n)));(*rotate to vertical*)
lns=Table[
Chop[N[{ Cos[-rot+(i*Pi/n)], Sin[-rot+(i*Pi/n)], Mod[i-1,kmod]-((kmod-1)/2) } ]],
{i,n}];

(*display line arrangement within suitable radius*)
radius=25;
Show[drawLines[lns, radius],
Frame->True];

Share[zaq=zonotile[lns]];

s=colorSort[ zaq ];

colorlist=Table[RGBColor[Random[Real,{0,1}],
		Random[Real,{0,1}],
		Random[Real,{0,1}]],{Length[s]}];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{colorlist[[k]],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[1],
Frame->True,
AspectRatio->Automatic];

(*what about 'kmod'? loop through kmods*)
Do[
n=12;(*bounded by a regular 2n-gon*)

rot=((Pi/2)+(Pi/(2*n)));(*rotate to vertical*)
lns=Table[
Chop[N[{ Cos[-rot+(i*Pi/n)], Sin[-rot+(i*Pi/n)], Mod[i-1,kmod]-((kmod-1)/2) } ]],
{i,n}];

Share[zaq=zonotile[lns]];

s=notextcolorSort[ zaq ];

colorlist=Table[RGBColor[Random[Real,{0,1}],
		Random[Real,{0,1}],
		Random[Real,{0,1}]],{Length[s]}];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{colorlist[[k]],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[1],
PlotLabel->ToString[kmod],
AspectRatio->Automatic],
{kmod,2,2*n,1}];

In the cell below we loop through a variety of displacements, to see how the resulting zonotile changes.

(*change colorlist if desired*)
colorlist=Table[RGBColor[Random[Real,{0,1}],
		Random[Real,{0,1}],
		Random[Real,{0,1}]],{100}];

nudge=Random[Real,{.001,.002}];
(*what does the "mod zonotile" look like at different displacements?*)
n=24;
kmod=12;
Do[(*loop through displacements*)

rot=((Pi/2)+(Pi/(2*n)));(*rotate to vertical*)
lns=Table[
Chop[N[{ Cos[-rot+(i*Pi/n)], Sin[-rot+(i*Pi/n)], Mod[i-1,kmod]-offset } ]],
{i,n}];

Share[zaq=zonotile[lns]];
s=notextcolorSort[ zaq ];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{colorlist[[k]],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
PlotLabel->ToString[offset],
Background->GrayLevel[0],
AspectRatio->Automatic],

{offset,-12-nudge, 12-nudge,.5}];(*the displacements*)

Two-Bite Tiles and Tilings

Now we actually take the bites from the zonotile. First, a two-bite zonotile is created. Possible values for n are 4, 6, 8, 10, etc.

(*the idea, get bilateral symmetry; n/kmod=number of subtractable regions*)
(*compare odd n, singly-even, and doubly-even n*)
n=12;(*bounded by a regular 2n-gon*)
kmod=n/2;(*the lines displaced mod kmod minus an offset*)
rot=((Pi/2)+(Pi/(2*n)));(*rotate to vertical*)
lns=Table[
Chop[N[{ Cos[-rot+(i*Pi/n)], Sin[-rot+(i*Pi/n)], Mod[i-1,kmod]-((kmod-1)/2) } ]],
{i,n}];

(*display line arrangement within suitable radius*)
radius=25;
Show[drawLines[lns, radius],
Frame->True];

Share[zaq=zonotile[lns]];
sca=Max[ First /@ Chop[ Flatten[zaq,1] ] ]; (*scale factor, to reduce to unit circumradius*)
zaq=Chop[ (1/sca)*zaq ]; (*scale down to unit circumradius*)

Length[zaq]
Length[ bite1=Chop[ Select[zaq, (mag[ {1,1}-Chop[cent[#]] ])<1&] ] ]
Length[ bite2=Chop[ Select[zaq, (mag[ {-1,1}-Chop[cent[#]] ])<1&] ] ]
Length[ bitten=Chop[ Select[zaq, 
((mag[ {-1,1}-Chop[cent[#]] ]>1) &&
(mag[ {1,1}-Chop[cent[#]] ]>1) )&] ] ]

s=colorSort[ bitten ];

colorlist=Table[RGBColor[Random[Real,{0,1}],
		Random[Real,{0,1}],
		Random[Real,{0,1}]],{Length[s]}];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{colorlist[[k]],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Now, make the tiling.

t2={{1,1},{-1,1}};(*for two-bite zonogons*)
latticepoints=make2Darray[{5,5},t2];(*make lattice*)
region=Select[latticepoints, mag[#]<4&];(*select points near origin*)
pack=Map[trans[xaq,#]&, 1.05*region];(*exploded by writing "1.05*region"*)

Show[{pack},
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

Three-Bite Tiles and Tilings

And here, a three-bite zonotile. Possible values for n are 6, 9, 12, 15, etc.

(*the idea, get bilateral symmetry; n/kmod=number of subtractable regions*)
(*compare odd n, singly-even, and doubly-even n*)
n=12;(*bounded by a regular 2n-gon*)
kmod=n/3;(*the lines displaced mod kmod minus an offset*)
rot=((Pi/2)+(Pi/(2*n)));(*rotate to vertical*)
lns=Table[
Chop[N[{ Cos[-rot+(i*Pi/n)], Sin[-rot+(i*Pi/n)], Mod[i-1,kmod]-((kmod-1)/2) } ]],
{i,n}];

(*display line arrangement within suitable radius*)
radius=25;
Show[drawLines[lns, radius],
Frame->True];

Share[zaq=zonotile[lns]];
sca=Max[ First /@ Chop[ Flatten[zaq,1] ] ]; (*scale factor, to reduce to unit circumradius*)
zaq=Chop[ (1/sca)*zaq ]; (*scale down to unit circumradius*)

Length[zaq]
Length[ bite1=Chop[ Select[zaq, (mag[ {1.5, Sqrt[3/4]}-Chop[cent[#]] ])<1&] ] ]
Length[ bite2=Chop[ Select[zaq, (mag[ {-1.5, Sqrt[3/4]}-Chop[cent[#]] ])<1&] ] ]
Length[ bite3=Chop[ Select[zaq, (mag[ {0,Sqrt[3]}-Chop[cent[#]] ])<1&] ] ]
Length[ bitten=Chop[ Select[zaq, 
(
(mag[ {1.5, Sqrt[3/4]}-Chop[cent[#]] ]>1) &&
(mag[ {-1.5, Sqrt[3/4]}-Chop[cent[#]] ]>1) &&
(mag[ {0,Sqrt[3]}-Chop[cent[#]] ]>1)
)&] ] ]

s=colorSort[ bitten ];

colorlist=Table[RGBColor[Random[Real,{0,1}],
		Random[Real,{0,1}],
		Random[Real,{0,1}]],{Length[s]}];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{colorlist[[k]],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Now, make the tiling.

t3={{1.5, Sqrt[3/4]},{0,Sqrt[3]}};(*for three-bite zonogons*)
latticepoints=make2Darray[{5,5},t3];(*make lattice*)
region=Select[latticepoints, mag[#]<4&];(*select points near origin*)
pack=Map[trans[xaq,#]&, 1.01*region];(*exploded by writing "1.05*region"*)

Show[{pack},
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

Forcing Line Intersections: Bites as Single Zonogons

Create Lines Which Determine a k-bite Zonotile

(*the idea, get bilateral symmetry; n/kmod=number of subtractable regions*)
(*compare odd n, singly-even, and doubly-even n*)
n=24;(*bounded by a regular 2n-gon*)
bitenumber=3;(*set number of bites*)
kmod=n/bitenumber;(*the lines displaced mod kmod minus an offset*)
rot=((Pi/2)+(Pi/(2*n)));(*rotate to vertical*)
lns=Table[
Chop[N[{ Cos[-rot+(i*Pi/n)], Sin[-rot+(i*Pi/n)], Mod[i-1,kmod]-((kmod-1)/2) } ]],
{i,n}];


(*find all points of intersection*)
pts=findpoints[ lns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[{drawLines[lns, radius], redpts}];

Find “Representative” Points

(*method to obtain actual points*)
(*relies upon ordering of lines*)
chk=Map[{First[#], Last[#]}&, seldex=Partition[Range[n], kmod]]
pt=Table[
t=lns[[ chk[[k]] ]];
Chop[newinter2lines[ {t[[1]], t[[2]]} ]],
{k, Length[chk]}]
Length[pt]

Find Compensatory Distances and Re-form Line List

Do[
selpt=pt[[k]];
thelines=Map[#[[{1,2}]]&, lns[[ seldex[[k]] ]] ];
newlns=Map[ Join[#, {selpt.#}]&, thelines];(*join 'em up*)
lns=ReplacePart[lns, newlns, List /@ seldex[[k]], List /@ Range[Length[newlns]] ],
{k, Length[seldex]}];
(*display line arrangement within suitable radius*)
Show[newdrawLines[lns, radius],
Frame->True];

Share[zaq=zonotile[lns]];
sca=Max[ First /@ Chop[ Flatten[zaq,1] ] ]; (*scale factor, to reduce to unit circumradius*)
zaq=Chop[ (1/sca)*zaq ]; (*scale down to unit circumradius*)

Construct Zonotile

s=colorSort[ zaq ];

colorlist=Table[RGBColor[Random[Real,{0,1}],
		Random[Real,{0,1}],
		Random[Real,{0,1}]],{Length[s]}];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{colorlist[[k]],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Two- and Three-bite Tilings

I only know of two types of tilings of the plane using bitten zonogons, both lattice-type tilings, in which translations yield the positions of the equal tiles. Two-bite tilings mimic the tessellation of squares, while three-bite tilings mimic the tessellation of hexagons. In both cases the bitten zonogon has one half intact. Hence, for symmetry to obtain, the number of sides of one-half the zonogon must be either a multiple of two (for two-bite tilings) or three (for three-bite tilings). The dodecagon of twelve sides satisfies both requirements and is used in the example below.

The simplest two-bite zonogon is the octagon, and the simplest three-bite zonogon, the dodecagon. A “spurious” one-bite hexagon can be obtained which also tiles the plane; no example of this is offered, and it is trivial.

To delve a little deeper: a zonogon is a convex polygon with an even number of sides, and each side has an equal and opposite “counter-side,” and each vertex a counter-vertex. Regular polygons of an even number of sides are zonogons, for instance. Any zonogon may be said to be “determined by” a set of, say, n vectors. Translations along these vectors “trace out” the zonogon, which has 2n sides. Although below, in the code, n refers only to the total number of sides, it would be more proper, in the case of zonogons, to call them 2n-gons.

Hence for a dodecagon of twelve sides, n would equal six. And we would say that for a two-bite zonogon (of the “special” type in which one-half remains intact, and the other half is symmetrically bitten), n must be a multiple of two. Hence a decagon cannot give a two-bite zonogon, for n=5. A square cannot either, for the smallest bite removes the entire square itself. We can obtain two-bite zonogons for n=4, 6, 8, 10, etc. We can obtain three-bite zonogons for n=6, 9, 12, etc.

Below, however, I use n to denote the total number of sides. Hence two-bite tilings arise for n=8, 12, 16, 20, etc., and three-bite tilings for n=12, 18, 24, 30, etc.

n=24; 
verts=Table[Chop[N[{Cos[2*i*Pi/n], Sin[2*i*Pi/n]}]],
{i, 0, n-1}];(*vertices of regular n-gon*)

sides=toedges[ verts ];(*the sides of the n-gon*)

v1=Map[ #[[2]]-#[[1]]&, sides];(*the vectors*)

(*show n-gon*)
Show[Graphics[ Line /@ sides],
Background->GrayLevel[1],
AspectRatio->Automatic];

Two-Bite “Square" Tilings

bitenumber=2;
Print["There will be ", bitenumber, " bites."]

bitelength=(n/2)/2;(*this sets number of segments in a bite*)

biteproduct=bitelength*bitenumber;

ordered=Range[n];

p=Partition[ Take[ordered, biteproduct], bitelength];(*split ordered list into bites*)
q=Take[ordered, -(n-biteproduct)];
neworder=Flatten[
Join[ Reverse /@ p[[ Range[bitenumber] ]], q ]
];

pt={1,0};(*set first vertex, global "pt"*)
(*now use the new ordering of vectors to make bitten polygon*)
bitten=Table[rlineto[pt, v1[[ neworder[[i]] ]] ],
{i,n}];
Show[obj=Graphics[ Line /@ bitten ],
Background->GrayLevel[1],
Frame->True,
AspectRatio->Automatic];

obj=Graphics[ {RGBColor[.25,.25,1],Polygon [First /@ bitten]} ];

t2={{1,1},{-1,1}};(*for two-bite zonogons*)
latticepoints=make2Darray[{10,10},t2];(*make lattice*)
region=Select[latticepoints, mag[#]<5&];(*select points near origin*)
pack=Map[trans[obj,#]&, 1.05*region];(*exploded by writing "1.05*region"*)

Show[{pack},
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

Three-Bite “Hexagonal" Tilings

bitenumber=3;
Print["There will be ", bitenumber, " bites."]

bitelength=(n/2)/3;(*this sets number of segments in a bite*)

biteproduct=bitelength*bitenumber;

ordered=Range[n];

p=Partition[ Take[ordered, biteproduct], bitelength];(*split ordered list into bites*)
q=Take[ordered, -(n-biteproduct)];
neworder=Flatten[
Join[ Reverse /@ p[[ Range[bitenumber] ]], q ]
];

pt={1,0};(*set first vertex, global "pt"*)
(*now use the new ordering of vectors to make bitten polygon*)
bitten=Table[rlineto[pt, v1[[ neworder[[i]] ]] ],
{i,n}];
Show[obj=Graphics[ Line /@ bitten ],
Background->GrayLevel[1],
Frame->True,
AspectRatio->Automatic];

obj=Graphics[ {RGBColor[.25,.25,1],Polygon [First /@ bitten]} ];

t3={{1.5, Sqrt[3/4]},{0,Sqrt[3]}};(*for three-bite zonogons*)
latticepoints=make2Darray[{10,10},t3];(*make lattice*)
region=Select[latticepoints, mag[#]<5&];(*select points near origin*)
pack=Map[trans[obj,#]&, 1.05*region];(*exploded by writing "1.05*region"*)

Show[{pack},
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

The General Equally-Bitten Polygon

n=11; 
verts=Table[Chop[N[{Cos[2*i*Pi/n], Sin[2*i*Pi/n]}]],
{i, 0, n-1}];(*vertices of regular n-gon*)

sides=toedges[ verts ];(*the sides of the n-gon*)

v1=Map[ #[[2]]-#[[1]]&, sides];(*the vectors*)

(*show n-gon*)
Show[Graphics[ Line /@ sides],
Background->GrayLevel[1],
AspectRatio->Automatic];

bitelength=2;(*this sets number of segments in a bite*)
(*number of bites in a "proper tile" is (n/bitelength)/2*)

bitenumber=5;
Print["There will be ", bitenumber, " bites."]

biteproduct=bitelength*bitenumber;

ordered=Range[n];

p=Partition[ Take[ordered, biteproduct], bitelength];(*split ordered list into bites*)
q=Take[ordered, -(n-biteproduct)];
neworder=Flatten[
Join[ Reverse /@ p[[ Range[bitenumber] ]], q ]
]

pt={1,0};(*set first vertex, global "pt"*)
(*now use the new ordering of vectors to make bitten polygon*)
bitten=Table[rlineto[pt, v1[[ neworder[[i]] ]] ],
{i,n}];
Show[obj=Graphics[ Line /@ bitten ],
Background->GrayLevel[1],
Frame->True,
AspectRatio->Automatic];

Bitten Wieringa Roofs

A rhombic tiling which has been lofted into the third dimension—a Wieringa Roof—is constructed, as a 3-bite zonotile, forcing intersections such that the bites are single, “higher” zonogons. The bites are removed, and the Bitten Wieringa Roof still tiles!

Actually, it is at times a happy accident that the “lofting” method discards higher zonogons, hence discards the bites. But when n is odd, other higher zonogons arise, not parts of the bites. These get discarded, too. Hence the example below works properly only for n a multiple of 6.

(*the idea, get bilateral symmetry; n/kmod=number of subtractable regions*)
(*compare odd n, singly-even, and doubly-even n*)
n=24;(*bounded by a regular 2n-gon*)
bitenumber=3;(*set number of bites*)
kmod=n/bitenumber;(*the lines displaced mod kmod minus an offset*)
rot=((Pi/2)+(Pi/(2*n)));(*rotate to vertical*)
lns=Table[
Chop[N[{ Cos[-rot+(i*Pi/n)], Sin[-rot+(i*Pi/n)], Mod[i-1,kmod]-((kmod-1)/2) } ]],
{i,n}];

(*find all points of intersection*)
pts=findpoints[ lns ];
Print["There are ", Length[pts]," points of intersection"];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[drawLines[lns, radius],
Frame->True,
PlotRange->All];

(*method to obtain actual points*)
(*relies upon ordering of lines*)
chk=Map[{First[#], Last[#]}&, seldex=Partition[Range[n], kmod]];
pt=Table[
t=lns[[ chk[[k]] ]];
Chop[newinter2lines[ {t[[1]], t[[2]]} ]],
{k, Length[chk]}];


Do[
selpt=pt[[k]];
thelines=Map[#[[{1,2}]]&, lns[[ seldex[[k]] ]] ];
newlns=Map[ Join[#, {selpt.#}]&, thelines];(*join 'em up*)
lns=ReplacePart[lns, newlns, List /@ seldex[[k]], List /@ Range[Length[newlns]] ],
{k, Length[seldex]}];

Share[zaq=zonotile[lns]];
sca=Max[ First /@ Chop[ Flatten[zaq,1] ] ]; (*scale factor, to reduce to unit circumradius*)
zaq=Chop[ (1/sca)*zaq ]; (*scale down to unit circumradius*)

s=notextcolorSort[ zaq ];

colorlist=Table[RGBColor[Random[Real,{0,1}],
		Random[Real,{0,1}],
		Random[Real,{0,1}]],{Length[s]}];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{colorlist[[k]],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
Frame->True,
AspectRatio->Automatic];

OK, now we work our magic on the plane tiling. It is a great mystery to me that this shot in the dark actually scored. Of course it generalizes to higher space: the tiling of a zonohedron by smaller zonohedra might be gradually lofted into the fourth dimension, so that the zonohedral tiles occupied various sets of parallel 3-spaces, instead of all lying in one 3-space.

Here the zonogons (only rhombs, under this method) suddenly occupy various planes, in parallel sets as it were, and the vectors which form their sides make the same angle, arc tangent Sqrt[2], with the z coordinate axis. Hence these vectors make the complement, arc tangent Sqrt[1/2], to the z=0 coordinate plane. The blue text, below, shows where the tangent of this angle may be changed. Try .2, .5, 1, and 2, for instance, in place of Sqrt[1/2].

Also change the red code at will; I think of Mod[ i-1, 2 ] as “regular,” so that is how the example stands. Try mod 1, 2, 3, and so on. The sign of the distance is affected.

(*from 2D homogenous to 3D Cartesian, z = +/- .5*)
lns2=Table[sgn=If[ Mod[i-1,2]==0,-1,1];
Join[lns[[i,{1,2}]],sgn*{N[Sqrt[1/2]]}], {i,Length[lns]}];


Share[

(*make list of sign vectors*)
a=Table[
  Table[
    Table[
      Sign[Chop[Det[ {lns[[i]],lns[[k]],lns[[j]]} ] ] ],
    {i,Length[lns]}],
  {j,k+1,Length[lns]}],
{k,Length[lns]-1}];

b=Union[Flatten[a,1]];


(*find polygons, some degenerate*)
zaq=Table[
pt={0,0,0};
Do[ If[ b[[k,j]]==1,
     rmoveto[pt, -lns2[[j]] ],
     rmoveto[pt, lns2[[j]] ]
    ],
{j,Length[lns]}];

t1=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt,2*-lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
   
t2=Cases[
Table[
   If[ b[[k,j]]==0,
     rlineto[ pt, 2*lns2[[j]] ]
   ],
   {j,Length[lns]}],{{_,_,_}..}];
 
toPoly[Join[t1,t2]],
{k,1,Length[b]}]
];

(*discard degenerate polygons*)
poly=Select[Cases[zaq,{{_,_,_},{_,_,_},{_,_,_}..},Infinity],
Length[#]==4&];
Print["There are ",Length[poly]," rhombs in the bitten zonotile"];

sca=(Sin[Pi/(2*n)]);(*scale down to unit circumradius*)
xaq=Graphics3D[{EdgeForm[],Polygon /@ Chop[ sca*poly ]}];

(*display*)
Show[xaq,
ViewPoint->2.5*unit[{0,0,2}],
Boxed->False,
PlotRange->All,
Background->GrayLevel[0]];

We have lofted a bitten zonotile into the 3rd dimension. Now, we make the tiling. Quite a process leads to the critical one of the two translation vectors needed for 3-bite tilings. It is found and named v3. Then a 5-by-5 lattice is made, centered on the origin, using the two translation vectors, which are named t3. From these 25 lattice points are selected those less than 3 units from the origin. Feel free to experiment with dimensions of the lattice and radii of selection. I should find a better method, one which would serve for the 2-bite tilings as well. This method seems to fail at times.

(*funky method to find translation vector*)
q=vunion[Select[Chop[Flatten[sca*poly,1]], mag[#[[{1,2}]]]>.99&]];(*periphery of 2n-gon*)
highy=Max[#[[2]]& /@ q];(*the largest positive y, height of highest horns*)
v1=q[[1]];(*left-most point*)
v2=First@Select[q, Abs[#[[2]]-highy]<.001&];(*leftmost of highest horns*)
v3=v1+v2;(*add them and, I hope, voila*)

t3={v3,{0,-Sqrt[3],0}};(*for three-bite zonogons*)
latticepoints=make2Darray[{5,5},t3];(*make lattice*)
region=Select[latticepoints, mag[#]<3&];(*select points near origin*)
pack=Map[trans[xaq,#]&, 1.0*region];(*exploded by writing "1.05*region"*)

Show[pack,
ViewPoint->2.5*unit[{0,0,1}],
Boxed->False,
Background->GrayLevel[0]];

Harmonices Stellarum

From methods evolved to find the intersection-point distances of stellation complexes, we obtain line arrangements with many points of multiple line intersections, and therefore, many higher zonogons in the zonotile.

Having obtained some symmetrical tiling with many higher zonogons, a random wind ruffles some of the lines, but not others.

Combine two line arrangements of different symmetries, one of which remains fixed, while the other slowly changes. Animate the sequence of zonotiles.

The Double Stellation of Regular Polygons

Construct a regular n-gon of inradius 1. Produce its sides, and if n>4, the lines will intersect in one or more orbits of n new points. We find the distances to these “kissing” points from the n lines, and also the distances to the “missing” points, being points we choose from the intervals within, between, and beyond the kissing points. Joining the missing and kissing points, we obtain a spectrum of distances.

A second set of n lines is now added to the first, choosing from some one of our missing or kissing points for the distance (inradius). If a missing point is used, only rhombs arise in the zonotile. If a kissing point if used, hexagons or octagons will arise within the zonotile, as well as rhombs. The last missing point, a distance beyond all others, gives the “dodecahedral expansion” pattern, as described elsewhere.

Clearly the process can be iterated; also, one might well use all the kissing points at once as distances, or all the missing points, or all of both.

(*set n1, therefore, n*)
n1=7;
n=If[EvenQ[n1],n1/2,n1];
dist=If[EvenQ[n1],{-1,1},{1}];

lns=Flatten[Table[
sgn=If[EvenQ[i],-1,1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

(*find all points of intersection*)
pts=findpoints[ lns ];

Share[zaq=zonotile[lns]];
s=notextcolorSort[ zaq ];

If[ Length[s]<8,
colorlist={
RGBColor[1,.25,.25],
RGBColor[.25,.25,1],
RGBColor[0,1,0],
RGBColor[1,1,0],
RGBColor[0,0,.5],
RGBColor[.3,0,0],
RGBColor[.5,.5,.5]},
(*else*)
colorlist=Table[
	RGBColor[
	  Random[Real,{0,1}],
	  Random[Real,{0,1}],
	  Random[Real,{0,1}]],
{Length[s]}]
];(*end If*)

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}],
	AspectRatio->Automatic];

spread=N[ 1/(Sin[Pi/n]) ];
radius=spread+Max[Map[mag[#]&, pts]];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
diagram1=Show[{mynewdrawLines[lns, GrayLevel[0], radius],redpts},
DisplayFunction->Identity];
Show[GraphicsArray[{diagram1,xaq}]];

Now, find the kissing points.

inrad=mag[ lns[[1,{1,2}]] ];(*all lines have equal inradii, distance-from-origin*)
rawlndist=Chop[Union[ Map[ (#.lns[[1,{1,2}]]/inrad)&, pts], SameTest->(#1 - #2 < .001 &)]];
(*now get rid of line(s) with distance<1*)
lndist=Select[rawlndist, #>=.9999&];
Print["The points lie on ", Length[circles=Union[ Map[ mag[#]&, pts], SameTest->(#1 - #2 < .001 &)]], " concentric circles."];
maxrad=Max[circles];(*minimum PlotRange*)
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
bluecircles=Graphics[{RGBColor[0,0,1], Map[Circle[{0,0}, #]&, circles]}];

If[lndist=={},
Print["No further intersections."],
(*else*)
Print["There are ", Length[lndist], " kissing point distances, which are ", lndist]
];

legal=Table[
testline=ReplacePart[ lns[[1]], lndist[[q]], 3];
tst=Graphics[{RGBColor[0,1,0],AbsoluteThickness[2],
Line[Join[
(*(vector * distance) +/- radius * orthogonal vector*)
{testline[[{1,2}]]*testline[[3]]-maxrad*First@NullSpace[ N[{testline[[{1,2}]]}] ]},
{testline[[{1,2}]]*testline[[3]]+maxrad*First@NullSpace[ N[{testline[[{1,2}]]}] ]}
] ]}
],
{q, Length[ lndist ]}];

Show[{legal,diagram1,redpts,bluecircles},
Frame->True,
AspectRatio->Automatic];

Find the missing points, join missing and kissing.

missing=Join[
	Table[
		a=lndist[[k]];
		b=lndist[[k+1]];
		a + ((b-a)/2) + Random[Real, {-((b-a)/20),((b-a)/20)}],
	{k,Length[lndist]-1}],
{Last@lndist + Random[Real, {.25,.5}]}
]

kissing=Select[lndist, #>1.000001&]

alldist=Sort[ Join[missing,kissing] ]

Create a series of zonotiles, for each missing and kissing point in turn.

alltiles=Table[

dist=If[EvenQ[n1],Sort[Union[{-alldist[[q]],-1,1,alldist[[q]]}]], Sort[{1,alldist[[q]]}] ];

bothlns=Flatten[Table[
sgn=If[EvenQ[i],-1,1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

Share[zaq=zonotile[bothlns]];
s=notextcolorSort[ zaq ];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
testline=ReplacePart[ lns[[1]], alldist[[q]], 3];
rad=maxrad;
tst=Graphics[{RGBColor[0,1,0],AbsoluteThickness[2],
Line[Join[
(*(vector * distance) +/- radius * orthogonal vector*)
{testline[[{1,2}]]*testline[[3]]-rad*First@NullSpace[ N[{testline[[{1,2}]]}] ]},
{testline[[{1,2}]]*testline[[3]]+rad*First@NullSpace[ N[{testline[[{1,2}]]}] ]}
] ]}
];
zaq1=Show[{tst,diagram1,redpts},AspectRatio->Automatic,DisplayFunction->Identity];
zaq2=Show[xaq,DisplayFunction->Identity];	
Show[GraphicsArray[{zaq1,zaq2},GraphicsSpacing->0],
PlotLabel->If[OddQ[q],"Missing Point", "Kissing Point"]],
{q, Length[alldist]} ];

The Holy Grail of Higher Zonogons

Here the methods used to find intersection distances in a stellation complex are applied again, in the example, to the stellation complex of a regular decagon. Note that to create this complex, we set n=5; for each vector, one perpendicular line is at distance 1, another at distance -1, ten lines altogether. The zonotile, not displayed, is a decagon of edge 2 composed by forty rhombs.  
Fifteen distances are found, and all fifteen are used with each of the five vectors, to construct a second line arrangement, and the corresponding zonotile. A plethora of “higher” zonogons arise in the tiling, including many decagons, each determined by the intersection of five lines.

It is intended that three blocks of code be evaluated in turn:

1. Create initial line arrangement, find points of intersection, and distances from the origin, perpendicular to line 1.
2. Create and display the new line arrangement, using all distances found.
3. Construct the zonotile.

Feel free to experiment, by changing n and the initial distance(s). But have a care: it is all too easy to end up with hundreds of lines, and on my computer, that means quite a long wait, for both the discovery of new intersection points (a step which may be deleted), and much more so, for the construction of the zonotile. In practice I rarely ever use an arrangement of more than 80 lines. Hence, where below I have dist=ptdist;(*the new distances*), and knowing that I will end up with n*Length[ dist ] lines in total, I will use some device such as dist= Select[ ptdist,  Abs[ # ] <2 &], so that the product of n and the number of distances is less than one hundred.

1. The initial line arrangement

(*create the initial line arrangement*)
n=5;
dist={-1,1};

lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*find all points of intersection*)
pts=findpoints[ lns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[{drawLines[lns, radius], redpts}];

(*express the points of intersection as distances from the origin*)
ptdist=Chop[Union[ Map[ (#.lns[[1,{1,2}]])&, pts], SameTest->(#1 - #2 < .001 &)]]
Print[Length[ptdist]," distances were found."];

2. The new line arrangement

newdist=ptdist;(*the new distances*)
newlns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], newdist[[j]] }]],
{i,n},{j, Length[newdist]}],1];
Print["There are ", Length[newlns]," lines altogether"];

(*find all new points of intersection; optional*)
pts=findpoints[ newlns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[{drawLines[newlns, radius], redpts}];

3. The zonotile

Timing[ Share[zaq=zonotile[newlns]] ][[1]]
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

An Iterated Path to More and More and More Higher Zonogons

Here too we begin with a stellation complex, that of a regular pentagon. All points of intersection are found, and their signed distances from the origin, measured perpendicular to the first line of the complex (arrangement). A new line arrangement is formed, its zonotile created, and then once again we find the signed distances. These in turn give a third arrangement, of one hundred lines. The zonotile is duly created. The process might continue, with enough RAM and time.

1. The initial line arrangement

(*create the initial line arrangement*)
(*set n1, therefore, n*)
n1=5;
n=If[EvenQ[n1],n1/2,n1];
dist=If[EvenQ[n1],{-1,1},{1}];

lns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

(*find all points of intersection*)
pts=findpoints[ lns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[{drawLines[lns, radius], redpts}];

(*express the points of intersection as distances from the origin*)
ptdist=Chop[Union[ Map[ (#.lns[[1,{1,2}]])&, pts], SameTest->(#1 - #2 < .001 &)]]
Print[Length[ptdist]," distances were found."];

2. The new line arrangement

Using the distances found, we make a new arrangement, adhering to the back-and-forth alternation of sign used above to make a stellation complex.

newdist=ptdist;(*the new distances*)
newlns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*newdist[[j]] }]],
{i,n},{j, Length[newdist]}],1];
Print["There are ", Length[newlns]," lines altogether"];

(*find all new points of intersection; optional*)
pts=findpoints[ newlns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[{drawLines[newlns, radius], redpts}];

3. The zonotile

Timing[ Share[zaq=zonotile[newlns]] ][[1]]
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

4. Iteration: find new distances, make new line arrangement, create zonotile

Here we find all the intersection distances in the second line arrangement, and use these to construct a third set of lines. To save time, these lines are not displayed. These are passed to the zonotile function. In the example provided here, this third arrangement contains 100 lines; it takes a minute or so to build the zonotile, on my computer. Clearly the iteration could continue. The code is split into two sections, so that one can avoid creating the zonotile, if too many lines have arisen. On my computer, I only rarely use arrangements of as many as 100 lines, and never as many as 200.

(*express the points of intersection as distances from the origin*)
ptdist=Chop[Union[ Map[ (#.lns[[1,{1,2}]])&, pts], SameTest->(#1 - #2 < .001 &)]]
Print[Length[ptdist]," distances were found."];
Print["Hence ", n*Length[ptdist]," lines will arise in the new arrangement."];

newdist=ptdist;(*the new distances*)
newlns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*newdist[[j]] }]],
{i,n},{j, Length[newdist]}],1];
Print["There are ", Length[newlns]," lines altogether"];

Timing[ Share[zaq=zonotile[newlns]] ][[1]]
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

The Random Wind

We return to the same example as above: having constructed the stellation complex of a regular decagon, we find the distances of points of intersection, and use these to make a new line arrangement.

There are j=15 distances, the eighth being zero; the seven less than zero are the negatives of the seven greater than zero. We “perturb” the arrangement by adding small random real numbers to the first five distances. Within the Table used to make the new lines, we have If[ j<6, Random[Real,{-.1,.1}]+dist[[j]],  dist[[j]]  ].

The resulting tilings verge upon the aperiodicity of the classic Penrose tilings, but include some “higher” zonogons. It is somewhat as though we had placed 75 jackstraws, five sets of fifteen, ever so carefully, so as to maximize the number of jackstraws crossing at various points. Then a “random wind” ruffles some of the straws, but not others.

It is intended that three blocks of code be evaluated in turn:

1. Create initial line arrangement, find points of intersection, and distances from the origin, parallel to line 1.
2. Create the new line arrangement, using all distances found, and randomizing some of these.
3. Construct the zonotile.

1. The initial line arrangement

(*create the initial line arrangement*)
n=5;
dist={-1,1};

lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*find all points of intersection*)
pts=findpoints[ lns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[{drawLines[lns, radius], redpts}];

(*express the points of intersection as distances from the origin*)
inrad=mag[ lns[[1,{1,2}]] ];
ptdist=Chop[Union[ Map[ (#.lns[[1,{1,2}]]/inrad)&, pts], SameTest->(#1 - #2 < .001 &)]]
Print[Length[ptdist]," distances were found."];

2. The new line arrangement, with random displacements

Note red code; of all j distances, the first five are randomized. Many other such schemes can be used to randomize subsets of the lines.

dist=ptdist;(*the new distances*)
newlns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], If[j<6,Random[Real,{-.1,.1}]+dist[[j]], dist[[j]] ] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[newlns]," lines altogether"];

3. The randomized zonotile

Timing[ Share[zaq=zonotile[newlns]] ][[1]]
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]},
	AspectRatio->Automatic];
	
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Mixing Stars and Conjuring Shadows

Suppose one line arrangement gives a periodic tiling of regular octagons and squares, while another gives a Penrose tiling of 36- and 72-degree rhombs. One partakes of a tesseractic tessellation of tesseracts, the other, of a packing of 5-cubes.

Now let the more central lines in the Penrose arrangement be removed, and superimpose the two arrangements. A patch of octagons and squares “shines through” a hole.

But a picture is better than words.

1. Make Penrose Arrangement

(*Penrose lines*)
n=5;(*set n*)
y1=Sort[ N[-1*((1+1/Floor[n/2])+Range[ Floor[n/2] ]) ]/Sqrt[ri=Random[Real,{17,24}] ] ];
y2=N[ Range[ Ceiling[n/2] ] ]/Sqrt[ri ];
y=Sort[ If[EvenQ[n], Join[y1, -y1], Join[y1,y2] ] ];
y=y[[ scramble[n] ]];(*the offsets*)

gridlines=Range[3,6,1 ];(*inradius*)
dist=Table[
  N[ y[[i]]+gridlines ],{i,n}];


lns1=Flatten[
      Table[
sgn=If[EvenQ[i], 1,-1];
Chop[N[{Cos[i*Pi/n],Sin[i*Pi/n], sgn*dist[[i,j]]}]],{i,n},{j,
          Length[dist[[i]]]}],1];

Print["There are ",Length[lns1]," lines altogether"]

(*display lines within suitable radius*)
Show[drawLines[lns1, 10]];

colorlist={RGBColor[1., 0, 0],RGBColor[.4, .4, 1.],RGBColor[1., 1., 0],RGBColor[0.4, 0.4, 0],RGBColor[0.2, 0.8, 0.6],RGBColor[0.8, 0.4, 1.],GrayLevel[.5],RGBColor[0, 0, 1.],RGBColor[0.6, 0.2, 0.2],RGBColor[0, 0, 0.8],RGBColor[0, 0.6, 0.6],RGBColor[1., 0.6, 0],RGBColor[1., 0.8, 1.],RGBColor[0.2, 0.2, 0.8],GrayLevel[1]};

Timing[ Share[zaq=zonotile[lns1]] ][[1]]
s=colorSort[ zaq ];
Print[
    "There are ", a1=Map[Length[#]&, s],
    " polygons, ", Plus@@a1," altogether, of areas ",
    a2=Map[hullarea[First[#]]&, s]
    ];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
    MapThread[Times,{a1,a2}]];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

2. Make Octagon-Square Arrangement

n=4;
a=2;
dist=Table[
	If[EvenQ[i],f=1,f=N[Sqrt[2]]];
	N[f*Range[-a,a,1]],
	{i,n}];
lns2=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns2]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns2, 10]];;

Share[zaq=zonotile[lns2]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

3. Combine Line Arrangements

(*crude crude sort into cyclical order*)
lns=Sort[ Union[lns1,lns2], (#1[[1]]>#2[[1]])&];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];

Timing[ Share[zaq=zonotile[lns]] ][[1]]
s=colorSort[ zaq ];
Print[
    "There are ", a1=Map[Length[#]&, s],
    " polygons, ", Plus@@a1," altogether, of areas ",
    a2=Map[hullarea[First[#]]&, s]
    ];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
    MapThread[Times,{a1,a2}]];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

4. Open the Window

It is fun to experiment. One might make a hole in the octagon-square arrangement, and let the Penrose rhombs occupy center stage, for instance. Here we vary the size of the hole opened into the Penrose arrangement, through which a fixed octagon-square arrangement shines through. A Do loop takes the variable radius from 0 to 11, and for each radius we put lines at distances radius, radius+1, radius+2, radius+3.

One can animate the series of images. Try letting radius go from -12 to 9 in steps of .5; begin animation by double-clicking on one of the resulting images.

(*a list of 25 random colors*)
colorlist=Table[
	RGBColor[
	  Random[Real,{0,1}],
	  Random[Real,{0,1}],
	  Random[Real,{0,1}]],
{25}];

(*the fixed octagon-square arrangement*)
n=4;a=2;
dist=Table[
	If[EvenQ[i],f=1,f=N[Sqrt[2]]];
	N[f*Range[-a,a,1]],
	{i,n}];
lns2=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];

(*reset n*)
n=5;
y1=Sort[ N[-1*((1+1/Floor[n/2])+Range[ Floor[n/2] ]) ]/Sqrt[ri=Random[Real,{17,24}] ] ];
y2=N[ Range[ Ceiling[n/2] ] ]/Sqrt[ri ];
y=Sort[ If[EvenQ[n], Join[y1, -y1], Join[y1,y2] ] ];
y=y[[ scramble[n] ]];(*the offsets*)

(*And Now At Last*)
(*Iterate from no hole (radius=0) to a large hole (radius=10)*)
Do[
gridlines=Range[radius,radius+3,1 ];
dist=Table[
  N[y[[i]] + gridlines ],{i,n}];


lns1=Flatten[
      Table[
sgn=If[EvenQ[i], 1,-1];
Chop[N[{Cos[i*Pi/n],Sin[i*Pi/n], sgn*dist[[i,j]]}]],{i,n},{j,
          Length[dist[[i]]]}],1];

lns=Sort[ Union[lns1,lns2], (#1[[1]]>#2[[1]])&];

zaq=zonotile[ lns ];
s=notextcolorSort[ zaq ];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic],
{radius,0,11,1}];(*try -12 to 9 step .5*)

Random Rose Windows Within Symmetrical Gray  Shadows

Let n be odd, and let the lines be parallel to the sides produced of a regular n-gon, and let the k distances be, say, {0, 5, 10, 20} at first, but let them be offset slightly by random real numbers. The zonotile is bounded by a larger 2n-gon of edge=4, and at its center is another 2n-gon of edge=1. This inner one is split away and given RGB colors, while all the rest of the zonotile has shades of gray.

The proportions of the small random offsets to the larger pattern of the lines are such that the inner 2n-gon is tiled randomly and erratically, while the outer region remains fixed. This can be seen by using an iterator like “5” in the Do loop below.

(*Set up your own list of colors*)
colorlist1={
RGBColor[1,1,0],RGBColor[0,0,1],RGBColor[.7,.7,1],
RGBColor[1,0,0],RGBColor[0,0,.5],RGBColor[.3,.3,.3],
RGBColor[.5,0,0],RGBColor[0,1,0]};

colorlist2={
GrayLevel[.9],GrayLevel[.6],GrayLevel[.3],
GrayLevel[.8],GrayLevel[.5],GrayLevel[.2],
GrayLevel[.7],GrayLevel[.4],GrayLevel[.1]
};

(*optional random greys*)
(*colorlist2=Table[GrayLevel[ Random[Real,{0,1}] ],{20}];*)

Do[
n1=11;
n=If[EvenQ[n1],n1/2,n1];
dist=If[EvenQ[n1],{-20,-10,0,10,20},{0,5,10,20}];
kdist=Length[dist];
lns1=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n],  Random[Real,{-.001,.001}]+sgn*dist[[j]] }]],
{i,0,n-1},{j, Length[dist]}],1];

Share[zaq=zonotile[lns1] ];

(*now split into colored inner 2n-gon and grey outer region*)
{c1,c2}=tilesplit[zaq,kdist];(*split into colored inner 2n-gon and grey outer region*)

s1=notextcolorSort[ c1 ];
s2=notextcolorSort[ c2 ];

xaq1=Graphics[
	Table[ {colorlist1[[i]],Polygon /@ s1[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s1[[i]] ]}, {i,Length[s1]}]
	];

xaq2=Graphics[
	Table[ {colorlist2[[i]],Polygon /@ s2[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s2[[i]] ]}, {i,Length[s2]}]
	];
Show[{xaq1,xaq2},
Background->GrayLevel[0],
AspectRatio->Automatic],
{1}];(*Do loop iterator*)

Lines on the Run: Animated Transformations of Shadows

Suppose that, as in the “Iterated Path” subsection above, we create the stellation complex of a pentagon, extract kissing points, and use them all to make a second set of twenty-five lines, with multiple intersections. These lines determine a “sufficiently complicated” zonotile.

Now let four of the five line-sets remain fixed, but translate the fifth set in tiny steps across the fixed lines. Let the fifth set begin its run to the right of the rightmost, and finish to the left of the leftmost, points of intersection between the fixed lines. (We begin and end in this way because, under the convention used throughout this notebook, the n vectors are multiples of π/n by i, i=1, 2, 3, ..., n. Hence when i=n the unit vector is {-1,0}, and under the orientation of this vector, a positive distance points to negative x, a negative distance to positive x; hence we move from right to left).

That is, the n vector is always horizontal, and its line-set always vertical.

Begin by evaluating the cell below; then evaluate the Do loop below that. Double-click on an image to initiate the animation.

(*create the initial line arrangement*)
(*set n1, therefore, n*)
n1=5;
n=If[EvenQ[n1],n1/2,n1];
dist=If[EvenQ[n1],{-1,1},{1}];

lns=Flatten[Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*dist[[j]] }]],
{i,n},{j, Length[dist]}],1];

(*find all points of intersection*)
pts=findpoints[ lns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[{drawLines[lns, radius], redpts}];

(*express the points of intersection as distances from the origin*)
ptdist=Chop[Union[ Map[ (#.lns[[1,{1,2}]])&, pts], SameTest->(#1 - #2 < .001 &)]]
Print[Length[ptdist]," distances were found."];

(************)
(*just trying to keep line count to near 50*)
newdist=If[n*Length[ptdist]<50,
ptdist,(*the new distances*)
b=Length[ptdist];
c=Ceiling[50/n];
d=Floor[(b-c)/2];
ptdist[[ Range[d+1,d+c] ]]
];
(************)


newlns=Flatten[Table[
sgn=If[EvenQ[i],-1,1];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], sgn*newdist[[j]] }]],
{i,n},{j, Length[newdist]}],1];
Print["There are ", Length[newlns]," lines altogether"];

(*find all new points of intersection*)
pts=findpoints[ newlns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[{drawLines[newlns, radius], redpts}];

(*Set up your own list of colors*)
colorlist1={
RGBColor[1,0,0],RGBColor[.3,.3,1],RGBColor[1,1,0],
RGBColor[0,0,1],RGBColor[1,.4,.4],RGBColor[.4,.4,.4],
RGBColor[.5,0,0],RGBColor[0,1,0]};

zaq=zonotile[newlns];
s=notextcolorSort[ zaq ];

colorlist=If[Length[s]<=Length[colorlist1], colorlist1, Table[
RGBColor[Random[Real,{0,1}],Random[Real,{0,1}],Random[Real,{0,1}]],
{Length[s]}]];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

(*express the points of intersection as distances from the origin*)
inrad=mag[ newlns[[n,{1,2}]] ];
newptdist=Chop[Union[ Map[ (#.newlns[[n,{1,2}]]/inrad)&, pts], SameTest->(#1 - #2 < .001 &)]];
(*Print[Length[newptdist]," distances were found."];*)
maxrange=Max[newptdist];
minrange=Min[newptdist];
r=maxrange-minrange;
t1=maxrange-First@newdist;
t2=minrange-Last@newdist;
span=Ceiling[t1-t2];
Print["The fixed-line intersections lie within ",span, " units of distance"];

We have a set of n (here, 5) vectors, and also a set of k (here, 5) distances, named here newdist. The nth lines are moved by adding the number off to their distances; any one line {a, b, c} becomes {a, b, c + off}. We have already found how far the nth lines must be translated, and where to start and end so as to more than encompass all points of intersection among the fixed lines.

A Do loop effects the animation. The iterator is named off and runs, here, across the span of fixed-line intersections in steps of 1 This “step” may be decreased for a more gradual translation; try .25 or .5. The offsets are themselves offset by .1. This avoids a zero translation, which would allow all twenty-five lines to intersect symmetrically, and spawn a set of decagons. The line arrangement is paired with its zonotile; drag the topmost graphic out larger, select the entire set of graphics, and choose “Align Selected Graphics” in the Cell menu, to force them all to the larger size.

Another code cell, below in a gray box, sets up a list of one hundred random colors, useful, perhaps, if one sets n at all large, say, n>7. Re-evaluating this makes a brand new list of colors.

(*optional random colorlist of great length*)
colorlist=Table[
RGBColor[Random[Real,{0,1}],Random[Real,{0,1}],Random[Real,{0,1}]],
{100}];

(*now keep n-1 line-sets fixed, and move the nth set across the others*)
Do[
newlns2=Flatten[Table[
sgn=If[EvenQ[i],-1,1];
offset=If[i<n,0,off];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], offset+sgn*newdist[[j]] }]],
{i,n},{j, Length[newdist]}],1];

zaq=zonotile[newlns2];
s=notextcolorSort[ zaq ];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}],
	AspectRatio->Automatic];
	
qaq=Show[drawLines[newlns2,r],
	PlotRange->{{-r,r},{-r,r}},
	Frame->True,DisplayFunction->Identity];
	
Show[GraphicsArray[{qaq,xaq}],
Background->GrayLevel[1],
AspectRatio->Automatic],
(*iterator named 'off'*)
{off,(t2-.1),(t2-.1)+span, 1(*change this for smaller steps*)}];

Here we purposely use the line-distances found above, newptdist, as our offsets, picking up fixed-line intersections from right to left (as our generating vector is {-1,0}).

(*now keep n-1 line-sets fixed, and move the nth set across the others*)
Do[
newlns2=Flatten[Table[
sgn=If[EvenQ[i],-1,1];
offset=If[i<n, 0, newptdist[[k]]-First@newdist];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], offset+sgn*newdist[[j]] }]],
{i,n},{j, Length[newdist]}],1];

zaq=zonotile[newlns2];
s=notextcolorSort[ zaq ];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}],
	AspectRatio->Automatic];
	
qaq=Show[drawLines[newlns2,r],
	PlotRange->{{-r,r},{-r,r}},
	Frame->True,DisplayFunction->Identity];
	
Show[GraphicsArray[{qaq,xaq}],
Background->GrayLevel[1],
AspectRatio->Automatic],
{k,Length[newptdist]}];

Or we can try to offset interval by interval ... we’re back to kissing and missing points, and the two, combined. Here we try the missing points.

kissing=newptdist;

missing=Join[
{First@kissing - Random[Real, {.25,.5}]},
	Table[
		a=kissing[[k]];
		b=kissing[[k+1]];
		a + ((b-a)/2) + Random[Real, {-((b-a)/20),((b-a)/20)}],
	{k,Length[kissing]-1}],
{Last@kissing + Random[Real, {.25,.5}]}
];

alldist=Sort[ Join[missing,kissing] ];

(*now keep n-1 line-sets fixed, and move the nth set across the others*)
Do[
newlns2=Flatten[Table[
sgn=If[EvenQ[i],-1,1];
offset=If[i<n, 0, missing[[k]]+First@newdist];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], offset+sgn*newdist[[j]] }]],
{i,n},{j, Length[newdist]}],1];

zaq=zonotile[newlns2];
s=notextcolorSort[ zaq ];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}],
	AspectRatio->Automatic];
	
qaq=Show[drawLines[newlns2,r],
	PlotRange->{{-r,r},{-r,r}},
	Frame->True,DisplayFunction->Identity];
	
Show[GraphicsArray[{qaq,xaq}],
Background->GrayLevel[1],
AspectRatio->Automatic],
{k,Length[missing]}];

One Line, Traversing a Stellation Complex

Here a set of n lines is created (n odd), n-1 remaining fixed, while the nth travels across, on missing-points.

(*create the initial line arrangement*)
(*n odd*)
n=15;
lns=Table[
sgn=If[EvenQ[i],1,-1];
Chop[N[ { Cos[i*Pi/n], Sin[i*Pi/n], sgn } ]],
{i,n}];

(*find all points of intersection*)
pts=findpoints[ lns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
(*display lines within suitable radius*)
Show[{drawLines[lns, radius], redpts},
Frame->True];

(*express the points of intersection as distances from the origin*)
ptdist=Chop[Union[ Map[ (#.lns[[n,{1,2}]])&, pts], SameTest->(#1 - #2 < .001 &)]]
Print[Length[ptdist]," distances were found."];

A Do loop below makes the animation. Drag out the topmost graphic to the desired size, select all the graphics, and then in the Cell menu, choose Align Selected Graphics.

colorlist=Table[GrayLevel[1-i],{i,0,1,.1}];(*good up to n=20 or so*)
newptdist=Join[ {First@ptdist-1}, ptdist, {Last@ptdist+1} ];
miss=Table[((newptdist[[i+1]]-newptdist[[i]])/Random[Real,{1.999,2.001}])+newptdist[[i]], {i,Length[newptdist]-1}];

r=radius+2;
(*now keep n-1 line-sets fixed, and move the nth set across the others*)
Do[
lns=Table[
sgn=If[EvenQ[i],1,-1];
offset=If[ i<n, sgn*1, miss[[k]] ];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], (offset) }]],
{i,n}];

zaq=zonotile[lns];
s=notextcolorSort[ zaq ];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}],
	Background->RGBColor[0,0,.4],
	AspectRatio->Automatic];
	
qaq=Show[drawLines[lns,radius],
	PlotRange->{{-r,r},{-r,r}},
	Background->RGBColor[1,.7,.7],
	Frame->True,DisplayFunction->Identity];
	
Show[GraphicsArray[{qaq,xaq}],
Background->RGBColor[0,0,.6],
AspectRatio->Automatic],
{k,Length[miss]}];

One Line, Walking, Again

Here a set of n lines is created, n-1 remaining fixed, while the nth travels across, on missing-points. The only difference to the example above is that all distances (except the nth) are 1.

(*create the initial line arrangement*)
n=12;
lns=Table[
Chop[N[ { Cos[i*Pi/n], Sin[i*Pi/n], 1 } ]],
{i,n}];

(*find all points of intersection*)
pts=findpoints[ lns ];
Print["There are ", Length[pts]," points of intersection"];
redpts=Graphics[{AbsolutePointSize[5],RGBColor[1,0,0], Point /@ pts}];
rad1=Max[Map[mag[#]&, pts]];
radius=rad1+(rad1/4);(*expand a little*)
r=rad1+2;
(*display lines within suitable radius*)
Show[{drawLines[lns, radius], redpts},
PlotRange->{{-r,r},{-r,r}},
Frame->True];

(*express the points of intersection as distances from the origin*)
ptdist=Chop[Union[ Map[ (#.lns[[n,{1,2}]])&, pts], SameTest->(#1 - #2 < .001 &)]]
Print[Length[ptdist]," distances were found."];

A Do loop below makes the animation. Drag out the topmost graphic to the desired size, select all the graphics, and then in the Cell menu, choose Align Selected Graphics.

colorlist=Table[GrayLevel[1-i],{i,0,1,.1}];(*good up to n=20 or so*)
newptdist=Join[ {First@ptdist-1}, ptdist, {Last@ptdist+1} ];
miss=Table[((newptdist[[i+1]]-newptdist[[i]])/Random[Real,{1.999,2.001}])+newptdist[[i]], {i,Length[newptdist]-1}];

(*now keep n-1 line-sets fixed, and move the nth set across the others*)
Do[
lns=Table[
offset=If[ i<n, 1, miss[[k]] ];
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], (offset) }]],
{i,n}];

zaq=zonotile[lns];
s=notextcolorSort[ zaq ];

xaq=Graphics[
	Table[ {colorlist[[ i ]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}],
	Background->RGBColor[0,0,.3],
	AspectRatio->Automatic];
	
qaq=Show[{drawLines[lns,radius],
Graphics[
	{AbsoluteThickness[2],RGBColor[1,0,0],Last@drawLines[lns,radius][[1]]}
]},
	PlotRange->{{-r,r},{-r,r}},
	Background->RGBColor[.8,.8,1],
	AspectRatio->Automatic,
	Frame->True,DisplayFunction->Identity];
	
Show[GraphicsArray[{qaq,xaq}],
Background->RGBColor[0,0,.6],
AspectRatio->Automatic],
{k,Length[miss]-1}];

Post-Processing: Colors, Grouted Tilings, etc.

Some Coloring Methods

First, create a sample zonotile and sort its zonogons by area ...

n=6;
a=2;
dist=Table[
	If[EvenQ[i],f=1,f=N[Sqrt[3]]];
	N[f*Range[-a,a,.5]],
	{i,n}];
lns=Flatten[Table[
Chop[N[
{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[i,j]] }
]],
{i,n}, {j, Length[dist[[1]]]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*draw the lines within some suitable radius*)
Show[drawLines[lns, 10]];;

Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

Having created a zonotile and obtained the partition of its polygons into sets of equal area, the list s, it remains to devise a list of colors of the same length. Three methods are supplied, many more might be devised.

Random Coloring

(*Make 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]}];

xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

Specified Coloring

(*Set up your own list of colors*)
colorlist={
RGBColor[1,0,0],
RGBColor[0,0,1],
RGBColor[.7,.7,1],
RGBColor[1,1,0],
RGBColor[0,0,.5],
RGBColor[.3,.3,.3],
RGBColor[.5,0,0]};

If[Length[s]<=Length[colorlist],
xaq=Graphics[
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];,
Print["Not enough colors!"]
]

Randomized RGB Coloring

z=Length /@ s;
xaq=Graphics[{GrayLevel[.25],
Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->GrayLevel[.7],
AspectRatio->Automatic];

Discard Duplicate Edges

Sometimes it is useful to discard duplicate edges. A simple zonotile is created for the eUnion function.

n=3;
dist=Range[0,1];(*set to Range[-3,3] for hexagonal region*)
lns=Flatten[Table[
Chop[N[{ Cos[i*Pi/n], Sin[i*Pi/n], dist[[j]] }]],
{i,n},{j, Length[dist]}],1];
Print["There are ", Length[lns]," lines altogether"];

(*display lines within suitable radius*)
Show[drawLines[lns, 10]];

(*create and display*)
Share[zaq=zonotile[lns]];
s=colorSort[ zaq ];
Print[
"There are ", a1=Map[Length[#]&, s],
" polygons, ", Plus@@a1," altogether, of areas ",
a2=Map[hullarea[First[#]]&, s]
];
Print["The zonotile has total area of ",a1.a2,", which is the sum of ",
MapThread[Times,{a1,a2}]];

z=Length /@ s;
xaq=Graphics[{Table[Table[
{RGBColor[ Sequence@@RotateLeft[{a=Random[Real,{0,.75}], 1, a},k] ],
	Polygon[ s[[k,i]] ]},{i,z[[k]]}],
	{k,Length[s]}],
	Table[{GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->GrayLevel[0],
AspectRatio->Automatic];

(*Discard duplicate edges using eUnion function*)
len=Length[ zedges=Flatten[ Map[ tosegs[ # ]&, zaq],1] ];
Print["Before eUnion, there were ", len, " edges."];
e1=eUnion[ zaq ];
Print["After eUnion, there are ", Length[e1], " distinct edges."];
vaq=Graphics[{GrayLevel[0],Line/@e1}];
Show[vaq,
AspectRatio->Automatic];

Export to POV-Ray

The free raytracing program POV-Ray is available for all platforms, and offers photorealistic (or wildly unrealistic) renderings of three-dimensional scenes. Zonotile export to POV is implemented somewhat awkwardly here. A POV #include file is created, and for every vertex of the zonotile, a POV sphere is written; for every unique edge, a cylinder; and every polygon is split into triangles and combined in a POV mesh. Actually, a separate mesh object is created for each color-set of polygons, since in this notebook, zonotile polygons are always sorted by surface area and colored accordingly.

Various assumptions are made. First, that the zonotile has been assigned the global variable name “zaq,” and that its polygons have been sorted by surface area into the global variable name “s,” a list of lists.

First the unique vertices and edges are found.

(*Discarding duplicate edges is slow*)
Timing[ ve=vertedge[zaq] ][[1]]
Print["There are ", Length[ ve[[1]] ], " distinct vertices in the tiling"];
Print["There are ", Length[ ve[[2]] ], " distinct edges in the tiling"];
vaq=Graphics[{GrayLevel[0],Map[Line[#]&, ve[[2]] ]}];
Show[vaq,
AspectRatio->Automatic];

(*make vertices 3D*)
verts=make3D[ve[[1]] ];

(*make edges 3D*)
sides=Map[ make3D[#]&, ve[[2]] ];

(*make tess polygons 3D*)
t=Chop[Table[Map[ make3D[#]&, s[[k]] ],{k,Length[s]}]];

Next a list of colors is made, randomly or manually  chosen.

(*assign random colors to polygons*)
colors=Table[{Random[Real,{0,1}],
		Random[Real,{0,1}],
		Random[Real,{0,1}]},{Length[s]}]

(*manually make color list for polygons*)
colors={{1,1,0},{.5,0,0},{0,0,.75},{.5,.5,1}};

(*adopt existing color list*)
colors=colorlist;

Assign a directory for the POV #include file.

SetDirectory["Macintosh HD:Desktop Folder:POV zonotiles:"]

Write the file.

TessToPOV["hexpenrose2.inc",t,verts,sides]

And here is a sample POV scene file to use as a point of beginning..

// Persistence of Vision Ray Tracer Scene Description File
// File: hexpenrose.pov
// Vers: 3.1
// Desc: 2D zonotile
// Date: 6/19/01
// Auth: Russell Towle
//

#version 3.1;

#include "colors.inc"
#include "shapes.inc"
#include "textures.inc"
#include "metals.inc"
#default { texture { pigment {color rgb <1,1,1>} finish {phong 0.1 ambient 0.2 diffuse .6} }}


// ----------------------------------------
camera {
	location <0, -5, 10>
	direction <0, 1, 0> //.75 wide angle
	up <0, 0, 1>
	right <4/3, 0, 0> //aspect ratio, w/h
	sky <0., 0., 1.>
	look_at <0., 0., 0>
}

light_source {<20, 50, 30> color rgb <1, 1, 1>}

#declare T1 = texture{Gold_Metal}//spheres
#declare T2 = texture{T_Silver_3C}//cylinders
#include"hexpenrose.inc"

/*the faces, edges and vertices defined in the #include file*/
object{FACES}
object{VERTS scale<1, 1, 1>}
object{EDGES scale<1, 1, .25>}

/*a sky sphere with strange texture*/
sky_sphere {
	pigment {
		agate
		color_map {
			[ 0.0 rgb <0.2, 0.2, 1.000000> ]
			[ 0.3 rgb <1.000000, 0.839979, 0.040024> ]
			[ 1 rgb <.5, 0, .2> ]
		}


	}

}

Grouted Tilings

A rather cumbersome function, grout, reduces the sizes of polygons in a tiling for uniform grout joints. The function is mapped across the list of polygons, with its second argument, the distance to shrink; this is half the width of the grout joint.

Naturally, if this were actually used to lay out tiles for cutting and grouting, one would first scale the tiles suitably.

The function fails on non-equilateral zonotiles.

(*having created a zonotile, discard degenerate tiles*)
myzaq=Select[zaq, hullarea[#]>.00001&];

(*make space for grout*)
qaz=Map[grout[#, .15]&, myzaq];

(*sort into subsets according to area*)
s=colorSort[qaz];

(*find the convex hull of the shrunk tiles*)
gon=vunion[ Flatten[s,2] ];(*unique vertices*)
qaz=convexhull2D[gon];(*convex hull; slow*)
Show[Graphics[Polygon@qaz],(*test*)
AspectRatio->Automatic];

(*Make 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]}];

xaq=Graphics[
	{GrayLevel[.25],Polygon@qaz,(*the grout polygon*)
	Table[ {colorlist[[i]],Polygon /@ s[[ i ]],
	GrayLevel[0],Map[Line /@ tosegs[#]&, s[[i]] ]}, {i,Length[s]}]}
	];
Show[xaq,
Background->RGBColor[0.2, 0.2, 0.5],
AspectRatio->Automatic];

Lofted Tilings

Here the grout function is adapted to accept a third argument, height, and truncated pyramids of the specified height are erected upon each zonogon. Since the grout function fails on non-equilateral zonotiles, so also will this function fail.

We create a 3D object, and use Graphic3D to display it, somewhat obliquely.

(*having created a zonotile, discard degenerate tiles*)
myzaq=Select[zaq, hullarea[#]>.00001&];

(*apply lofting into 3D*)
uptile=Map[ loft[#, .2, .2]&, myzaq];

(*apply SurfaceColor specs to the polygon list*)
xaq=Graphics3D[
{EdgeForm[],SurfaceColor[RGBColor[1,.5,0],GrayLevel[1], 5 ],
		uptile }];

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