Conference rusure::math

733.0. "Strange attractions in POSTSCRIPT" by CXCAD::LARSEN (Glen Larsen) Wed Jul 15 1987 19:19

        People with graphic workstations started driving me crazy
        with chaotic strange attractor plots, my only defense was
        to create something I could look at with what I have available.

        Below this text is a postscript program to plot the
        strange attractor discussed in the current (August?) issue
        of Scientific American (Computer Recreations by Dewdney).

        All the computes are done by the LPS40 or LASERWRITER, so it
        takes a while (don't let the length of the file deceive you).

        Enjoy.


--------------------------------------cut-here-------------------------
%!PS-Adobe-1.0
%%Creator: Glen (CXCAD::)Larsen
%%Title: CHAOS1
%%CreationDate: 15-Jul-1987
%%DocumentFonts:
%%EndComments

%
% Strange attractor described by A. K. Dewdney in Scientific American
%
% (takes 18 minutes on an LPS40, ~30 on Apple LaserWriter)
%

% constants:

/pagey 72 11 mul def    % page height in units
/pagex 72 8.5 mul def   % page width 

/extray 72 def          % an extra 1 inch at bottom of page
/margin 72 2 div def    % 1/2 inch margin

% note that these variables are coerced to integers
/ylen pagey margin margin extray add add sub cvi def
/xlen pagex margin margin add sub cvi def

%        
% draw a line around the display space
%
/originbox {            % x y ==> -
  0 0 moveto
  dup 0 exch rlineto
  exch 0 rlineto 
  neg 0 exch rlineto
  closepath stroke
} def
        
%                                      
% Calculate a new value for x and leave on stack
% If you are looking for the algorithm, here it is...
%
/newx {                 % x ==> r*x*(1.0-x)
  dup 1.0 exch sub curr mul mul
} def                                                         

%
% make a dot by stroking a 1 unit line, any better ideas?
%
/makedot {               % x y ==> -
  moveto 0 1 rlineto stroke
} def

% calculate a new line
%  
%   Do wheel spins for 200 iterations, then
%   plot the x*xlen value for the next 300 iterations
%
/calcline {             % x ==> -
  200 {newx} repeat     % 200 iterations to get rid of transients
  300 {                 % plot the next 300 iterations
    newx                % compute new x value on stack      
    dup xlen mul cury   % scale x to line, push current-y for moveto
    makedot             % make a dot here
  } repeat              %                                
  pop                   % finished, clean the x off the stack
} def

% chaos1
%    parameters :   rhi - r value to be assigned to top part of graph
%                   rlo - r value for lowest line of graph
%
%    rindex = |(rhi - rlo)|/(ylen), index to apply to the y-axis
%
/chaos1 {               % rhi rlo ==> -
  /curr exch def        % top of stack into curr variable (current-r)
  /rindex exch def      % next on stack is temporarily rindex,
                        % adjust rindex to be the amount to offset r
                        % for each unit on y axis
  /rindex rindex curr sub ylen div def
  /cury 0 def           % initialize cury variable (current y)
  ylen 1 sub {          % do ylen-1 units (all of y-axis)
    /curr curr rindex add def       
    /cury cury 1 add def
    0.3 calcline        % calcline with this initial x value
  } repeat
} def

% --- start of main program ---
                                                                
margin margin extray add translate
                        % translate origin out into the page a little
1 setlinewidth          % set 1 unit line width
xlen ylen originbox     % draw box at origin

2.95 4.0 chaos1         % make chaos top_r_val = 2.95
                        %            low_r_val = 4.0

showpage

    An optimizing POSTSCRIPT compiler, anyone?
    
    /Bevin