;;; automata-project.ss -- tracing cellular automata graphically

;; John David Stone
;; Department of Mathematics and Computer Science
;; Grinnell College
;; stone@math.grin.edu

;; created April 17, 1998
;; last revised April 22, 1998

;; An automaton is a device, usually extremely simple, the only function of
;; which is to change from one state to another at regular intervals,
;; depending on its current state and the inputs it receives.  A cellular
;; automaton is one that takes as its inputs the current states of other
;; precisely similar machines.  This program simulates the operation of a
;; number of cellular automata arranged in a linear sequence, with each
;; automaton able to sense the state of automata that are near to it in the
;; sequence.

;; In this simulation, each state of a cellular automaton is represented by
;; a non-negative integer, and the entire sequence of automata is
;; represented by a vector of such integers.  The number of automata in the
;; row is determined by the global constant *number-of-automata*, and the
;; number of different states by the global constant *number-of-states*.
;; Subsequent code assumes that both of these values are positive integers.

(define *number-of-automata* 150)
(define *number-of-states* 5)

;; The STATE? predicate determines whether a given argument is a state --
;; a non-negative integer less than the number of states.

(define state?
  (lambda (object)
    (and (integer? object)
         (<= 0 object)
         (< object *number-of-states*))))

;; The states of the automata as they run are displayed graphically on
;; screen in a separate window.  Since version 5 of Chez Scheme does not
;; include a library for window graphics, this project uses another
;; implementation of the language, DrScheme.

;; The first step in any use of DrScheme's graphics library is to
;; initialize the graphics subsystem by invoking the OPEN-GRAPHICS
;; procedure.

(open-graphics)

;; In DrScheme's terminology, a window for graphical display is called a
;; viewport.  The OPEN-VIEWPORT procedure creates a viewport and paints it
;; on the screen.  The first argument to OPEN-VIEWPORT is a string that
;; gives the title of the window, as displayed at the top of the frame
;; around it.  The other two are the height and width of the desired
;; viewport, measured in ``pixels'' (that is ``picture elements'' -- the
;; tiny colored dots that are lit up or left dark to make a picture on
;; screen).

;; Each automaton, in each cycle of its operation, is displayed in the
;; viewport as a small square; the color of this square indicates the state
;; of the automaton.  The following constant determines the number of
;; pixels on each side of the square that is displayed.

(define *size-of-automaton-graphic* 5)

;; The squares representing the automata are lined up across the viewport.
;; A narrow gap is left between adjacent automata; the following constant
;; determines the size of this gap, in pixels.  (Changing it to 0 would
;; cause the gap to vanish.)

(define *gap-between-automata-graphics* 1)

;; In addition, a margin is left at each side of the row so that it does
;; not collide with the frame around the viewport.  The following constant
;; fixes the size of this margin, in pixels.

(define *margin* 30)

;; It is now possible to compute the width of the viewport that is needed
;; to display the automata graphics:

(define *viewport-width*
  (+ (* 2 *margin*)
     (* *number-of-automata* *size-of-automaton-graphic*)
     (* (- *number-of-automata* 1) *gap-between-automata-graphics*)))

;; Successive states of the automata as they run are represented
;; graphically by successive rows of squares.  To determine how high the
;; viewport should be, we have to fix the number of cycles for the
;; simulation.

(define *number-of-cycles* 50)

;; The number of rows of squares to be displayed is actually one greater
;; than the number of cycles, because the initial state of the machine is
;; displayed first, before the automata begin to operate.

;; Adjacent rows of squares are again separated by a narrow gap.  The
;; following constant determines the size of this gap.

(define *gap-between-rows* 2)

;; Now we're ready to compute the height of the viewport:

(define *viewport-height*
  (+ (* 2 *margin*)
     (* (+ *number-of-cycles* 1) *size-of-automaton-graphic*)
     (* *number-of-cycles* *gap-between-rows*)))

;; The next step is to call OPEN-VIEWPORT, which draws the viewport onto
;; the screen and also returns it as a value so that we can give it a name.
;; OPEN-VIEWPORT takes three arguments: the title of the viewport (a string
;; that will be printed in the frame around the viewport when it is drawn
;; on screen), its width, and its height.

(define *automata-viewport*
  (open-viewport "automata" *viewport-width* *viewport-height*))

;; The simulator for the row of automata takes as its arguments a vector
;; specifying the initial state of each automaton and a rule that each
;; automaton follows in making a transition from one state to another.  The
;; rule is supplied in the form of a procedure.  The idea is that, in each
;; cycle, an automaton senses the state of each automaton in its
;; neighborhood; those states are supplied as arguments to the rule
;; procedure, which returns the state that the automaton should assume by
;; the end of the cycle.  The neighborhood of an automaton, for purposes of
;; this program, comprises the automaton itself and its two nearest
;; neighbors on either side.  The rule procedure should therefore have
;; arity 5.

;; The SIMULATOR procedure does not actually apply the rule procedure,
;; however, but passes it to another procedure, UPDATE, which manages the
;; details of traversing the vector.  Similarly, SIMULATOR invokes a
;; separate procedure, DRAW-AUTOMATA-GRAPHICS, to draw the representations
;; of the automata onto the screen.

(define simulator
  (lambda (initial-states rule)

    ;; Make sure that INITIAL-STATES is a vector of the correct length
    ;; and contains only states.

    (if (not (and (vector? initial-states)
		  (= (vector-length initial-states) *number-of-automata*)
                  (all-vector? state? initial-states)))
	(error 'simulator
               (string-append "The first argument must be a vector of "
                              "length "
                              (number->string *number-of-automata*)
                              " containing only states")))

    ;; Make sure that RULE is at least a procedure.  (There is no good way
    ;; to test its arity or the types of its arguments and return value.)

    (if (not (procedure? rule))
        (error 'simulator
               "The second argument must be a procedure"))

    ;; Run the automata through the specified number of cycles, displaying
    ;; the states of the automata in each cycle and then updating the
    ;; automata according to the specified rule.

    (do ((automata initial-states (update automata rule))
	 (timer 0 (+ timer 1)))
        ((> timer *number-of-cycles*))
      (draw-automata-graphics automata timer))))

;; The ALL-VECTOR? procedure takes as arguments a predicate and a vector
;; and determines whether the predicate is true of all of the elements of
;; the vector, returning #T if it is and #F if it is not.

(define all-vector?
  (lambda (pred? vec)
    (let loop ((position (- (vector-length vec) 1)))
      (or (negative? position)
          (and (pred? (vector-ref vec position))
               (loop (- position 1)))))))

;; The UPDATE procedure constructs a new vector of states, reflecting the
;; operation of the rule on each automaton in the given vector.

;; Alas, this version of UPDATE is in error; when trying to determine the
;; new states of the two automata at each end of the vector, it refers to
;; non-existent positions of OLD-STATES.  One of the steps in the project
;; is to correct this defect.

(define update
  (lambda (old-states rule)
    (let ((new-states (make-vector *number-of-automata*)))
      (do ((index 0 (+ index 1)))
          ((= index *number-of-automata*) new-states)
        (vector-set! new-states index
                     (rule (vector-ref old-states (- index 2))
                           (vector-ref old-states (- index 1))
                           (vector-ref old-states index)
                           (vector-ref old-states (+ index 1))
                           (vector-ref old-states (+ index 2))))))))

;; The color of a square that is drawn by the simulator corresponds to the
;; state of the automaton it represents.  The following vector contains a
;; color for each state; the DRAW-AUTOMATA-GRAPHICS procedure selects the
;; color for each square by using the state as an index into this vector.

;; The elements of *COLOR-VECTOR* are constructed by DrScheme's MAKE-RGB
;; procedure.  `RGB' stands for ``red, green, blue,'' and the MAKE-RGB
;; procedure takes as its arguments the intensity of light of each of the
;; component colors that is to be displayed at a given pixel.

(define *color-vector*
  (vector (make-rgb 0 0 1)    ; blue
          (make-rgb 1 0 1)    ; purple
          (make-rgb 1 0 0)    ; red
          (make-rgb 1 1 0)    ; yellow
          (make-rgb 0 1 0)))  ; green

;; To obtain a procedure that can draw squares into the
;; *AUTOMATA-VIEWPORT*, one invokes DrScheme's higher-order procedure
;; DRAW-SOLID-RECTANGLE, giving it the target viewport as its argument:

(define draw-automaton
  (draw-solid-rectangle *automata-viewport*))

;; The DRAW-AUTOMATON procedure thus defined takes four arguments: the
;; position of the top left-hand corner of the rectangle to be drawn, its
;; width, its height, and its color.

;; A position in the viewport is identified by two coordinates, which are
;; here called X-COORDINATE and Y-COORDINATE.  The x-coordinate of a pixel
;; is the number of pixels in the viewport that are directly to its left;
;; its y-coordinate is the number of pixels in the viewport that are
;; directly above it.  For example, a pixel at x-coordinate 30 and
;; y-coordinate 48 would be thirty pixels in from the left edge of the
;; viewport and forty-eight pixels down from the top.  DrScheme provides a
;; MAKE-POSN procedure that constructs a viewport position, given its x-
;; and y-coordinates.

;; The DRAW-AUTOMATA-GRAPHICS procedure takes as arguments a vector of
;; automata and the number of cycles that have so far elapsed.  It then
;; draws the square that indicates the state of each automaton into the
;; viewport at a carefully calculated position.

(define draw-automata-graphics
  (lambda (states timer)

    ;; The y-coordinate is the same for all of the squares in the row.  It
    ;; is computed by adding to the top margin the number of pixels
    ;; occupied by all the preceding rows.  The value of TIMER indicates
    ;; the number of preceding rows; for each of those rows, we must allow
    ;; for the height of the squares and for the size of the gap between
    ;; the row and its successor.

    (let ((y-coordinate (+ *margin* (* timer (+ *size-of-automaton-graphic*
                                                *gap-between-rows*)))))

      ;; Run through the elements of the state vector, displaying an
      ;; automaton graphic for each one.

      (do ((index 0 (+ index 1)))
          ((= index *number-of-automata*))

        ;; The x-coordinate for a particular automaton graphic is obtained
        ;; by adding to the side margin the number of pixels occupied by
        ;; all the preceding graphics in that row.  The value of INDEX
        ;; indicates how many such graphics there have been; for each one,
        ;; we must allow for the width of the square and the size of the
        ;; gap between it and its successor.

        (let ((x-coordinate
               (+ *margin* (* index (+ *size-of-automaton-graphic*
                                       *gap-between-automata-graphics*)))))

          ;; Now we've located the coordinates of the top left-hand corner
          ;; of the square we want to draw, so we invoke MAKE-POSN to 
          ;; build the position and DRAW-AUTOMATON to put the square there.

          (draw-automaton (make-posn x-coordinate y-coordinate)
                          *size-of-automaton-graphic*
                          *size-of-automaton-graphic*
                          (vector-ref *color-vector*
                                      (vector-ref states index))))))))

;; Here are a couple of ways of setting up the vector of automata
;; initially.  Sometimes you get interesting results by letting the initial
;; states be random:

(define random-initial-state
  (let ((result (make-vector *number-of-automata*)))
    (do ((index 0 (+ index 1)))
        ((= index *number-of-automata*) result)
      (vector-set! result index (random *number-of-states*)))))

;; But it's often more instructive to set up just one automaton in a
;; non-zero state and to watch how the effects are propagated.  Here is an
;; initial vector that can be used in such experiments; it consists
;; entirely of zeroes, except for the middle element, which is 1.

(define loner-initial-state
  (let ((result (make-vector *number-of-automata* 0)))
    (vector-set! result (quotient *number-of-automata* 2) 1)
    result))

;; Here are some rule procedures that you may find interesting:

;; The SHIFT-RIGHTWARDS rule instructs each automaton to adopt the current
;; state of the automaton immediately to its left.

(define shift-rightwards
  (lambda (far-left left self right far-right)
    left))

;; The COLLECT-DISPARITY rule instructs each automaton to compute the
;; disparity between the states of its left-hand and right-hand neighbors
;; and use that as its own new state.

(define collect-disparity
  (lambda (far-left left self right far-right)
    (abs (- left right))))

;; The MODULO rule adds up the states of the five automata in the
;; neighborhood and takes the remainder of the result on division by the
;; number of states.

(define modulo-rule
  (lambda (far-left left self right far-right)
    (modulo (+ far-left left self right far-right) *number-of-states*)))

;; Now let's call the simulator:

(simulator random-initial-state collect-disparity)

;; The viewport is drawn on the screen, and it will remain there until the
;; user clicks any mouse button inside the viewport.  The following call to
;; the DrScheme procedure GET-MOUSE-CLICK causes the program to wait for
;; the click.

(get-mouse-click *automata-viewport*)

;; To make the window disappear, we call the CLOSE-VIEWPORT procedure:

(close-viewport *automata-viewport*)

;; Since we're now done with the DrScheme graphics, we close the graphics
;; subsystem to allow DrScheme to recycle the storage it occupies.

(close-graphics)