PostScript Program for a Ulam Sprial of Primes

(download)

%!PS

% Postscript program to draw 'prime numbers patterns'. 
% Program options are as follows:
% * paper size (in inches)
% * resolution (in dpi). Choose very low resolution (like 5) to get
%   close-ups without having to zoom in.
% * color: if color is true, colors are defined from primes distribution
% * spiral: if spiral is true, then not only the dots will appear, but the 
%   lines between them are drawn too. This is nice for close-ups.
% * startzero: if true, starts with 0 instead of 1.
% * number: if true, print prime numbers inside the dots.
                         

% Paper size, in dots (letter)
/paperx 8.5    72 mul def
/papery 11     72 mul def

% Resolution in dpi
/dpi 72 def

% Colors ?
/color? false def

% Change to true to make the 'spiral' appear.
/spiral? false def

% Change to true to have the spiral start with 0 instead of 1
/startzero? false def

% Change to true to print prime numbers inside the dots
/number? false def

% ============= CHANGES BELOW AT YOUR OWN RISK ============================

% Define some constants
/dot 72 dpi div def
/maxpts papery papery mul dot dup mul div def

% Allocate a string and load a font for printing numbers
number? {
  /buf 10 string def
  /fontsize 9 def % number here is irrelevant
  /Courrier-Bold findfont fontsize scalefont setfont
} if

% Brute force primality test
% (postscript interpreters are faster than they have memory...)
/prime? {
  /n exch def
  n 1 eq {false} { % 1 is not prime
    n 2 mod 0 eq {n 2 eq} {
      /divide? false def
      3 2 n sqrt {
        n exch div dup ceiling eq {/divide? true def exit} if
      } for
      divide? not
    } ifelse
  } ifelse
} bind def

% A little less stupid test (printers are not that fast, after all...)
/maxarray 65534 def
/primes maxarray 1 add array def
/lprime -1 def
/prime? {
  /n exch def
  /sn n sqrt def
  /d 1 def
  /id 0 def
  n 1 eq {false} { % 1 is still not prime
    n 2 mod 0 eq {n 2 eq} {
      /divide? false def
      {
        id lprime gt {
          /d d 2 add def
        } {
          /d primes id get def
          /id id 1 add def
        } ifelse
        d sn gt {exit} if
        n d mod 0 eq {/divide? true def exit} if
      } loop
      divide? {
        false
      } {
        lprime maxarray lt {
          /lprime lprime 1 add def
          primes lprime n put
        } if
        true
      } ifelse
    } ifelse
  } ifelse
} bind def

% 'random' primes, to compare
% /prime? {
%   dup 2 mod 0 ne exch
%   1 add ln cvi rand exch mod 0 eq and} bind def

% Change colors
% If a prime is close from its predecessor (<ln(x)), it tends to be blue,
% green if is is at a 'normal' distance (ln(x)), red if it is too far
% and black if it is much too far (>2ln(x))
color? {
  /ppi 0 def
  /chgcolor {
    pi ppi sub pi ln lt {
      0 pi ppi sub 2 sub pi ln 2 sub div dup 1 exch sub setrgbcolor
    } {
      pi ppi sub pi ln 2 mul 2 sub lt {
        pi ppi sub pi ln sub pi ln 2 sub div dup 1 exch sub 0 setrgbcolor
      } {
        0 setgray
      } ifelse
    } ifelse
    /ppi pi def
  } bind def
} if

% Mark a point when a number is prime
% We actually draw the PREVIOUS dot, to overwrite the (possible) spiral
/markpoint {
  currentpoint % save currentpoint that is lost because of stroke or newpath
  spiral? {0 setgray stroke} if % draw the spiral, if necessary
  color? {chgcolor} if % change the color, if necessary
  newpath px py dot 2 div 0 360 arc fill % draw the (previous) dot, always
  number? { % write the (previous) number in white over the dot, if necessary
    gsave % because we use 'scale'
      1 setgray
      px py moveto
      pi buf cvs dup stringwidth pop 
          % have the number fit 90% of the dot (50% if it is a single digit)
      dup dot pi 10 lt {.5} {.9} ifelse mul exch div dup scale
      -2 div fontsize -3 div rmoveto show % center in the dot and print
    grestore
  } if
  2 copy /py exch def /px exch def % update previous dot location
  /pi i def % update previous number
  moveto % move back to the point we were
} bind def

% Here is the algorithm for moving along the spiral
/do-p-times {
  1 1 p {
    pop 
    x y rlineto % if spiral? is not on, the path will not be stroked
    i 2 eq {
      currentpoint /py exch def /px exch def /pi 2 def
    } {
      i prime? {markpoint} if
    } ifelse
    /i i 1 add def
  } for
} bind def

/p 1 def
/i startzero? {1} {2} ifelse def

newpath
paperx 2 div papery 2 div moveto % center the picture
spiral? {dot 10 div setlinewidth} if

{
  /x dot def /y 0 def do-p-times
  /x 0 def /y dot def do-p-times
  /p p 1 add def
  /x dot neg def /y 0 def do-p-times
  /x 0 def /y dot neg def do-p-times
  /p p 1 add def
  i maxpts ge {exit} if
} loop

showpage