;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End of Code
;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: qp-source-1.lsp
;;;;    System: FIRE
;;;;   Version: v1
;;;;    Author: Jin Yan
;;;;   Created: March 2, 2003 18:37:13
;;;;   Purpose: Provide qualitative reasoning services for FIRE
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Thursday, October 30, 2003 at 13:19:44 by jinyan

(in-package :fire)

(defun make-gizmo-fire-reasoner (&optional (title "Gizmo-Fire reasoner"))
  (let ((reasoner (fire::make-reasoner title)))
    (fire::add-eval-source reasoner)
    (load-file fire:*fire-path* "evalfns")
;;;    (fire::add-analogy-source reasoner)
    (fire::add-qp-source reasoner)
    reasoner))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Class Definitions
  
(defclass qp-source (source)
  ((gizmos :type list :initform nil :accessor gizmos
           :documentation "List of GIZMOs created by this source.")
   (scenarios :type list :initform nil :accessor scenarios
              :documentation "List of scenarios created in this source.")
   (dts :type list :initform nil :accessor dts
        :documentation "List of dts created in this source.")
   (scenario-counter :type t :initform -1 :accessor scenario-counter
                     :documentation "ID counter for scenario.")
   (dt-counter :type t :initform -1 :accessor dt-counter
               :documentation "ID counter for dt.")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Making new qp sources

(defun get-new-scenario-id (source) (incf (scenario-counter source)))

(defmethod qp-source? ((thing t)) nil)
(defmethod qp-source? ((thing qp-source)) t)

(defmethod qp-source-of ((thing t)) nil)
(defmethod qp-source-of ((thing reasoner))
  (dolist (source (sources thing))
    (when (qp-source? source)
      (return-from qp-source-of (values source)))))

(defmethod add-qp-source ((reasoner reasoner) &key (type 'qp-source))
  (let ((source (make-instance type :reasoner reasoner)))
    (add-source source reasoner)
    (register-ask-source reasoner 
                         (if (mixed-case?)
                           'data::qpAnalysisOf
                           'data::qp-analysis-of)
                         source
                         'run-basic-gizmo '(:known :known :known :variable)
                         '(:input-only :input-only :input-only :produces)
                         :medium)
    (register-ask-source reasoner
                         (if (mixed-case?)
                           'data::qpStatesConsistentWith
                           'data::qp-states-consistent-with)
                         source
                         'find-consistent-states '(:known :known :variable)
                         '(:input-only :input-only :produces)
                         :medium)
    (register-ask-source reasoner 
                         (if (mixed-case?)
                           'data::qpStateTransitionTo
                           'data::qp-state-transition-to)
                         source
                         'run-limit-analysis '(:known :known :variable)
                         '(:input-only :input-only :produces)
                         :medium)
    (register-ask-source reasoner 
                         (if (mixed-case?)
                           'data::qpEnvisionment
                           'data::qp-envisionment)
                         source
                         'run-envisionment '(:known :variable :variable)
                         '(:input-only :produces :produces)
                         :medium)))
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Running Gizmo

(defun run-basic-gizmo (source context number response effort 
                               query scenario dt model-assumptions)
  "function for query (qpAnalysisOf <sc> <dt> <asm> ?gizmo), it creates a gizmo
   object by using the dt and sc objects; reifies the results; and returns a 
   QpAnalysis to the user."
  (declare (ignore number effort))
  (let* ((scenario (get-scenario scenario source))
         (dt (get-dt dt source))
         (gizmo (gizmo::create-gizmo (format nil "~A" (gensym "friendly-gizmo"))
                                     :debugging nil
                                     :scenario scenario
                                     :domain-theory dt)))
    (gizmo::with-gizmo gizmo
;;;      (gizmo::g-run-rules)
      (gizmo::formulate-exhaustive-model gizmo)
      (gizmo::g-run-rules)
      (push gizmo (gizmos source))
      (loop for assumption in model-assumptions
          do (ltre::assume! assumption :user))
      (reify-gizmo gizmo source) ;; cache results in ltre
      (make-gizmo-result source query response context gizmo))))
  
(defun find-consistent-states (source context number response effort 
                                      query constraints gizmo-term)
  "function for query (qpStatesConsistentWith <constraints> <gizmo> ?states)"
  (let ((gizmo (get-gizmo gizmo-term source)))
    (gizmo::with-gizmo gizmo
      ;; One bug: think about where ltre::assume! is placing the assumption.
      (dolist (constraint constraints)
          (ltre::assume! constraint :user))
      (gizmo::find-state-completions gizmo)
      (gizmo::apply-domain-specific-elaborations-as-appropriate)
      (gizmo::resolve-influences-if-appropriate gizmo) ;; resolve-influnce
      (reify-states (gizmo::gizmo-states gizmo) source)
      (substitute-if gizmo #'(lambda (x)
                               (equal x (gizmo::gizmo-id-number gizmo)))
                     (gizmos source) :key #'gizmo::gizmo-id-number))
    ;; Any results that get assumed after this need to be in the reasoner's LTRE
    (make-states-result source query response context (gizmo::gizmo-states gizmo))))

;;;After revolve-inference, shouldn't we push this new gizmo object into
;;;the source gizmos queue? coz we've got some states installed in the 
;;;gizmo object. See the function: substitute-if above.

(defun get-gizmo (gizmo-term source)
  (find (cadr gizmo-term) (gizmos source) :key #'gizmo::gizmo-id-number))

(defun get-state (state-term gizmo)
  (find (cadr state-term) (gizmo::list-states gizmo) :key #'gizmo::state-title))

(defun run-limit-analysis (source context number response effort
                                  query state-term gizmo-term)
  ;; It's "limit" not "limited"
  "function for query (qpStateTransitionTo <state-id> <gizmo-id> ?next-states)"
  (let* ((gizmo (get-gizmo gizmo-term source))
         (state (get-state state-term gizmo))
         (next-states (gizmo::find-next-states state)))
    ;; If there are no next states, shouldn't one return the fact that there aren't
    ;; rather than failing, which is what a NIL result will do?
    (when (and gizmo state)
      (substitute-if gizmo #'(lambda (x)
                             (equal x (gizmo::gizmo-id-number gizmo)))
                     (gizmos source) :key #'gizmo::gizmo-id-number)
      (make-transition-states-result source query response context next-states))))

(defun run-envisionment (source context number response effort
                                query gizmo-term)
  "function for query (qpEnvisionment <gizmo-id> ?states ?states-transitions)"
  (let ((gizmo (get-gizmo gizmo-term source)))
    (gizmo::with-gizmo gizmo
      ;; You're better off also using with-gizmo here than just lambda-binding
      ;; *gizmo*, because you also want to ensure that the LTRE is properly bound.
      ;; This wasn't such a problem when Gizmo was being used by itself, but now there
      ;; are potentially a lot of LTRE's around..
      (gizmo::total-envisionment)
      (reify-states (gizmo::list-states gizmo) source)
      (dolist (potential-state (find #'gizmo::transitions-found?
                                     (gizmo::list-states gizmo)))
        (reify-transition-states potential-state source))
      ;; Why are you reifying all of the transitions and states in the fire WM?
      ;; Wouldn't it just be better to return two values, a set of states and a set of
      ;; transitions?  
      ;; What is this substitute-if doing?
      (substitute-if gizmo #'(lambda (x)
                               (equal x (gizmo::gizmo-id-number gizmo)))
                     (gizmos source) :key #'gizmo::gizmo-id-number)
      (make-envisionment-result source query response context gizmo))))

(defun make-gizmo-result (source query response context gizmo)
  (let* ((binding-list (list (cons (fifth query) (make-gizmo-reference gizmo))))
         (bound-result (sublis binding-list query)))
    ;; Cache result in reasoner
    (tell bound-result (reasoner source) :qp-source context)
    (list (case response
            (:bindings binding-list)
            (:pattern (sublis binding-list query))
            (t (sublis binding-list response))))))

(defun make-states-result (source query response context states)
  (let* ((binding-list (list (cons (fourth query) 
                                   (mapcar 'make-state-reference states))))
         (bound-result (sublis binding-list query)))
    ;; Cache result in reasoner
    (tell bound-result (reasoner source) :qp-source context)
    (list (case response
            (:bindings binding-list)
            (:pattern (sublis binding-list query))
            (t (sublis binding-list response))))))

(defun make-transition-states-result (source query response context next-states)
  (let* ((binding-list (list (cons (fourth query)
                                   (mapcar 'make-state-reference states))))
         (bound-result (sublis binding-list query)))
    ;; Cache result in reasoner
    (tell bound-result (reasoner source) :qp-source context)
    (list (case response
            (:bindings binding-list)
            (:pattern (sublis binding-list query))
            (t (sublis binding-list response))))))

(defun make-envisionment-result (source query response context gizmo)
  (let* ((binding-list (list (cons (third query) 
                                   (mapcar 'make-state-reference (gizmo::gizmo-states gizmo)))))
         (binding-list-2 (list (cons (fourth query)
                                    (mapcar 'make-transition-states (find #'gizmo::transitions-found?
                                                                          (gizmo::list-states gizmo))))))
         (bound-result (sublis binding-list query))
         (bound-result (sublis binding-list-2 bound-result)))
    (pprint binding-list)
    (pprint binding-list-2)
    (pprint bound-result)
    (tell bound-result (reasoner source) :qp-source context)
    (list (case response
            (:bindings (list binding-list binding-list-2))
            (:pattern bound-result)))))
;;;            (t (sublis binding-list response))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End Of Code