;; Generates a random sentence according to *grammar* (a global
;; variable currently set to *bigger-grammar*).  To generate a
;; random sentence, enter (generate 's).  (In fact, you can generate
;; any type of phase defined in the grammar with generate --
;; try (generate 'np), (generate 'vp), (generate 'det), etc.)
;; 
;; Each grammar rule has the following format:
;; (<non-terminal> -> <list of alternatives>)
;; An alternative that is a list of elements, say (n1...nj),
;; is an and-node:  choosing that alternative amounts to
;; choosing all of n1...nj, in that order.

(setf *little-grammar* '(
    (s -> (np vp))
    (np -> (det noun) noun)
    (vp -> (verb np))
    (det -> a the)
    (noun -> cat cats dog dogs)
    (verb -> chased saw)))
   
(setf *bigger-grammar* '(
    (s -> (np vp))
    (np -> (det adj* noun pp*) name)
    (np -> pronoun)
    (vp -> (verb np))
    (adj* -> () (adj adj*))
    (pp* -> () (pp pp*))
    (pp -> (prep np))
    (adj -> colorless silly cold nice happy)
    (prep -> on with in)
    (det -> a the)
    (noun -> cat cats dog dogs)
    (name -> Sam Juan Anile)
    (pronoun --> he she it they)
    (verb -> chased saw visited)))   
 
(setf *grammar* *bigger-grammar*)
; setf *grammar* to the grammar you want to use.

(defun rule-lhs (rule) (first rule))

(defun rule-rhs (rule) (rest (rest rule)))

;====================================
; rewrites (cat):  cat is a non-terminal of the grammar.
; Returns all of the alternative ways to rewrite
; cat according to *grammar*.  The data structure is
; the same as a right-hand-side:  alternatives that
; are symbols are or-nodes; alternatives that are lists
; are and-nodes.

; This is the "first-rest" recursive version of rewrites.
; It works fine.  
;(defun rewrites (cat) (rewriteHelper cat *grammar*))

;(defun rewriteHelper (cat grammar)
;   (cond ((null grammar) nil)
;         ((equal cat (rule-lhs (first grammar)))
;             (append (rule-rhs (first grammar))
;                     (rewriteHelper cat (rest grammar))))
;         (t (rewriteHelper cat (rest grammar)))))

;==================================
; rewrites (cat):  cat is a non-terminal of the grammar.
; Returns all of the alternative ways to rewrite
; cat according to *grammar*.  The data structure is
; the same as a right-hand-side:  alternatives that
; are symbols are or-nodes; alternatives that are lists
; are and-nodes.

(defun rewrites (cat)
   (apply #'append
           (mapcar #'(lambda (rule)
                        (if (equal cat (rule-lhs rule))
                            (rule-rhs rule)
                            nil))
                   *grammar*)))

(defun random-elt (choices)
   (elt choices (random (length choices))))

(defun generate (phrase)
; See notes below on calling generate with nil.
   (if (listp phrase)
       (apply #'append (mapcar #'generate phrase))
       (let ((choices (rewrites phrase)))
         (if (null choices)
             (list phrase)
             (generate (random-elt choices))))))

;  Suppose that generate is called with nil or the equivalent ().
;  This happens when the () option is chosen in adj* or pp* in 
;  *bigger* grammar.  What happens?

;  listp applied to nil returns true, so the apply-append-mapcar
;  statement is executed.  MAPCAR, WHEN ITS SECOND ARGUMENT IS
;  NIL, SIMPLY RETURNS NIL.  Applying append to nil yields nil,
;  so the final result is nil.


;Here is a function that returns the syntactic structure of the
; sentence which is implied by the rule applications.

(defun generate-tree (phrase)
;Generates a random sentence or phrase, returning the parse tree.
   (if (listp phrase)
       ; change 1--don't flatten the result by applying append
       ; to the result of the mapcar.
       (mapcar #'generate-tree phrase)
       (let ((choices (rewrites phrase)))
         (if (null choices)
             (list phrase)
             ;change 2--cons the phrase onto the front of the
             ;  rewrite of the phrase.
             (cons phrase (generate-tree (random-elt choices)))))))