# -----------------------------------------
# SIMPLE LISP QUESTION ANSWER PROGRAM...
#
# AUTHOR: MATTHEW WILLIAM COAN
# DATE: SEP. 6, 2019 08:39PM
# -----------------------------------------

(set question-map (make-map))
(set visit-map (make-map))
(set data (make-list))
(set data (cons (list data '((I is I)))))
(set data (cons (list data '((I is person)))))
(set data (cons (list data '((person is person)))))
(set data (cons (list data '((thing is thing)))))
(set data (cons (list data '((place is place)))))
(set data (cons (list data '((time is time)))))
(set data (cons (list data '((person is place)))))
(set data (cons (list data '((place is thing)))))
(set data (cons (list data '((time is thing)))))
(set data (cons (list data '((God is God)))))
(set data (cons (list data '((God is person)))))
(set data (cons (list data '((you is computer)))))
(set data (cons (list data '((you is you)))))
(set data (cons (list data '((you is thing)))))
(set data (cons (list data '((computer is thing)))))

(defun filter (lis typ)
   (cond (= 0 (length lis))
      (
         (return (make-list))
      )
      (
         (set phrase (car lis))
         (set ret (is phrase))
         (cond (= -1 (find ret typ))
            (
               (return (filter (cdr lis) typ))
            )
            (
               (set ret0 (filter (cdr lis) typ))
               (set ret (add-new ret0 phrase))
               (return ret)
            )
         )
      )
   )
)

(defun who (q)
   (return (filter q "person"))
)

(defun what (q)
    (return q)
)

(defun when (q)
   (return (filter q "time"))
)

(defun where (q)
   (return (filter q "place"))
)

(defun why (q)
    (return q)
)

(defun how (q)
    (return q)
)

(defun add-new (ret n)
   (cond (= (length ret) 0)
      (
         (set ret (list n))
         (return ret)
      )
      (cond (= -1 (find ret n))
         (return (cons (list ret n)))
         (return ret)
      )
   )
)

(defun is-search1 (data subject)
   (set sent (car data))
   (set n1 (car sent))
   (set n2 (cdar sent))
   (set n3 (cddar sent))
   (cond (and (= n2 "is") (= n3 subject))
      (
         (set ret0 (is-search (cdr data) subject))
         (set ret (add-new ret0 n1))
         (return ret)
      )
      (cond (and (= n2 "is") (= n1 subject))
         (
            (set ret0 (is-search (cdr data) subject))
            (set ret (add-new ret0 n3))
            (return ret)
         )
         (
            (set ret (is-search (cdr data) subject))
            (return ret)
         )
      )
   )
)

(defun is-search (data subject)
   (cond (> (length data) 0) 
      (
         (return (is-search1 data subject))
      )
      (
         (return (make-list))
      )
   )
)

(defun is (subject)
    (set q (is-search data subject))
    (return q)
)

(defun am (subject)
    (set q (is-search data subject))
    (return q)
)

(defun are (subject)
    (set q (is-search data subject))
    (return q)
)

(defun make-code (q)
   (set question (lex q))
   (set pred (car question))
   (set verb (cdar question))
   (set subject (cddar question))
   (set code (compute "(" + pred + " (" + verb + " \"" + subject + "\"))"))
   (print code)
   (print "\n")
   (return code)
)

(defun auto-answer (question)
   (set code (make-code question))
   (set answer (eval code))
   (return answer)
)

(defun ask0 (answer) 
   (set question (cons (list 'who 'is answer)))
   (question-loop question)
   (set question (cons (list 'what 'is answer)))
   (question-loop question)
   (set question (cons (list 'when 'is answer)))
   (question-loop question)
   (set question (cons (list 'where 'is answer)))
   (question-loop question)
   (set question (cons (list 'why 'is answer)))
   (question-loop question)
   (set question (cons (list 'how 'is answer)))
   (question-loop question)
)

(defun ask (answer)
   (cond (> (length answer) 0)
      (
         (ask0 (car answer))
         (ask (cdr answer))
      )
   )
)

(defun learn1 (question answer)
   (map-put question-map question (lex answer))
   (map-put visit-map question 'true)
   (set st (cdr question))
   (set st (cons (list answer st)))
   (set data (cons (list data (list st))))
   (ask answer)
)

(defun learn2 (question answer)
   (map-put question-map question answer)
   (map-put visit-map question 'true)
   (ask answer)
)

(defun answer-question (question)
   (set answer (auto-answer question))
   (cond (= (length answer) 0)
      (
         (print question)
         (print "\n")
         (print "answer> ")
         (set answer (input))
         (learn1 question answer)
      )
      (
         (print question)
         (print "\n")
         (print answer)
         (print "\n")
         (learn2 question answer)
      )
   )
)

(defun print-question (question)
   (print question)
   (print "\n")
   (print (map-get question-map question))
   (print "\n")
   (cond (= nil (map-get visit-map question))
      (
         (map-put visit-map question 'true)
         (ask (map-get question-map question))
      )
   )
)

(defun question-loop (question) 
   (cond (= nil (map-get question-map question)) 
      (
         (answer-question question)
      )
      (
         (print-question question)
      )
   )
)

(defun ai-main () 
   (set visit-map (make-map))
   #(set question-map (make-map))
   (print "question> ")
   (set question (input))
   (cond (= question "exit")
      (return)
   )
   (cond (<> question "")
      (question-loop question)
   )
   (ai-main)
)

(defun main ()
   (print "LISP Artificial Intelligence 1.0\n")
   (print "Program author: Matthew W. Coan\n") 
   (print "Email: matthewcoan1976@hotmail.com\n\n")
   (print "Please type \"exit\" to end this program...\n\n")
   (ai-main)
)

(main)
