CS 61A    Project 3 solutions (Part II)



A5.  First we define the FOOD class:

(define-class (food name calories)
  (parent (thing name))
  (initialize (ask self 'put 'edible? #t)))

; or it can be done with a method instead of a property:

(define-class (food name calories)
  (parent (thing name))
  (method (edible?) #t))

(define-class (bagel)
  (parent (food 'bagel 300))
  (class-vars (name 'bagel)))

;;; Now for the new EDIBLE? procedure:

(define (edible? thing)
  (ask thing 'edible?))

;;; here is the eat method.  It should be inserted into make-person.

  (method (eat)
    (for-each (lambda (food)
		(ask self 'put 'strength (+ (ask self 'strength)
					  (ask food 'calories) ))
		(ask self 'lose food)
		(ask place 'gone food))
	      (filter edible? possessions)))


A6a.  Give people money.

(define-class (person name place)
  (instance-vars
   (possessions '())
   (saying "")
   (MONEY 100))
  ...
  (METHOD (GET-MONEY AMT)
    (SET! MONEY (+ MONEY AMT)) )
  (METHOD (PAY-MONEY AMT)
    (COND ((>= MONEY AMT)
	   (SET! MONEY (- MONEY AMT))
	   #T)
	  (ELSE #F) ))
  ...)


A6b. Create restaurant class.  This is all new so I won't bother with
capital letters!

(define-class (restaurant name food-class food-price)
  (parent (place name))
  (method (menu) (list (ask food-class 'name) food-price))
  (method (sell buyer order)
    (if (eq? order (ask food-class 'name))
	(if (ask buyer 'pay-money food-price)
	    (let ((food (instantiate food-class)))
	      (ask self 'appear food)
	      food)
	    #f)
	#f)) )


A7. Modification to PERSON class:

(define-class (person name place)
  ...
  (method (buy food-name)
    (let ((food (ask place 'sell self food-name)))
      (if food
	  (begin
	   (set! possessions (cons food possessions))
	   (ask food 'change-possessor self))
	  (error "could not buy" food-name) )))
  ...)


B5a.  First the easy parts:


;;; make a jail-house.  Since we give it no neighbors, there will be no
;;; entrances or exits

(define jail (instantiate place 'sing-sing))

;;; make a GO-DIRECTLY-TO method
;;; insert this into the definition of the PERSON class

  (method (go-directly-to new-place)
    (announce-move name place new-place)
    (for-each (lambda (p)
		(ask place 'gone p)
		(ask new-place 'appear p))
	      possessions)
    (ask place 'exit self)
    (set! place new-place)
    (ask new-place 'enter self))


;; Notes on the above:  The part about possessions isn't really
;; relevant for the thief who's been arrested, but we might use
;; this method for other people in other circumstances.  Since the
;; existing GO method does all of this plus more, you might choose
;; to rewrite that method so that it says
;;    (ask self 'go-directly-to new-place)
;; instead of the stuff I've duplicated here.  (That is, have the
;; old method invoke the new method.)



B5b.  We just explicitly check for no exits before the thief tries
to choose one:

(define-class (thief name initial-place)
  ...
  (method (notice person)
    (if (eq? behavior 'run)
	(LET ((EXITS (ASK (USUAL 'PLACE) 'EXITS)))
	  (IF (NOT (NULL? EXITS))
	      (ASK SELF 'GO (PICK-RANDOM EXITS))))
	(let ((food-things
	       (filter (lambda (thing)
			 (and (edible? thing)
			      (not (eq? (ask thing 'possessor) self))))
		       (ask (usual 'place) 'things))))
	  (if (not (null? food-things))
	      (begin
	       (ask self 'take (car food-things))
	       (set! behavior 'run)
	       (ask self 'notice person)) )))) )



B6.  code for police class

(define-class (police name place)
  (parent (person name place))
  (initialize (ask self 'set-talk "Crime does not pay!"))
  (method (police?) #t)
  (method (notice new-person)
    (let ((thieves (filter (lambda (thing)
			     (eq? (ask thing 'type) 'thief))
			   (ask (ask self 'place) 'things))))
      (if (not (null? thieves))
	  (let ((thief (car thieves)))
	    (ask self 'talk)
	    (for-each (lambda (thing) (ask self 'take thing))
		      (ask thief 'possessions) )
	    (ask thief 'go-directly-to jail) )) )))



;;; To give default strengths, we have to augment the INITIALIZE method
;;; for people, and create initializers for thieves and police:

(define-class (person name place)
  ...
  (initialize
   (ask place 'enter self)
   (ASK SELF 'PUT 'STRENGTH 1000))
  ...)

(define-class (police name place)
  ...
  (initialize
   (ASK SELF 'PUT 'STRENGTH 30000))
  ...)

;;; and the same deal for thieves.

;;; By the way, this works only because the OOP system ensures that
;;; an object's parent is initialized BEFORE the object itself.  So
;;; when a police object is created, it first gets a strength of 1000
;;; because of the parent person's initialize method, then the strength
;;; is changed to 30000 when the police itself is initialized.




B7.  We need a modified take method in the person class
and a new may-take method in the thing class.

      (method (take thing)
      	(cond ((not (thing? thing)) (error "Not a thing" thing))
 	      ((not (memq thing (ask place 'things)))
	       (error "Thing taken not at this place"
		      (list (ask place 'name) thing)))
	      ((memq thing possessions) (error "You already have it!"))
	      (ELSE
	       (LET ((REPLY (ASK THING 'MAY-TAKE SELF)))
		 (IF REPLY
		     (BEGIN
		      (ANNOUNCE-TAKE NAME REPLY)
		      ;; add it to my possessions
		      (set! possessions (cons REPLY possessions))
	       
		      ;; go through all the people at the place
		      ;; if they have the object we are taking
		      ;; make them lose it and have a fit
		      (for-each
		       (lambda (pers)
			 (if (and (not (eq? pers self)) ; ignore myself
				  (memq REPLY (ask pers 'possessions)))
			     (begin
			      (ask pers 'lose REPLY)
			      (have-fit pers))))
		       (ask place 'people)))
	       
		     ;; actually change the possessor
		     (ask REPLY 'change-possessor self)
		     'taken)
		 (ANNOUNCE-TOO-WEAK NAME THING) )))
      ...)

;;; And here's the MAY-TAKE? method for the thing class:

      (method (may-take? who)
	(cond ((eq? possessor 'no-one) self)
	      ((> (ask who 'strength) (ask possessor 'strength)) 
	    	self)
	      (else #f)))

;;; still need to write annouce-too-weak, but it's boring.


8.  Subgroup A invented restaurants that deal with food classes that
have THING as their parent class.  Meanwhile, subgroup B invented a FOOD
class; the foods that restaurants serve should really be subclasses of
that.  The big difference is that when a FOOD is instantiated we have to
give it a number of calories.  So we'll do something like

(define-class (bagel)
  (parent (food 'bagel 300)))

Of course, both subgroups wrote new methods for the PERSON class, and
so on, which must be combined, but there isn't any single method that was
modified differently by the two groups.

Now for the business about the police.

(define-class (restaurant name food-class food-price)
  (parent (place name))
  (method (menu) (list (ask food-class 'name) food-price))
  (method (sell buyer order)
    (if (eq? order (ask food-class 'name))
	(if (OR (POLICE? BUYER) (ask buyer 'pay-money food-price))
	    (let ((food (instantiate food-class food-name)))
	      (ask self 'appear food)
	      food)
	    #f)
	#f)) )