Re: hexagon tiled torus
- To: mathgroup at smc.vnet.net
- Subject: [mg20705] Re: hexagon tiled torus
- From: Mark C McClure <mcmcclur at bulldog.unca.edu>
- Date: Mon, 8 Nov 1999 02:48:48 -0500
- Organization: University of North Carolina at Asheville
- References: <7vrc11$2n2@smc.vnet.net> <8038lo$amb@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Martin Kraus <Martin.Kraus at informatik.uni-stuttgart.de> wrote:
: Guilherme Roschke wrote:
:>
:> I am trying to draw a torus tiled with regular hexagons. I've been able
:> to modify the torus in <<Graphics`Shapes` to give one tiled by triangles,
:> but no luck with regular hexagons.
: Here is some code:
---- Martin's Code Deleted ----
: There are several problems of this solution, but it might be good
: enough in your case.
Here is another solution. The idea is very similar to Martin's,
but the implementation is a bit different. I'm not sure what the
problems that Martin refers to are, but I suspect one problem
has to do with overlapping hexagons. This solution rectifies
that problem by constructing the planar graphic a bit more
carefully.
We start with a parameterization of the torus.
r = .4;
torus[{t_, s_}] := {Cos[t], Sin[t], 0} +
r Cos[s]{Cos[t], Sin[t], 0} +
r Sin[s] {0, 0, 1};
We now set up a planar graphic, which tiles [0,2Pi]x[0,2Pi] with
hexagons, for our parameterization to act upon. yNum hexagons
will end up wrapping around the tube at any point. Let r1=.4 be
radius of the tube and let r2=1 be the radius of the circle which
is wrapped by the tube. We want xNum/yNum = r2/r1 in the code
below to make the hexagons look somewhat regular.
xNum = 20; yNum = 8;
baseHex = Polygon[{{0, 0}, {1, 0}, {3/2, Sqrt[3]/2},
{1, Sqrt[3]}, {0, Sqrt[3]}, {-1/2, Sqrt[3]/2}}];
hShift[Polygon[l_List]] := Polygon[{3, 0} + # & /@ l];
firstRow = NestList[hShift, baseHex, xNum - 1];
dShift[Polygon[l_List]] := Polygon[{3/2, Sqrt[3]/2} + # & /@ l];
secondRow = dShift /@ firstRow;
vShift[Polygon[l_List]] := Polygon[{0, Sqrt[3]} + # & /@ l];
hexes = NestList[Map[vShift, #, {2}] &, {firstRow, secondRow}, yNum - 1];
coloredHexes = hexes /.
Polygon[x_] :> {RGBColor[Random[], Random[], Random[]],
Polygon[x]};
scaledHexes = hexes /.
{x_?NumericQ, y_?NumericQ} -> 2Pi{x/(3 xNum), y/(yNum Sqrt[3])};
Finally, we use the parameterization to wrap this graphic around a tube.
hexes3D = scaledHexes /. Polygon[l_List] :> Polygon[tube /@ l];
Show[Graphics3D[hexes3D]]
I placed the final image on my web page using Martin's very cool
LiveGraphics3D applet
http://www.unca.edu/~mcmcclur/java/LiveMathematica/hexaTorus.html
http://www.unca.edu/~mcmcclur/mathematicaGraphics/index.html
Hope that helps,
--
__/\__
Mark McClure \ /
Department of Mathematics __/\__/ \__/\__
UNC - Asheville \ /
Asheville, NC 28804 /__ __\
http://www.unca.edu/~mcmcclur/ \ /
__/\__ __/ \__ __/\__
\ / \ / \ /
__/\__/ \__/\__/ \__/\__/ \__/\__