Hexagonal Spiral AddOn
- To: mathgroup at smc.vnet.net
- Subject: [mg56905] Hexagonal Spiral AddOn
- From: zak <chocolatez at gmail.com>
- Date: Tue, 10 May 2005 03:42:08 -0400 (EDT)
- Reply-to: zak <chocolatez at gmail.com>
- Sender: owner-wri-mathgroup at wolfram.com
Hi as an addon to my previous message, i have found in an article titled Lady PI in: http://users.aol.com/s6sj7gt/ladypi.htm a method to draw a spiral on a hexagonal grid written in UBASIC programming language , i have translated some of the ubasic lines to mathematica, you could download the notebok from: http://sr2.mytempdir.com/25816 indeed i could not visualize the code, but as you can see the prime numbers in the graph will have some ordering , i color the 7, 19, 37, 61 sequence wich appeared in the http://www.cut-the-knot.org/ctk/HexMosaic.gif you will see them in a line, so the code are working. here is the contents of the above notebook: the socond graph will show you how the points are arranged in hexagonal grid, but what annoy me is the crooked line wich connect the points because it will not connect at the center of every hexagon. dx = {2, 1, -1, -2, -1, 1}; dy = {0, 2, 2, 0, -2, -2}; x = 0; y = 0 ; lst = {}; z = 0; v = {}; For[shell = 1, shell < 200, x = x + dx[[5]]; y = y + dy[[5]]; For[k = 1, k <= 6, For[n = 1, n <= shell, x = x + dx[[k]]; y = y + dy[[k]]; z = z + 1; If [PrimeQ[z] == True, lst = Join[lst, {{x, y}, {x + 1, y + 1}}]]; If[MatchQ[z, 7 | 19 | 37 | 61], v = Join[v, {{x, y}}]]; , n++]; k++]; shell++]; p1 = Graphics[{PointSize[0.001], Point /@ lst}]; p2 = Graphics[{Red, PointSize[0.005], Point[{2, 0}], Point /@ v}]; Show[p1, p2, AspectRatio -> Automatic] dx = {2, 1, -1, -2, -1, 1}; dy = {0, 2, 2, 0, -2, -2}; x = 0; y = 0 ; lst = {}; For[shell = 1, shell < 8, x = x + dx[[5]]; y = y + dy[[5]]; For[k = 1, k <= 6, For[n = 1, n <= shell, x = x + dx[[k]]; y = y + dy[[k]]; lst = Join[lst, {{x, y}, {x + 1, y + 1}}]; , n++]; k++]; shell++]; p1 = Graphics[{Line[Take[lst, 38]], Point /@ lst}]; p2 = Graphics[{Red, PointSize[0.015], Point[{0, 0}]}]; Show[p1, p2, AspectRatio -> Automatic]
