Re: simplifying ulam spiral code
- To: mathgroup at smc.vnet.net
- Subject: [mg56407] Re: simplifying ulam spiral code
- From: Peter Pein <petsie at arcor.de>
- Date: Sun, 24 Apr 2005 03:28:57 -0400 (EDT)
- References: <d4cmlr$39e$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
zak wrote: > hi > in the site: > http://teachers.crescentschool.org/weissworld/m3/spiral/spiral.html > there is a mathematica code for drawing ULAM'S SPIRAL > the code is: > > dat = Table[i, {i, 20000}]; > x := 0; y := 0; num := 1; shift := 1; > point := {x, y}; list = {} > While[num <= 20000, > i := 1; > While[i <= shift, > x = x + 1; > If[PrimeQ[dat[[num]]] == True, list = Flatten[{list, point}]]; num++; > i++;]; i := 1; While[i <= shift, > y = y + 1; > If[PrimeQ[dat[[num]]] == True, list = Flatten[{list, point}]]; num++; > i++;]; shift++; > i := 1; > While[i <= shift, > x = x - 1; > If[PrimeQ[dat[[num]]] == True, list = Flatten[{list, point}]]; num++; > i++;]; i := 1; > While[i <= shift, > y = y - 1; > If[PrimeQ[dat[[num]]] == True, list = Flatten[{list, point}]]; num++; > i++;]; shift++;] > ListPlot[Partition[list, 2], PlotStyle -> PointSize[0.007], > AspectRatio -> Automatic, Axes -> True]; > > > or see text in: > http://sr1.mytempdir.com/15902 > > > Please i hope someone transform it to a functional programming code. > thanks > zak > Hi Zak, This is my approach: First, create a complete spiral and then delete the points which correspond to non-primes. spiral[n_Integer /; n > 0] := Module[{ lst = Take[FoldList[Plus, {0, 0}, Join @@ Table[Join @@ Transpose[ Table[(-1)^(k + 1)*{{1, 0}, {0, 1}}, {k}]], {k, Ceiling[(Sqrt[1 + 4n] - 1)/2]}]], n]}, ListPlot[Delete[lst, List /@ Complement[Range[n], Prime[Range[PrimePi[n]]]]], Axes -> False, PlotStyle -> PointSize[.007], AspectRatio -> Automatic] ] spriralplot[20000] will (hopefully ;-)) give the same image, as the above so called Mathematica code. -- Peter Pein Berlin