Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Hexagonal Spiral

• To: mathgroup at smc.vnet.net
• Subject: [mg56872] Hexagonal Spiral
• From: zak <chocolatez at gmail.com>
• Date: Mon, 9 May 2005 01:45:54 -0400 (EDT)
• Reply-to: zak <chocolatez at gmail.com>
• Sender: owner-wri-mathgroup at wolfram.com

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]

• Follow-Ups:
  • Re: Hexagonal Spiral
    • From: DrBob <drbob@bigfoot.com>