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>