;;;; Logic Programming
;;;;
;;;; File:	   login-programming.in
;;;; Author:	   <your name> (<your e-mail address>)
;;;; Version:	   1

;; Data Structure;
;;
;;	state ::= ( substitution . query )
;;
;;	query ::= predicate-list
;;
;;	predicate-list
;;	    ::= () | non-empty-predicate-list
;;
;;	non-empty-predicate-list
;;	    ::= ( predicate )
;;	      | ( predicate AND
;;		      . non-empty-predicate-list )
;;
;;	predicate ::= s-expression
;;
;; Predicates can contain variables:
;;
;;	variable ::= `variable-name
;;
;;	variable-name ::= atom except nil
;;
;; The database records definite-clauses:
;;
;;	database ::= ()
;;		   | ( definite-clause . database )
;;
;;	definite-clause ::= ( head )
;;			  | ( head <=== . body )
;;
;;	head ::= predicate
;;
;;	body ::= predicate-list

(load "search.lsp")
(load "unify.lsp")

;; Database (list of definite clauses):
;;
(defvar *database* nil)

;; Switch that is true to print substitutions for all
;; goals but not to print the path to the first goal.
;; This is done by having GOAL print the `SUCCESS'
;; and the substitution for each goal state, while
;; returning NIL always to keep the search going.
;;
;; False to print the path to first goal found and stop
;; search at the first goal.  This is done by having
;; GOAL do its normal thing of returning true for
;; goal states, so the search engine stops and returns
;; the path which prints as a return value.
;;
(defvar *print-substitutions* t)

;; Helper functions to make code more readable.
;;
(defun head (definite-clause) (car definite-clause))
(defun body (definite-clause) (cddr definite-clause))
(defun predicate-car (predicate-list)
  (car predicate-list))
(defun predicate-cdr (predicate-list)
  (cddr predicate-list))
(defun predicate-cons (predicate predicate-list)
  (cond
   ((null predicate-list) `(,predicate))
   (t `(,predicate and . ,predicate-list))))
(defun predicate-append
	  (predicate-list1 predicate-list2)
  (cond
   ((null predicate-list1) predicate-list2)
   (t
    (predicate-cons (predicate-car predicate-list1)
		    (predicate-append
		     (predicate-cdr predicate-list1)
		     predicate-list2)))))

;; Function to generate a substitution that will
;; replace all the variables in an s-expression by
;; newly generated variables.
;;
;; Generated names are created by GENERATE-
;; VARIABLE-NAME.
;;
(defun generate-variables (e)
  (mapcar #'(lambda (v)
		    `(,v ',(generate-variable-name)))
	  (variables e)))

;; GOAL function.  The simplest GOAL function just
;; returns true if and only if the state has an empty
;; predicate list.  The more complicated goal functions
;; print `SUCCESS' and the state substitution when the
;; state has an empty predicate list, but always return
;; false to keep the search going.
;;
(defun goal (state)
  (cond
   ((not *print-substitutions*)
    (null (cdr state)))
   ((null (cdr state))
    ;; Print `SUCCESS' and state substitution.

    (fresh-line)
    (princ '|SUCCESS|)
    (terpri)

    ;; Put your substitution print code here.

    (terpri)

    ;; Return NIL to keep search going.
    nil)))

;; Compute the children of STATE by searching the
;; *DATABASE* for definite clauses whose heads
;; unify with the first predicate in STATE.  For
;; each such, replace the first predicate in STATE
;; by the body ofthe clause.  Before attempting
;; unification with the head of a definite clause,
;; the variables in the clause must be replaced
;; by newly generated variables by using GENERATE-
;; VARIABLES and SUBIN.
;;
;; The SEEN argument is ignored.
;;
;; RR: <fill in the missing parts>
;;
;;     Apply rules in the order given:
;;
;;	(children 'state 'seen) ===>
;;	    ===> (children 'state 'seen 'clauses '())
;;		 if *database* ===> 'clauses
;;
;;	(children 'state 'seen '() 'child-list)
;;	    ===> <fill in here>
;;
;;	(children '(substitution . nil) 'seen
;;	          'clauses 'child-list)
;;	    ===> <fill in here>

;;	(children '(substitution . query)
;;		  'seen
;;	          '(clause . more-clauses)
;;		  'child-list)
;;	    ===> <fill in here>
;;		 if (eql 'match 'fail)
;;	    ===> <fill in here>
;;		otherwise
;;
;;	    if (generate-variables 'clause)
;;	    		===> 'gsub
;;	       (subin (head 'clause) 'gsub)
;;	    	        ===> 'ghead
;;	       (predicate-cons 'first-predicate
;;			       'more-query)
;;			===> 'query
;;	       (unify 'first-predicate 'ghead
;;	    	      'substitution)
;;	    		===> 'match
;;	       (predicate-append
;;	    	   (subin (body 'clause) 'gsub)
;;	    	   'more-query) ===> 'new-query

(defun children (state seen &optional
			    (clauses *database*)
			    (children ()))
  ;; Replace this line and the next with your code.
  nil)


;; Test subroutines.

(head '(foo and fum))

(body '(foo <=== fum and fiddle))

(predicate-car '(foo and fum))

(predicate-cdr '(foo))

(predicate-cdr '(foo and fum))

(predicate-cdr '(foo and fum and fiddle))

(predicate-cons 'foo '())

(predicate-cons 'foo '(fum))

(predicate-cons 'foo '(fum and fiddle))

(generate-variables '('X and 'Y and 'Z))

(generate-variables '((('X)) and (('Y and 'Z))))



;; Begin tests of SLD-Resolution search.

;; Sets database and returns NIL to prevent large
;; printout.
;;
(defun set-database (value)
  (setf *database* value)
  nil)

(setf *limit* 500)

;; Ancestory Example

(set-database
  '(	((fop is male))
	((mop is female))
	((dop is female))
	((sop is male))
	((sop is the son of fop))
	((sop is the son of mop))
	((dop is the daughter of fop))
	((dop is the daughter of mop))

	(('X is a parent) <=== ('Y is the son of 'X))
	(('X is a parent) <===
		('Y is the daughter of 'X))
	(('X is a father) <===
		('X is a parent) and ('X is male))))

(breadth-first-search '((() . (('X is female))))
  #'children #'goal)

(depth-first-search '((() . (('X is female))))
  #'children #'goal)

(breadth-first-search '((() . (('P is a parent))))
  #'children #'goal)


(setf *trace* t)

(breadth-first-search '((() . (('F is a father))))
  #'children #'goal)

(setf *trace* nil)

(compile 'depth-first-search-recurse)
(compile 'breadth-first-search-recurse)
(compile 'children)
(compile 'goal)
(compile 'unify)
(compile 'subin)
(compile 'variables)
(compile 'generate-variable-name)
(compile 'generate-variables)
(compile 'head)
(compile 'body)
(compile 'predicate-car)
(compile 'predicate-cdr)
(compile 'predicate-cons)
(compile 'predicate-append)

;; Add any new functions you write to the above.



;; Natural Language Parsing Example

(set-database
  '(	((sentence from 'P1 to 'P3)
	 <===
	 (noun phrase from 'P1 to 'P2 with number 'N)
	 and
	 (verb phrase from 'P2 to 'P3 with number 'N))

	((noun phrase from 'P1 to 'P4 with number 'N)
	 <===
	 (determiner from 'P1 to 'P2 with number 'N)
	 and
	 (noun from 'P2 to 'P3 with number 'N)
	 and
	 (optional relative clause from 'P3 to 'P4
		   with number 'N))

	((noun phrase from 'P1 to 'P2 with number 'N)
	 <===
	 (proper noun from 'P1 to 'P2 with number 'N))

	((verb phrase from 'P1 to 'P3 with number 'N)
	 <===
	 (transitive verb from 'P1 to 'P2
		     with number 'N)
	 and
	 (noun phrase from 'P2 to 'P3
	       with number 'ANY))

	((verb phrase from 'P1 to 'P2 with number 'N)
	 <<<=
	 (intransitive verb from 'P1 to 'P2
		       with number 'N))

	((optional relative clause from 'P1 to 'P1
		   with number 'ANY))

	((optional relative clause from 'P1 to 'P3
		   with number 'N)
	 <===
	 (word that from 'P1 to 'P2)
	 and
	 (verb phrase from 'P2 to 'P3 with number 'N))

	((determiner from 'P1 to 'P2 with number 'N)
	 <===
	 (word 'WORD from 'P1 to 'P2)
	 and
	 ('N determiner 'WORD))

	((singular determiner a))
	((singular determiner every))
	(('ANY determiner the))
	((plural determiner some))

	((noun from 'P1 to 'P2 with number 'N)
	 <===
	 (word 'WORD from 'P1 to 'P2)
	 and
	 ('N noun 'WORD))

	((singular noun author))
	((plural   noun authors))
	((singular noun book))
	((plural   noun books))
	((singular noun professor))
	((plural   noun professors))
	((singular noun program))
	((plural   noun programs))
	((singular noun student))
	((plural   noun students))

	((proper noun from 'P1 to 'P2 with number 'N)
	 <===
	 (word 'WORD from 'P1 to 'P2)
	 and
	 ('N proper noun 'WORD))

	((singular proper noun bill))
	((singular proper noun bertrand))
	((singular proper noun gottlob))
	((singular proper noun terry))
	((singular proper noun begriffsschrift))
	((singular proper noun principia))
	((singular proper noun lunar))
	((singular proper noun shrdlu))

	((transitive verb from 'P1 to 'P2
		     with number 'N)
	 <===
	 (word 'WORD from 'P1 to 'P2)
	 and
	 ('N transitive verb 'WORD))

	((singular transitive verb concerns))
	((plural transitive verb concern))
	(('ANY transitive verb met))
	(('ANY transitive verb ran))
	(('ANY transitive verb wrote))

	((intransitive verb from 'P1 to 'P2
		       with number 'N)
	 <===
	 (word 'WORD from 'P1 to 'P2)
	 and
	 ('N intransitive verb 'WORD))

	((singular intransitive verb halts))
	((plural intransitive verb halt))

	((word 'WORD from ('WORD . 'P2) to 'P2))

	))


(defun test-sentence (phrase)
  (breadth-first-search
   `((() . ((sentence from ,phrase to ()))))
   #'children #'goal))

;; Show the path.
  
(setf *print-substitutions* nil)

(test-sentence '(shrdlu concerns bill))

(setf *print-substitutions* t)

;; Do not show paths to keep printout from being
;; extremely large.

(test-sentence '(shrdlu concern bill))

(test-sentence '(the professor wrote
			       the book
			       that concerns lunar))

(test-sentence '(the professor wrote
			       the book
			       that concern lunar))

;; Add your test sentences here!