; PROJECT 2, due Friday, May 9, 2008
;--------------------------------
; simulation of simple foxes-rabbits-grass world

; implementation of two-dimensional arrays

(define (make-array rows cols fill) ; fill is the initial value of each element
  (do ((a (make-vector rows))
       (n 0 (+ n 1)))
      ((= n rows) a)
      (vector-set! a n (make-vector cols fill))))

(define (array-ref array row col)
  (vector-ref (vector-ref array row) col))

(define (array-set! array row col obj)
  (vector-set! (vector-ref array row) col obj))

; The world of the simulation consists of locations arranged in a
; world-size x world-size grid.

(define world-size 20)

(define grass-world (make-array world-size world-size #f))

(define animal-world (make-array world-size world-size #f))


; Each location in the world will be represented by a o-size x o-size pixel 
; square in the graphics window, so the window size (width, height) is 
; o-size * world-size.

(define o-size 20) ; Also the width and height of an object (animal or grass)

(define size (* o-size world-size))

; Each world location will be empty or will contain one object, either an
; animal or some grass.  The basic simulation routine simply scans a
; random list of the objects in the world and sends a 'tick message to each
; object.  The 'tick message will cause grass objects to grow and spread,
; rabbits to eat grass and give birth to other rabbits, and foxes to eat
; rabbits, fight each other and give birth to other foxes.

; In order to be fair to all the objects in the simulated world, the objects
; have to be given their 'tick messages in a different order in each cycle of
; the simulation.  The function rearrange takes a list as its argument and
; returns another list containing the same objects as the input list, but in
; a random order.  (Well, it won't be quite random, but it should be random
; enough for our purposes.)  Using an auxiliary function, rearrange steps
; through the list and removes every third object from the list and puts it
; in a new list that it is building.  The way to remove an object from 
; the original list if the auxiliary function has cdred down the list to
; its current-position in the list, is to set a local variable to the cadr of
; the current-position, set the cdr of the current-position to the cddr of
; the current-position, and then call the auxiliary function with the
; current-position and the object saved in the local variable consed onto
; the new list.  Since the first object in the original list will have to
; be removed at some time and put on the new list, but all objects are removed
; by setting the cdr of a pair to the cddr of the pair, rearrange conses a
; dummy object onto the front of the original list before passing it to the
; auxiliary function.  Also, when the auxiliary function finds itself at the
; last pair in the list, it immediately calls itself with the entire list
; (beginning with the dummy object) again and continues cdring down the list
; until it finds the next third object to be removed.  The auxiliary function
; will also need to keep track of the number of objects yet to be removed from
; the list; every time it removes an object and puts it on the new list, it
; decrements this number.  When the number reaches 0, the original list
; contains only the dummy object.  The new list, which now contains all of the
; original objects (but in a different order) is then returned.

; To illustrate, and to provide a test case, here is a trace of the behavior
; or rearrange:

; (define a '(0 1 2 3 4 5 6 7 8 9))
; (set! a (rearrange a))
; a
; (3 9 4 7 0 6 1 8 5 2)
; (set! a (rearrange a))
; a
; (7 2 0 8 3 1 9 5 6 4)

; Hints:  In rearrange, you can use a local variable to hold the original
; list with the dummy object consed onto it.  Then define the nested auxiliary
; function with four arguments: the current-position it is at in the list,
; the number of objects still to be removed from the list, the count of the
; number of cdrs it has yet to do before removing an object, and the new list
; on which the auxiliary function puts the object once it is removed from 
; the cadr of the current-position and the cdr of the current-position is set
; to the cddr of the current-position. The auxiliary function is called with
; the current-position being the entire list (including the added dummy 
; object), the number of items to be removed being the length of the original
; list (before the dummy object was added), the cdr count being 2, and the new
; list being initially empty.

; YOUR ASSIGNMENT, PART 1: Implement the rearrange procedure.
; Turn in a listing of your code.

(define (rearrange lst)
; You supply definition here.

; On each cycle of the simulation, update-world will combine the new-objects
; with the current active-objects.  Then it will filter this list, leaving
; out the objects that are no longer alive.  Next it rearranges this list
; and finally it sends a 'tick message to every object on the list.  If the
; list contains no animals, update-world returns #f to indicate that the
; simulation is over.

(define new-objects ())
(define active-objects ())

(define (filter proc list)
  (cond ((null? list) ())
        ((proc (car list)) (cons (car list) (filter proc (cdr list))))
        (else (filter proc (cdr list)))))

(define (update-world)
  (set! active-objects (rearrange (filter (lambda (obj) (obj 'alive?))
                                          (append new-objects active-objects))))
  (set! new-objects ())
  (if (zero? (rabbit-count active-objects))
      #f
      (map (lambda (obj) (if (obj 'alive?) (obj 'tick))) active-objects)))

(define (rabbit-count lst)
  (cond ((null? lst) 0)
        ((eq? ((car lst) 'type) 'rabbit)
	 (+ 1 (rabbit-count (cdr lst))))
        (else (rabbit-count (cdr lst)))))
    

; The simulation simply calls update-world over and over until
; the specified cycle limit has been reached or until there are
; no more rabbits.  It returns 'done if it reaches the limit (n)
; or it returns the number of cycles it did before all the rabbits
; disappeared.

(define (run n)
  (define (run-aux t)
    ;(sleep 0.5) ; uncomment to slow down simulation
    (display t)
    (newline)
    (if (= t n)
	'done
	(if (update-world)
	    (run-aux (+ t 1))
	    t)))
  (init-graphics-window)
  (init-world)
  (run-aux 0))

; The objects in the world consist of grass and animals.
; The locations of the initial grass and animals are given
; by listing their i and j coordinates in separate lists:

(define grass-list '((1 5) (4 3) (6 9) (2 6) (7 2)))
(define rabbit-list '((7 5) (4 2) (2 9)))
(define fox-list '((4 9) (2 2)))

; Init-world puts the animals and grass in the world using
; the above lists.

(define (init-world)
  (set! new-objects ())
  (set! active-objects ())
  (do ((i 0 (+ i 1)))
      ((>= i world-size))
      (do ((j 0 (+ j 1)))
	  ((>= j world-size))
        (array-set! grass-world i j #f)
        (array-set! animal-world i j #f)))
  (map plant-grass grass-list)
  (map place-rabbit rabbit-list)
  (map place-fox fox-list))

(define (plant-grass ij)
 (let ((i (car ij))
       (j (cadr ij)))
  (let ((new-grass (make-grass i j (random max-growth))))
       (array-set! grass-world i j new-grass)
       (set! new-objects (cons new-grass new-objects))
       (new-grass 'draw))))

(define (place-rabbit ij)
 (let ((i (car ij))
       (j (cadr ij)))
  (let ((new-animal (make-rabbit i j (+ (random rabbit-breed-level) 1))))
       (array-set! animal-world i j new-animal)
       (set! new-objects (cons new-animal new-objects))
       (new-animal 'draw))))

(define (place-fox ij)
 (let ((i (car ij))
       (j (cadr ij)))
  (let ((new-animal (make-fox i j (+ (random fox-breed-level) 1))))
       (array-set! animal-world i j new-animal)
       (set! new-objects (cons new-animal new-objects))
       (new-animal 'draw))))

; A rabbit will need to choose randomly from its adjacent locations.
; It will need to do this in order to move, and when it has enough energy
; to reproduce, it will need to do this to determine where its offspring
; will be born.  The function that computes such a random spot is next-spot.
; If there are no adjacent locations, it returns the same spot it started from.

(define (next-spot i j)
  (do ((candidates ())
       (di -1 (+ di 1)))
      ((> di 1)
       (if (null? candidates)
	   (list i j)  ; no adjacent spots
	   (let ((choice (random (length candidates))))
		(list-ref candidates choice))))
      (do ((dj -1 (+ dj 1)))
	  ((> dj 1))
	  (let ((ii (+ i di))
		(jj (+ j dj)))
	       (if (and (>= ii 0) (< ii world-size)
			(>= jj 0) (< jj world-size))
		   (set! candidates (cons (list ii jj)
					  candidates)))))))

; The remaining code depends on graphics procedures.

(require (lib "graphics.ss" "graphics"))

(open-graphics)

(define w (open-viewport "simulation" size size))

(define (init-graphics-window) ((clear-viewport w)))

(define green (make-rgb 0 1 0))
(define red (make-rgb 1 0 0))
(define white (make-rgb 1 1 1))
(define blue (make-rgb 0 0 1))

; Animals and grass will be defined as procedures that
; respond to messages.  We need a constructor procedure
; to create these procedures for us.

; Grass will be represented by a green rectangle of size
; o-size pixels by o-size pixels.  If the world coordinates
; of the grass are i,j then the green rectangle will be
; drawn at location o-size * j, o-size * i in the graphics
; window.

(define rectangle (draw-solid-rectangle w))

; Note that with the rectangle procedure, a green square
; can be drawn at point x,y in the graphics window with the
; command (rectangle (make-posn x y) o-size o-size green).

; Grass has a location i,j in the world, and an internal growth
; parameter.  Growth starts with value 0 and increments by 1 
; with each cycle of the simulation.  When growth reaches the
; value of max-growth, the grass reproduces in every adjacent
; space, and the growth parameter is reset to 0.

(define max-growth 3)

; The above paragraph describes what grass does in response to
; the message 'tick.  The other messages that it responds to are:

; draw -- the grass draws itself at the appropriate place in the
; graphics window.

; refresh -- the grass draws itself but also any animal
; standing on it.

; type -- returns the value 'grass. 

; alive? -- returns #t if it is still alive, #f if it has been eaten.

; chomp -- the grass has been eaten; grass is now dead.

; Here is code for making a grass procedure:

(define (make-grass i j growth)
  (let ((living #t))
    (lambda (msg)
      (cond ((eq? msg 'tick)
	     (set! growth (+ growth 1))
	     (if (= growth max-growth)
                 (begin
		   (set! growth 0)
		   (do ((di -1 (+ di 1)))
		       ((> di 1))
		       (do ((dj -1 (+ dj 1)))
		           ((> dj 1))
		           (let ((ii (+ i di))
			         (jj (+ j dj)))
			        (if (and (>= ii 0) (< ii world-size)
				         (>= jj 0) (< jj world-size)
					 (not (array-ref grass-world ii jj))
					 )
				    (let ((new-grass (make-grass ii jj 0)))
					 (array-set! grass-world
                                                     ii
                                                     jj
                                                     new-grass)
					 (new-grass 'refresh)
				         (set! new-objects 
					       (cons new-grass
					             new-objects))))))))))
	    ((eq? msg 'draw)
	     (rectangle (make-posn (* o-size j) (* o-size i))
		         o-size o-size green))
            ((eq? msg 'refresh)
             (let ((me (array-ref grass-world i j))
                   (animal (array-ref animal-world i j)))
               (me 'draw)
               (if animal (animal 'draw))))
	    ((eq? msg 'type)
	     'grass)
	    ((eq? msg 'chomp)
	     (array-set! grass-world i j #f)
	     (set! living #f)
	     (rectangle (make-posn (* o-size j) (* o-size i))
		         o-size o-size white))
	    ((eq? msg 'alive?)
	     living)
	    (else (error "bad message to grass" msg))))))

; Rabbits will be implemented in a similar way to the implementation
; of grass.  A rabbit will be displayed as a red circle made with
; the ellipse procedure:

(define ellipse (draw-solid-ellipse w))

; If a rabbit is located in the world at i,j, it is drawn in
; the graphics window by the command

; (ellipse (make-posn (* o-size j) (* o-size i)) (- o-size 2) (- o-size 2) red)

; You have to define the make-rabbit procedure that makes the 
; procedure that accepts messages.  When a rabbit procedure
; is created, it has a location i,j and an internal energy.
; This energy is initialized to the birth-energy level.

(define birth-energy 20)

; The messages that a rabbit can receive are the following:

; tick -- The rabbit subtracts 1 from its energy.  If the energy gets
; to be <= zero, the rabbit dies; it does the same thing that it would
; do if it received the 'chomp message.  If the energy
; is still greater than 0, it gets hold of itself by calling
; (array-ref world i j) and moves itself to a
; new location obtained by calling 'next-spot.
; Note: the rabbit has to draw a white rectangle in the square where it
; was and a red circle where it has just moved to. (If the next spot is
; the same as the current spot, there is no need to draw anything.)

; If the location that the rabbit is about to move to is occupied by grass,
; the rabbit sends a 'chomp message to the grass to kill it and increments
; its own energy by the value of 'grass-food-value before moving to the new
; location.   Note: if there is an animal standing on the grass, the rabbit
; doesn't do anything except lose energy.

(define grass-food-value 10)

; If the energy is >= rabbit-breed-level, the rabbit gives birth
; to another rabbit in an adjacent location.  Use the next-spot
; procedure to get the adjacent location.  If that location is empty,
; create the rabbit with 'make-rabbit and put it in the adjacent location
; in the world array.  Also subtract birth-energy from the (parent)
; animal's energy; this is the cost of giving birth.  Don't forget to
; put the new rabbit on the new-objects list.

(define rabbit-breed-level 40)

; chomp -- This is the message that a fox sends to a rabbit when it eats the
; rabbit. The rabbit must remove itself from the animal-world array, mark itself as
; not living, and draw a green or white rectangle where it used to be.

; draw -- The animal draws itself in the graphics window.

; type -- Returns the value 'rabbit.

; alive? -- returns #f if it is no longer alive.

; YOUR ASSIGNMENT, PART 2: Define the make-rabbit procedure so that it
; returns a procedure that responds to the above messages as described.
; Turn in a listing of your code.

; Foxes are similar to rabbits with the following differences;

; Foxes receive no 'chomp messages because nothing can eat them.

; When a fox receives a 'tick message, it examines the locations next to it.
; If one or more locations is occupied by a rabbit, it eats the rabbit and
; moves to that location. Its energy increases by rabbit-food-value.

(define rabbit-food-value 10)

; If it finds another fox in that location, they fight and one of them has to
; die.  The easiest way to implement this is to have the fox commit suicide
; when it finds another fox next to it.

; If none of the adjacent locations contains a rabbit or a fox, the fox moves to any
; adjacent location. It decrements its energy level by 1.

; Foxes are represented by blue circles instead of red circles.

; Fox breeding is controlled by the 'fox-breed-level variable.  Birth-energy
; will be the same for foxes as for rabbits.

(define fox-breed-level 100)

; YOUR ASSIGNMENT, PART 3: Implement the 'make-fox procedure.  You may want
; to define one or two auxiliary functions analogous to next-spot to help the
; fox decide where to move to.  Turn in a listing of your procedure(s).

; YOUR ASSIGNMENT, PART 4:  Experiment with the system using
; different integer values for max-growth and the other global parameters.
; Turn in a very short report of your findings.  In particular, what happens
; when rabbit-breed-level is made smaller (rabbits breed faster)?  What happens
; when rabbit-breed-level is made larger (rabbits breed slower)?  What seems to
; be the range of values for rabbit-breed-level and for rabbit-food-level for
; the animals to live indefinitely?  Keep in mind that, due to the random
; function, the number of cycles that the animals survive will vary if you call
; run several times in a row without changing any parameters.

; GENERAL HINTS: For the message-passing paradigm, see pages 186-187.
; Note that in the grass example, I used a lambda expression rather
; than the explicitly named dispatch function in the book's example.
; (Ignore talk about the 'apply-generic procedure.)

; For objects with local state, see section 3.1.1, but note that in
; some ways, the code for make-grass is simpler than some of the
; examples in section 3.1.1.  In particular, the grass and animal
; procedures never return procedures as a value as the example on page
; 223 does.  Instead, they execute the appropriate code immediately
; and return either nothing, a symbol or a number.

; GENERAL HINT ABOUT MOVING ANIMALS:  Both rabbits and foxes move to the place
; where their food was.  If the square where a rabbit wants to move is occupied
; by grass, it must first chomp the grass, which will make the square empty,
; then it moves there.  Similarly, if the square where a fox wants
; to move to is occupied by a rabbit, it chomps the rabbit first, then
; moves there.

; For both rabbits and foxes, an animal moves by first setting a local
; variable to itself, setting the square where it was in the world array
; to #f, and putting itself, in the new square.  Thus, in outline, the
; code for moving the animal would look something like this:

;  (let ((me (array-ref animal-world i j)))
;       (vacate i j)
;       some code goes here
;       (array-set! animal-world ii jj me))

;  where ii, jj are the coordinates of the new location where the animal is
; moving to.  You will also have to put in lines of code to 
; draw the animal in the new square, and update its memory
; of where it is (i.e., the values of i and j).


; Auxiliary function for vacating a location

(define (vacate i j)
  (array-set! animal-world i j #f)
  (let ((grass (array-ref grass-world i j)))
    (if (and grass (grass 'alive?))
        (grass 'draw)
        (rectangle (make-posn (* o-size j) (* o-size i))
		            o-size o-size white))))

(define (make-rabbit i j energy)
; You supply definition here.
 )

(define (make-fox i j energy)
; You supply definition here.

;(run 100)