Re: Hexagonal Spiral
- To: mathgroup at smc.vnet.net
- Subject: [mg56929] Re: [mg56872] Hexagonal Spiral
- From: DrBob <drbob at bigfoot.com>
- Date: Tue, 10 May 2005 03:42:44 -0400 (EDT)
- References: <200505090545.BAA13761@smc.vnet.net>
- Reply-to: drbob at bigfoot.com
- Sender: owner-wri-mathgroup at wolfram.com
This needs more work to appear properly hexagonal, but it shows primes in Red and other integers in Blue:
Clear[tier, last]
last[tier_] = Rationalize@Fit[Transpose@{Range@
6, {1, 7, 19, 37, 61, 91}}, {1, tier, tier^2}, tier];
Clear[n, tier]
tier[n_Integer?Positive] = Ceiling[tier /. Last@Solve[n == last@tier, tier]];
Clear@direction
direction[1] = 0;
direction[n_Integer?Positive] := Module[{t = tier@n},
Pi(1 - 2*((last[t] - n)/(last[t] - last[t - 1])))
]
Clear@point
Attributes@point = {Listable};
point[1] := {Red, Text[1, {0, 0}]}
point[n_Integer?
Positive] := Text[n, tier@n{Re@#, Im@#} &[E^(I*direction[n])]]
max = 91; p = PrimePi@max;
Show[Graphics@{Blue, point@
Range@max, Red, point@Prime@Range@p}, AspectRatio -> Automatic];
Bobby
On Mon, 9 May 2005 01:45:54 -0400 (EDT), zak <chocolatez at gmail.com> wrote:
> Hi
> the purpose of this message is to draw a hexagonal spiral and then
> divide every edge to the suitable numbers of points, then map the
> prime numbers to the all points of the spiral.
> this is motivated by the figure:
> http://www.cut-the-knot.org/ctk/HexMosaic.gif
> in an article in:
> http://www.cut-the-knot.org/ctk/FromLCarrollToArchimedes.shtml
> this project consist of three parts: first: draw a hexagonal spiral by
> using the hexagon function from mathworld HexagonalGrid.nb notebook by
> making multiple hexagons every one bigger than the previous by one
> unit, the fifth edge of every hexagon is extended by one unit to allow
> the beginning of a new bigger hexagon in a spiral way.
> second: we need to divide the edges of every hexagon to pieces
> according to its position from the center, except the fifth edge, this
> dividing will use the straigth Line equation to determine the
> coordinates of every point inside the edge.
> third: map the prime numbers over the points wich constitute the
> hexagonal spiral.
> you can download the notebook from:
> http://sr2.mytempdir.com/25353
>
> the program may seem messy and convoluted but it may be usefull for
> studying the straight line equation, or other fun something.
> welcome to any critic, suggestions, ideas, improvements.
>
> (* The hexagon generator function is from mathworld in the notebook
> HexagonalGrid.nb with a small variation*)
> x = 0; dsp = 1;(*dsp is for drawing consecutive bigger hexagons*)
> Table[p[i] = x + # & /@ (dsp*(Through[{Cos, Sin}[Pi#/3]] &) /@ Range[0, 5]);
> dsp++;
> (* The fifth edge of every hexagon we want to extend it horizontaly by 1 \
> unit so we will be able to begin the new bigger hexagon in a spiral form *)
> p[i] = ReplacePart[p[i], Last[p[i]] + {1, 0}, Length[p[i]]];, {i,(*
> number of hexagons possible *)100}]; (* End of Table function *)
> i = 1; ww = {}; While[i <= 20 (* number of hexagons desired *),
> ww = Join[ww, p[i]]; i++] (*
> The coordinates of the vertices of consecutive Hexagons will be in ww \
> variable*)
> (* the Hexagonal spiral *)
> m1 = Graphics[{Line[ww], {Red, PointSize[0.02], Point[{0, 0}]}},
> AspectRatio -> Automatic];
> Show[m1]
>
> (* The straigth Line Equation function *)
> f[{x1_, y1_}, {x2_, y2_}] :=
> y = x*((y2 - y1)/(x2 - x1)) + y1 - x1*((y2 - y1)/(x2 - x1))
> w = Partition[ww, 6];
> w2 = {}; i = 1; While[i <= Length[w] - 1,
> w2 = Join[w2, {Append[w[[i]], First[w[[i + 1]]]]}]; i++;]
> (* the following will divide every edge into equal units according to its \
> distance from the center of the hexagon with the exception of the horizontal \
> fifth edge wich is taller than the others by one unit *)
>
> n = 1; polylist = {}; polynum = 19 (* number of hexagons *); lst = {}; s = 1;
> i = 1; j = 1;
> While[
> s <= polynum,
> j = 1;
> While[j <= 6, lst = {};
> x1 = w2[[s]][[j]][[1]];
> y1 = w2[[s]][[j]][[2]];
> x2 = w2[[s]][[j + 1]][[1]];
> y2 = w2[[s]][[j + 1]][[2]];
> If[j == 5, ss = s + 1, ss = s];
> i = 1; n = 1;
> While[i <= s,
> x = x1 + n*(x2 - x1)/ss;
> (*call the straight line equation function : *)
> y = f[{x1, y1}, {x2, y2}];
> lst = Join[lst, {{x, y}}];
> n++; i++];
> If[j == 1, lst = Prepend[lst, {x1, y1}]];
> If[j == 5, lst = Append[lst, {x2, y2}]];
> polylist = Join[polylist, lst];
> j++];
> s++]
> (* To delete one of every consecutive similar points which represent the \
> beginning point of every hexagon points *)
> i = 1; While[i <= Length[polylist] - 2,
> If[polylist[[i]] == polylist[[i + 1]], polylist = Delete[polylist, i]]; i++]
> v = {}; i = 1;
> While[i <= Length[polylist],
> If[PrimeQ[i] == True, v = Join[v, {polylist[[i]]}]]; i++]
> Show[Graphics[{Line[Take[ww, 50]], {PointSize[.02], Point[{0, 0}], Red,
> Point /@ Take[polylist, 234]}}], AspectRatio -> Automatic]
> hexx = Graphics[{PointSize[.02], Point[{0, 0}], Green, Point /@ polylist}];
> prm = Graphics[{PointSize[.02], Red, Point /@ v}];
> lin = Graphics[{Line[ww], {PointSize[.03], Point[{0, 0}]}}];
> (* show prime numbers in Red : *)
> Show[hexx, prm, AspectRatio -> Automatic]
> Show[lin, hexx, prm, AspectRatio -> Automatic]
>
>
>
>
--
DrBob at bigfoot.com
- References:
- Hexagonal Spiral
- From: zak <chocolatez@gmail.com>
- Hexagonal Spiral