;; Exercise 2:        4 pts
;; ========================
;; correct:           3 pts
;; 243!:              1 pt


;; Exercise 3:        8 pts

;; Exercise 4:        8 pts
;; ========================
;; nesting:           4 pts
;; recursive:         2 pts
;; otherwise correct: 2 pts

;; Exercise 5:        8 pts
;; ========================
;; uses equal:        2 pts
;; otherwise correct: 6 pts


;; Exercise 6:       10 pts
;; ========================
;; counts correctly:  3 pts
;; assoc-list:        3 pts
;; non-redundant:     2 pts
;; sorted:            2 pts


;; Exercise 7:        4 pts

;; Exercise 8:        4 pts
;; ========================
;; *print-level*:   1.5 pts
;; *print-length*:  1.5 pts
;; nil values:        1 pt


;; Exercise 9:        8 pts
;; ========================
;; sample sentences:  2 pts
;; grammar:           6 pts


;; Exercise 10:       8 pts
;; ========================
;; stores result:     4 pts
;; correct:           4 pts


;; Exercise 11:       8 pts
;; ========================
;; non-terminal-p:    4 pts
;; generate:          4 pts


;; Exercise 12:      30 pts
;; ========================
;; assertions:       12 pts
;; questions:        12 pts
;; interactive:       3 pts
;; useful comments:   3 pts

(defun fact (n)
  (if (= n 0) 1
      (* n (fact (- n 1)))))

;;;-------------------------------------------------------------------------

(defun palindromep (x)
  "list X is a palindrome if it prints the same when its elements are reversed"
  (equal x (reverse x)))

;;;-------------------------------------------------------------------------

(defun presentp (a lst)
  "an atom a is present in list lst if it is:
   1) eql to the car (the "car" is the first elt), if the car is an atom
   2) present in the car, if the car is not an atom
   3) present in the cdr (rest of the list)
   remember we also need to check for a null list 
   so that we terminate (rest nil) => NIL"
  (cond ((null lst) NIL)
        ((atom (first lst))
         (or (eql a (first lst))
             (presentp a (rest lst))))
        (t (or (presentp a (first lst))
               (presentp a (rest lst))))))

;;;-------------------------------------------------------------------------

(defun duplicate-entries (lst)
  "list lst contains duplicate entries either if the first elt is present in
   the rest of lst or if the rest of lst contains duplicate entries.
   Terminate when the rest of lst is empty."
  (cond ((null (rest lst)) NIL)
	((member (first lst) (rest lst) :TEST #'equal) t)
	(t (duplicate-entries (rest lst)))))

;;;-------------------------------------------------------------------------

(defun occurrences (lst)
  "Generate using mapcar an assoc-list containing the count of each elt of
   lst. Then sort the assoc-list in descending order of the stored count
   (i.e. the cdr of each assoc-pair)."
  (sort (mapcar #'(lambda (elt) (cons elt (count elt lst)))
		(remove-duplicates lst))
	#'>
	:KEY #'cdr))

;;;-------------------------------------------------------------------------
;;; Exe7. Why does (member '(a) '((a) (b)) return nil?
;;;-------------------------------------------------------------------------
;;; Because member function uses eql function to compare two entries by default, 
;;; and eql returns true only if its arguments are the same object.  In this case, 
;;; the first parameter and the second parameter of the eql function are different 
;;; objects(different memory locations), so eql will return nil.
;;;   A revised version could be (member '(a) '((a) (b)):Test #'equal)


;;;-------------------------------------------------------------------------
;;; Exe8. "print-level" and  "print-length"
;;;-------------------------------------------------------------------------
;;; print-level can be either nil or a positive integer. If it is a integer, 
;;; obejects nested up to that depth will be displayed, the rest being elided. If 
;;; it is nil, there is no limit.
;;;============
;;; print-length can also be either nil or a positive integer. If it is an 
;;; integer, up to that many elements of an object will be displayed, the rest 
;;; being elided. If it is nil, there is no limit.

;;;-------------------------------------------------------------------------
;;; Exe9. "bigger-grammar" and "my-grammar"
;;;-------------------------------------------------------------------------

;;;-------------------------------------------------------------------------
;;; 9a. switch to the bigger grammar by adding the following sentence at the 
;;;     end of the prog1.lisp file:
;;;-------------------------------------------------------------------------
    (setf *grammar* *bigger-grammar*)

   Below are some sentences generated by the bigger grammar:

    CL-USER 27 > (generate 'sentence)
    (THE WOMAN LIKED THAT BY ROBIN)
    CL-USER 28 > (generate 'sentence)
    (KIM TOOK KIM)
;;;-------------------------------------------------------------------------
;;; 9b. switch to the grammar defined by myself by adding the following
;;;     sentences at the end of the prog1.lisp file:
;;;     (Actually one of students did this, I think it's very neat...)
;;;-------------------------------------------------------------------------    
(defparameter *my-grammar* 
  '((assign -> (var equals var operator var))
    (operator -> + * - /)
    (var -> a b c)
    (equals -> := )))

(setf *grammar* *my-grammar*)

 
;;;-------------------------------------------------------------------------
;;;  Exe10. change the function generate to the following version:
;;;         VERSION WITH ONE CALL TO REWRITES
;;;-------------------------------------------------------------------------
(defun generate (phrase)
  "Generate a random sentence or phrase"
  (cond ((listp phrase)
         (mappend #'generate phrase))
        ((setf x (rewrites phrase))
         (generate (random-elt x)))
        (t (list phrase))))

;;;-------------------------------------------------------------------------
;;; Exe11. add the function non_terminal_p just before the function generate, 
;;;        and change the function generate to the following version.
;;;-------------------------------------------------------------------------
(defun non_teminal_p (phrase)
  (assoc phrase *grammar*))
  
(defun generate (phrase)
  "Generate a random sentence or phrase"
  (cond ((listp phrase)
         (mappend #'generate phrase))
        ((non_teminal_p phrase)
         (generate (random-elt (rewrites phrase))))
        (t (list phrase))))

    
;;;-------------------------------------------------------------------------
;;; Exe12. ASK-AND-TELL

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   Main Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defvar *kb* (make-hash-table :TEST #'equal)
  "Defines the knowledge base, which is a hash table.
   The hash key is each person' name; each entry also has a field
   containing a list containing two sublists:  the first is a list
   of the person's likes, the second is a list of their dislikes.
   E.g., a sample entry is [jane ((pretzels hiking) (pizza)]")

(defun ask-and-tell (statement)
  "Processes a top-level statement (arg1), according to its type.
   Reply to questions; let the user known if the information is
   already in the knowledge base; verify contradictory information,
   and, if verified update the knowledge base; add new information.
   In all cases, set the local variable 'the-reply' to the message
   that should be printed out."
  (let ( (n (get-name statement))
         (v (get-valence statement))
         (o (get-object statement))
         (the-reply NIL))
      (cond ( (question statement) (setf the-reply (reply n v o)))
            ( (already-known n v o) (setf the-reply "I know that already."))
            ( (contradictory n v o) 
              (if (they-are-sure)
                  (and (delete-entry n (invert v) o) (add-entry n v o)))
              (setf the-reply "Ok."))
            (t (add-entry n v o) (setf the-reply "Ok.")))
      the-reply))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Functions for parsing input statements
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun get-name (statement)
  "Get the 'name' from an input statement (arg1)"
  (cond ((question statement) (second statement))
        (t (first statement))))

(defun get-valence (statement)
  "Get the 'valence' (likes or dislikes) from an input statement (arg2)"
  (cond ((question statement) (third statement))
        (t (second statement))))

(defun get-object (statement)
  "Get the object that is liked or dislikes from an input statement (arg3)"
  (cond ((question statement) (fourth statement))
        (t (third statement))))

(defun question (statement)
  "Determine whether something (arg1) is a question."
  (eq (first statement) 'does))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   Functions for Accessing and Modifying the Knowledge Base
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun not-known (name)
  "Determine whether there are any entries in the KB with hash key
   equal to arg1  "
  (not (gethash name *kb*)))

(defun likes (name)
  "Returns the list of things that arg1 likes"
  (car (gethash name *kb*)))

(defun dislikes (name)
  "Returns the list of things that arg1 dislikes"
  (cadr (gethash name *kb*)))

(defun make-new-entry (name)
  "Add a new entry to the KB, for the person named arg1"
  (setf (gethash name *kb*) '(nil nil)))

(defun add-entry (name valence object)
  "Add arg3 to the list of things arg1 likes or dislikes (according
   to arg2.  First makes sure there is already an entry in the KB
   for arg1, and if not makes one  "
  (progn
    (if (not-known name) (setf (gethash name *kb*) '(nil nil)))
    (cond ( (eq valence 'likes)
            (setf (gethash name *kb*) (list (cons object (likes name))
                                            (dislikes name))))
          ( (eq valence 'dislikes)
            (setf (gethash name *kb*) (list (likes name) 
                                            (cons object (dislikes name))))))))

(defun delete-entry (name valence object)
  "Deletes arg3 from the list of things arg1 likes or dislikes (according
   to arg2)  "
  (cond ( (eq valence 'likes)
          (setf (gethash name *kb*) (list (delete object (likes name))
                                  (dislikes name))))
        ( (eq valence 'dislikes)
          (setf (gethash name *kb*) (list (likes name) 
                                  (delete object (dislikes name)))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Other functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun already-known (name valence object)
  "See if some input statement reflects information already in the KB.
   To do this test whether arg3 is already on the list of likes or
   dislikes (accorind to arg2) for arg1.  "
  (if (eq valence 'likes) (member object (likes name))
             (member object (dislikes name))))


(defun contradictory (name valence object)
  "Checks whether some input statement is contradictory with information
   already in the KB.  To do this, test whether arg3 is on the opposite
   list of likes or dislikes from arg2, for arg1  "
  (cond ( (eq valence 'likes) (member object (dislikes name)))
        ( (eq valence 'dislikes) (member object (likes name)))))


(defun reply (name valence object)
  "Replies to a question.    "
  (cond ( (not-known name) "I don't know")
        (  (and (eq valence 'like) (member object (likes name)))
           "Yes.")
        ( (and (eq valence 'like) (member object (dislikes name)))
          "No.")
        (  (and (eq valence 'dislike) (member object (dislikes name)))
           "Yes.")
        ( (and (eq valence 'dislike) (member object (likes name)))
          "No.")
        (t "I don't know.")))


(defun they-are-sure ()
  "Allows a user to verify a contradictory statement.  Anything except
   a yes counts as no."
  (let (response)
    (princ "You've changed your mind.  Are you sure? ")
    (setf response (read))
    (cond ((eq response 'yes) t)
          (t nil))))
 
           

(defun invert (v)
  "Turns 'likes into 'dislikes, and vice versa"
  (if (eq v 'likes) 'dislikes 'likes))