#| File is: ANIMAL.LSP  ---  Clark Elliott  version 5.0 18-FEB-97

This program tries to guess what animal you are thinking of by
asking questions. If it guesses wrong, it will learn the correct answer
for next time. It uses a dynamically constructed binary search tree.

This program works in XLISP, with a mod for generating node names, and also
in Allegro Common LISP. To return from an error in LISP, use C-d in ACL, and
C-c in XLISP. This is the reason for some of the oddities in the code.

To start LISP from within emacs, just issue, M-x, run-lisp. Your
LISP buffer will be called, "*inferior-lisp*
To run this program, after loading the file in LISP with
 (load "animal.lsp"), type (animal), in LISP. 

To save a session, after answering "n" to "Do you want to play again?,"
type (save-it "filename.ani") where filename is the name of the file into
which you wish to save your data (e.g., (save-it "a.ani") (save-it "b.ani").

To load your data back in, type (load "filename.ani") where filename is the
name of the file in which your data resides

as always in emacs, C-x, K kills a buffer, in this case *inferior-lisp*
|#

(defun animal () 
  (loop
   (run-node 'thing)
    (when (not (ask-play-again)) 
      (format t "Thanks for playing. [Use (save-it \"fname.ani\") ~
                 if you want to save your data.]~%")
      (return))))

;;; =============================================================
;;; ======   This is what we will modify:   =====================
;;; =============================================================
(setq *gloat-responses*
      (list "I thought so"
	    "Hah, you cannot fool me!"
            "Hurray for me!"))

(defun gloat ()
  (let ((i (random (length *gloat-responses*))))
    (format t "~A~%" (nth i *gloat-responses*))))

(setq *shoot-responses*
      (list "Ahh -- nuts."
       "Rats, I thought I knew that one"
       "Fooey, I will get you next time"))

(defun oh-shoot ()
  (let ((i (random (length *shoot-responses*))))
    (format t "~A~%" (nth i *shoot-responses*))))

;;; =============================================================
;;; ======   End of what we will modify  =====================
;;; =============================================================


(defun save-it (filename)
  (if (stringp filename)
      (let ((saver (open filename :direction :output 
			 :if-exists :supersede)))
	(format saver "(setq *nodes* '~s)" *nodes*)
	(format saver "~%(setq *node-count* ~s)" *node-count*)
        (close saver)) ; note SHOULD use with-open-file, not in XLISP
      (format t "Sorry, filename must be a string~%")))

(defvar *nodes*) (setq *nodes* nil)
(defvar *node-count*) (setq *node-count* 1)
(defun node-count () (incf *node-count*))

(defun node-name (n)       (first n))
(defun node-question (n)   (second n))
(defun node-yes-branch (n) (third n))
(defun node-no-branch (n)  (fourth n))

(defun defnode (name question yes-branch no-branch)
  (setq *nodes* 
	(cons (list name question yes-branch no-branch) *nodes*)))

(defnode 'thing "Is this thing a mammal" 'cow 'lizard)
;;; I encourage you to use other data sets instead. For example:
;;; (defnode 'thing "Is this car fast" 'ferrari 'yugo)
;;; (defnode 'thing "Does this sport have a round ball" 'basketball 'football)

(defun get-node (name)  (assoc name *nodes*))

(defun run-node (name)
  (let ((n (get-node name)) (response nil))
    (if (equal (ask (node-question n)) 'y)

	(if (symbolp (node-yes-branch n))
	    (if (guess (node-yes-branch n))
		(gloat)
	        (setf (cdr n)
		      (list (second n) (add-node (node-yes-branch n))
			    (fourth n)))) ; hack around xlisp shortcomming.
	    (run-node (first (node-yes-branch n))))

	(if (symbolp (node-no-branch n))
	    (if (guess (node-no-branch n))
		(gloat)
	        (setf (cdr n)
		      (list (second n) (third n)
			    (add-node (node-no-branch n)))))
	    (run-node (first (node-no-branch n)))))))

(defun ask (question) 
  (format t "~a? [y/n]~%" question)
  (read))

(defun add-node (answer-tried)
  (let ((new-thing nil) (new-node-name (node-count)) (new-node nil))
    (oh-shoot)
    (format t "~%What was it [type one word]?~%")
    (setq new-thing (read))
    (format t 
	    "Type a question that is true for ~s ~
             and false for ~s [in quotes]:~%~%"
	    new-thing answer-tried)
    (defnode new-node-name (read) new-thing answer-tried) ; read-line problem
    (list new-node-name)))

(defun ask-play-again ()
  (format t "~%Would you like to play again? [y/n]~%")
  (equal (read) 'y))

(defun guess (name)
  (format t "Is it a ~s? [y/n]~%" name)
  (equal (read) 'y))

(format t "~%~%To play animal, just type (animal) at the LISP prompt~%~%")