Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: simplifying ulam spiral code

• To: mathgroup at smc.vnet.net
• Subject: [mg56416] Re: [mg56394] simplifying ulam spiral code
• From: Daniel Lichtblau <danl at wolfram.com>
• Date: Sun, 24 Apr 2005 03:29:08 -0400 (EDT)
• References: <200504230516.BAA03185@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

The below possibilities are not in functional programming style. I'm not 
convinced that would be a good approach for this problem. These all 
agree with one another but I did not check whether they agree with your 
code above; there may be some fiddling to do with the initial i and j 
values. Also I note that the code above can (and will) run off the end 
of the data, giving several messages to that effect.

ulamSpiral1[len_] := Module[
   {dat=Range[len], x=0, y=0, num=1, shift=1, j=1,
     xyincr={{1,0},{0,1},{-1,0},{0,-1}}, shiftincr = {0,1,0,1}},
   Reap[While[num<=len,
     Do[If[num>len,Break[]]; {x,y} += xyincr[[Mod[j,4,1]]];
       If[PrimeQ[dat[[num]]], Sow[{x,y}]]; ++num;
       ,{i,shift}];
     shift += shiftincr[[Mod[j,4,1]]];
     j++;
     ]][[2,1]]
     ]

ulamSpiral2[len_] := Module[
   {dat=Range[len], x=0, y=0, shift=1, j=0, i=0, big={1000,1000},
	xyincr={{1,0},{0,1},{-1,0},{0,-1}}, shiftincr={0,1,0,1}},
   Select[Table[
     i++;
     If [i>=shift, i = 1; shift += shiftincr[[Mod[j,4,1]]]; j++;];
     {x,y} += xyincr[[Mod[j,4,1]]];
     If[PrimeQ[dat[[num]]], {x,y}, big],
     {num,len}], Abs[First[#]]<1000&]
   ]

ulamSpiral3 = Compile[{{len,_Integer}}, Module[
   {dat=Range[len], x=0, y=0, shift=1, i=0, j=0,
   xincr = {1,0,-1,0}, yincr = {0,1,0,-1}, shiftincr={0,1,0,1}},
   Select[Table[
     i++;
     If [i>=shift, i = 1; shift += shiftincr[[Mod[j,4,1]]]; j++;];
     x += xincr[[Mod[j,4,1]]]; y += yincr[[Mod[j,4,1]]];
     If[PrimeQ[dat[[num]]], {x,y}, {1000,1000}],
     {num,len}], Abs[First[#]]<1000&]
     ],
   {{PrimeQ[_],True|False}}];

In[31]:= Timing[list1 = ulamSpiral1[20000];]
Out[31]= {0.410938 Second, Null}

In[32]:= Timing[list2 = ulamSpiral2[20000];]
Out[32]= {0.470928 Second, Null}

In[33]:= Timing[list3 = ulamSpiral3[20000];]
Out[33]= {0.100985 Second, Null}

In[34]:= list1===list2===list3
Out[34]= True


Daniel Lichtblau
Wolfram Research

• References:
  • simplifying ulam spiral code
    • From: zak <chocolatez@gmail.com>