;;;;;;;;;;;;;;;;;
;;;
;;; "JoyceBot.2"
;;;
;;; THE INTRO TO AI SHOW
;;; Summer 99
;;;
;;;   --Selmer Bringsjord
;;;
;;; JoyceBot.2 is an excruciating simple artificial storyteller. 
;;; In order to use the code, load, and activate the function
;;; tell-story.  Then, for some more complicated stories, change
;;; *grammar* to *bigger-grammar* via
;;;
;;;    (setf *grammar* *bigger-grammar*)
;;;
;;; How might you adapt this program in conjunction with the reading in of a
;;; sentence to produce an agent able to play the S3G game?
;;;
;;; The underlying sentence generator is from Section 2.3 of
;;; Peter Norvig's *Paradigms of AI Programming*
;;; which makes a nice complement to the *AIMA* text.
;;;
;;;;;;;;;;;;;;;;;

;(defvar *reader* 'Junior)

(defun tell-story ()
  (append (tell-storyheart) 
  `(And that -- ,*reader* -- concludes my tale)
  '(- by Ralph the Mean Green Droid)))

(defun tell-storyheart ()
  (let ((story (append '(Once upon a time) (append (generate 'sentence) '(*)))))
    (get-name)
    (dotimes (len (random 20) story)
      (setf story (append story (append (generate 'sentence) '(*)))))))

(defun get-name ()
  (format t "~%Please type in your name and press ENTER: ")
  (setf *reader* (read)))

;;; The following functions are used for sentence generation.

(defun mappend (fn the-list)
  "Apply function to each element of list and append the results."
  (apply #'append (mapcar fn the-list)))

(defun one-of (set)
  "Pick one element of a set, and make a list of it."
  (list (random-elt set)))

(defun random-elt (choices)
  "Choose an element from a list at random."
  (elt choices (random (length choices))))


;;; The first (simple) grammar used.

(defparameter *simple-grammar*
  '((sentence -> (noun-phrase verb-phrase))
    (noun-phrase -> (Article Noun)) 
    (verb-phrase -> (Verb noun-phrase))
    (Article -> the a)
    (Noun -> man ball woman table)
    (Verb -> hit took saw liked))
  "A grammar for a trivial subset of English.")

;;; Initially *grammar* is set to *simple-grammar*

(defvar *grammar* *simple-grammar*
  "The grammar used by generate.  Initially, this
  is *simple-grammar*, but we can switch to other
  grammars.")


(defun rule-lhs (rule)
  "The left-hand side of a rule."
  (first rule))
  
(defun rule-rhs (rule)
  "The right-hand side of a rule."
  (rest (rest rule)))

(defun rewrites (category)
  "Return a list of the possible rewrites for this category."
  (rule-rhs (assoc category *grammar*)))


;;;;;;;;;;
;;;
;;; Here's the function that will now generate sentences.
;;; This is a neat piece of code, and warrants close inspection.
;;;
;;;;;;;;;;

(defun generate (phrase)
  "Generate a random sentence or phrase."
  (cond ((listp phrase)
         (mappend #' generate phrase))
        ((rewrites phrase)
         (generate (random-elt (rewrites phrase))))
        (t (list phrase))))


(defparameter *bigger-grammar*
  '((sentence -> (noun-phrase verb-phrase))
    (noun-phrase -> (Article Adj* Noun PP*) (Name) (Pronoun))
    (verb-phrase -> (Verb noun-phrase PP*))
    (PP* -> () (PP PP*))
    (Adj* -> () (Adj Adj*))
    (PP -> (Prep noun-phrase))
    (Prep -> to in by with on)
    (Adj -> gargantuan microscopic blue green adiabatic)
    (Article -> the a)
    (Name -> Junior Anita Max Terry Robin)
    (Noun -> man ball woman resort)
    (Verb -> killed stole beheld loved)
    (Pronoun -> he she it these those that)))