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