;; This file requires Common Lisp and Babel2.
;; Please visit http://emergent-languages.org for the source code.

(asdf:operate 'asdf:load-op 'language-game-examples)

(in-package :fcg-user)

(defun unifier (list1 list2)
  "This function takes bindings from the function unify and substitutes them
   in the pattern."
  (let ((bindings (unify list1 list2)))
    (notify trace-learning-verbose
	    (format nil "~%Unification of ~a and ~a yields the following bindings:"
		    list1 list2))
    (notify trace-learning-verbose
	    (format nil "~% ~a" bindings))
    (loop for binding in bindings
       collect (substitute-bindings binding list1))))

;;; ##########################
;;; The basics of unification.
;;; ##########################

(toggle-monitor trace-learning-verbose)

;; Unify can see if two patterns are equal...
(unifier 'a 'a)

;; But it can also see what possible bindings are for
;; variables.
(unifier '?x 'a)

(unifier '(+ ?x 1) '(+ 2 ?y))

(unifier '(syn-cat ?x) '(syn-cat noun))

;; Unification allows two variables to be matched against each other.
;; These two variables then remain unbound, but they become equivalent.
(unify '(?x ?x) '(?y ?y))

(unify '(?a ?b) '(?x ?x))

(unifier '(?a ?b) '(?x ?x))

;; Sophisticated reasoning is now possible.
(unifier '(?a + ?a = 0) '(?x + ?y = ?y))

;; Attention: unification only cares about equality constraints!
;; It does not solve equations or other constraints.
(unifier '(?a + ?a = 2) '(?x + ?y = ?y))

;; Why is it useful?
;; -----------------

(toggle-monitor trace-learning-verbose)

(defun n ()
  (random-elt '((noun
		 (form "boy")
		 (number sg)
		 (person 3))
		(noun
		 (form "cat")
		 (number sg)
		 (person 3))
		(noun
		 (form "women")
		 (number pl)
		 (person 3)))))

(defun det ()
  (random-elt '((det
		 (form "the")
		 (number ?x))
		(det
		 (form "a")
		 (number sg))
		(det
		 (form "this")
		 (number sg))
		(det
		 (form "these")
		 (number pl)))))

(defun np ()
  (let* ((determiner (det))
	 (noun (n))
	 (noun-phrase (unifier
		       '((det
			  (form ?determiner-form)
			  (number ?number))
			 (noun
			  (form ?noun-form)
			  (number ?number)
			  (person ?person)))
		       (list determiner noun))))
    (if noun-phrase
	(cons 'np (first noun-phrase))
	(np))))
    
(defun v ()
  "This function rewrites v as a verb."
  (list 'v (random-elt '("sneezed" "shouted"))))

(defun vp ()
  "This function rewrites vp as v."
  (list 'vp (v)))

(defun s ()
  "This function rewrites s as NP VP."
  (list 's (np) (vp)))

(defun generate-sentence ()
  "This function calls the rewrite-rules that generate a sentence."
  (list 's (np) (vp)))

(defun get-sentence-from-tree (list)
  "This function returns only the sentence itself without the tree."
  (cond
    ((null list) nil)
    ((stringp (first list)) (list (first list)))
    ((or (numberp (first list))
	 (symbolp (first list))) 
     (get-sentence-from-tree (rest list)))
    (t
     (append (get-sentence-from-tree (first list)) 
	     (get-sentence-from-tree (rest list))))))

(defun produce-sentence ()
  "This function produces a tree and returns its sentence."
  (let ((tree (generate-sentence)))
    (format t "~%Generated tree: ~a~%" tree)
    (get-sentence-from-tree tree)))