Prime Spiral

Author

Eric W. Weisstein
July 22, 2011

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PrimeNumbers/PrimeSpiral.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/PrimeSpiral.html.

©2011 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

IntegerSpiral code from
Abbott, P. (Ed.).  "Mathematica One-Liners: Spiral on an Integer Lattice."  Mathematica J. 1, 39, 1990.

HexagonalSpiral code from
Paul Abbott
MathGroup posting
May 11, 2005

Code

This code is relatively elegant

Square[{x_,y_},r_:.5]:=Polygon[{{x-r,y+r},{x+r,y+r},{x+r,y-r},{x-r,y-r}}]
Square[{x_,y_},r_:.5,color_]:={color,Polygon[{{x-r,y+r},{x+r,y+r},{x+r,y-r},{x-r,y-r}}]
}
Square[x_,y_]:=Square[{x,y},.5]

IntegerSpiral[n_] :={Re[#],Im[#]}& /@ 
    Fold[Join[#1, Last[#1]-I^#2 Range[#2/2]]&, {0}, Range[n]]

PrimeSpiral[n_]:=Module[{spiral=Most[IntegerSpiral[n]],primes,rect},
primes = Pick[spiral, PrimeQ[Range[Length[spiral]]]];
rect={-1,1}/2+Outer[Apply,{Min,Max},Transpose[spiral],1];
Graphics[{
{Yellow,Rectangle@@rect},
Square[#,.5,Red]&/@primes,
MapIndexed[Text[#2[[1]],#1]&,spiral]
}]
]

This code is relatively ugly

NumberSpiral[n_Integer?OddQ]:=Module[{a,i=(n+1)/2,j=(n+1)/2,cnt=1,dir=0,len,parity,vec={{1,0},{0,-1},{-1,0},{0,1}}},
a=Table[j+n(i-1),{i,n},{j,n}];
Do[Do[Do[a[[j,i]]=cnt++;
{i,j}+=vec[[dir+1]],{k,len}];
dir=Mod[dir+1,4],{parity,0,1}],{len,n-1}];
a]

Options[PrimeSpiral2]={
ColorRules->{1->Black,0->White},
PixelConstrained->True
};
PrimeSpiral2[n_Integer?OddQ,opts___]:=Module[
{p=PrimeQ[NumberSpiral[n]]/.{True->1,False->0},colors},
ArrayPlot[p,opts,Sequence@@Options[PrimeSpiral2]]
]

NumberedPrimeSpiral[k_,opts___]:=Module[{n=NumberSpiral[k],x,colors},
colors=Colors/.{opts}/.Options[PrimeSpiral];
x=Length[n];
{PrimeSpiral[11,Colors->colors],
Graphics[Table[Text[n[[i,j]],{j-.5,x-i+.5}],{i,x},{j,x}]]
}
]

NumberSpiral::usage="NumberSpiral[n] for odd n gives an array of integers arranged in a spiral pattern on an nxn grid."

PrimeSpiral::usage="PrimeSpiral[n] for odd n gives a graphics object in which primes, arranged in a number spiral on an nxn grid.  The optional argument Colors->{primecolor,compositecolor} can also be given."

NumberedPrimeSpiral::usage="NumberedPrimeSpiral[n] for odd n gives a graphics object in which primes, arranged in a number spiral on an nxn grid and the corresponding prime numbers are displayed on top.  The optional argument Colors->{primecolor,compositecolor} can also be given."

Square Spiral

spiral=IntegerSpiral[60];
primes = Pick[spiral, PrimeQ[Range[Length[spiral]]]];
ListPlot[spiral, PlotJoined->True,  Axes -> False,
   AspectRatio->Automatic, Epilog -> {PointSize[0.02], Point /@ primes},PlotRange->All];

Side by Side

spiral=IntegerSpiral[22];
primes = Pick[spiral, PrimeQ[Range[Length[spiral]]]];
g1=ListPlot[spiral, PlotJoined->True,  Axes -> False,
   AspectRatio->Automatic, Epilog -> {PointSize[0.05], Point /@ primes},PlotRange->All];

g2=Show[PrimeSpiral[22],AspectRatio->Automatic]

Show[GraphicsArray[{g1,g2}],ImageSize->500]

V6

spiral=IntegerSpiral[22];
primes = Pick[spiral, PrimeQ[Range[Length[spiral]]]];
g1=
ListPlot[spiral, Joined->True, Axes->False,AspectRatio->Automatic,PlotRange->{{-5.5,5.5},{-5.5,5.5}},Epilog->{PointSize[0.05],Point[primes]}]

g2=Show[PrimeSpiral[22],AspectRatio->Automatic]

Unnumbered Spirals

V5

PrimeSpiral2[101,ColorRules->{1->Black,0->Yellow}]

PrimeSpiral2[399,ImageSize->500]//Timing

<<Utilities`GIF`;

Export[gifs<>"primesp.gif",%]//Timing

V6

PrimeSpiral2[101,ColorRules->{1->Black,0->Yellow}]

g3=PrimeSpiral2[399]

Hexagonal Spiral

V5

HexagonalSpiral[n_]:={Re[#],Im[#]}&/@Fold[Join[#1,Last[#1]+Exp[I Pi/3]^#2 Range[#2/2]]&,{0},Range[n]]

spiral=HexagonalSpiral[100];

primes=spiral[[Prime[Range[PrimePi[Length[spiral]]]]]];

ListPlot[spiral,PlotJoined->True,Axes->False,AspectRatio->Automatic,Epilog->{PointSize[0.016],Point/@primes},
ImageSize->300];

V6

HexagonalSpiral[n_]:={Re[#],Im[#]}&/@Fold[Join[#1,Last[#1]+Exp[I Pi/3]^#2 Range[#2/2]]&,{0},Range[n]]

spiral=HexagonalSpiral[100];

primes=spiral[[Prime[Range[PrimePi[Length[spiral]]]]]];

g4=ListPlot[spiral,Joined->True,Axes->False,AspectRatio->Automatic,Epilog->{PointSize[0.016],Point[primes]}]

Combinaed Figure

GraphicsGrid[{{g1,g2},{g3,g4}}]