Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2005
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2005

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

Search the Archive

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]


  • Prev by Date: Re: Adding two numbers of high precision results in a number of low precision??
  • Next by Date: Re: ArcTan[1/0] no result, but ArcTan[Infinity] ok. How to resolve?
  • Previous by thread: Re: function definition difficulty
  • Next by thread: Representation and Simulation of Dynamic Systems