;; $Id: answer.lsp,v 1.2 2001/04/02 20:41:19 moltmans Exp $
;; answer.lsp -- 
;; Author: Michael Oltmans <moltmans@ai.mit.edu> 
;; Created: <Mon Feb 26 23:14:58 2001> 
;; Time-stamp: <2001-02-28 15:26:16 moltmans> 


(in-package :COMMON-LISP-USER)

(defun talk-about-causality (body-name)
  (with-solution
   (let* ((body (find-body-by-name body-name))
	  (event (find-event-involving body))
	  (causes (find-causes-of event))
	  (effects (find-effects-of event)))
    (debugging-assistance :ANSWERS "~%body     : ~A" body-name)
    (debugging-assistance :ANSWERS "~%event    : ~A" event)
    (debugging-assistance :ANSWERS "~%causes   : ~A" causes)
    (debugging-assistance :ANSWERS "~%effects  : ~A" effects)

    (cond ((and causes effects)
	   (format nil "~A cause~A ~A which causes ~A"
		   (english-event-list causes)
		   (if (cdr causes) "" "s")
		   (format nil "the motion of ~A" body-name)
		   (english-event-list effects)))
	  (causes
	   (format nil "~A cause~A ~A but ~A has no influence on other events"
		   (english-event-list causes)
		   (if (cdr causes) "" "s")
		   (format nil "the motion of ~A" body-name)
		   (format nil "the motion of ~A" body-name)))
	  (effects
	   (format nil "~A cause~A ~A"
		   (english-event-list effects)
		   (if (cdr causes) "" "s")
		   (format nil "the motion of ~A" body-name)))
	  (t
	   (format nil
		   "~A does not participate in any actions."
		   body-name))))))
	   


; (defun english-motion-of (events)
;   (format nil "the motion~A of ~A"
; 	  (if (cdr events) "" "s")
; 	  (english-event-list events)))
	  

(defun english-event-list (events)
  (let ((exogenous-p (find 'exogenous-cause events :key #'first))
	(names (mapcar #'find-body-name
		       (mapcar #'find-subject-of
			       (remove 'exogenous-cause events
				       :key #'first)))))
    ;; if there are nulls something went wrong
    (when (and names (some #'null names))
      (error "All events should have resolved to body names:~%  ~A"
	     names))
    (let ((ms (and names
		   (format nil "the motion~A of ~A"
			   (if (cdr names) "s" "")
			   (english-and-list names))))
	  (es (and exogenous-p "an exogenous force")))
      (cond ((and ms es)
	     (concatenate 'string  ms " and " es))
	    (ms ms)
	    (es es)))))

;     (reduce #'(lambda (a b)
; 		(format nil "~A and ~A" a b))
; 	    names)))
		

(defun english-and-list (items)
  (apply #'format nil
	 "~#[~;~A~;~A and ~A~:;~@{~#[~;and ~]~A~^, ~}~]"
	 items))

(defun find-event-involving (body)
  (let ((events (find-events-involving body)))
    (when (cdr events)
      (format t "~%ERROR: Body ~A is involved in multiple events:~%  ~A"
	      body events))
    (car events)))

(defun find-events-involving (body)
  "find event-sets that involve body"
  (let ((events (cond-fetch `(moves ,body ?id) :TRUE))
	(result nil))
    (dolist (event (mapcar #'third events) result)
      (let ((cannonical (find-cannonical-event event)))
	(when (and cannonical
		   (not (find (second cannonical)
			      result :key #'second)))
	  (setq result (push cannonical result)))))))



;;; We are going to hold off on this (more complicated) algorithm
;;; until latter so that can better demonstrate the operation of the
;;; system and show that it is not a parroting of the original
;;; explanation

;;; find the events involving body
;;; collect parent events first then this event
;;; for each event in this set:
;;;    find causes & effects
;;;    filter out mentioned events
;;;    case:
;;;       no cause, no effect, alreay mentioned
;;;       return ""
;;;
;;;       some of each
;;;       return "When causes
;;;    record a list of events we have mentioned so we don't bring
;;;    them up again

;;; list-events sub procedure: list things without repeating or
;;; talking about both sub and parent events 
;;;
;;;  