(in-package "CL-USER")

;;;;!!!!!!!!!!!!!!!!!!!!!!
;;;;
;;;; DON'T FORGET TO: (1) DEFINE *DUAL-TASK* TO BE T BEFORE LOADING ALL MODELS.
;;;;                  (2) USE 4CAPS,LSP v1.2.3 (10)
;;;;                  (3) USE PARS.LSP v2.0.2 (c7)
;;;;                  (4) USE DRIVING.LSP V0.4.3
;;;;
;;;;!!!!!!!!!!!!!!!!!!!!!!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;        Name:   dual task
;;;;     Version:   0.1.3
;;;;        Date:   10.2.2003
;;;;
;;;;      Author:   Sashank Varma
;;;;       Email:   sashank@vanderbilt.edu
;;;; Organization:  Center for Cognitive Brain Imaging (CCBI)
;;;;                Carnegie Mellon University
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; History:
;;;;
;;;;  12.2.2002 sv: (v0.1.1) Initial version.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Bugs:
;;;;
;;;;   1.1.2003 sv: (v0.1.1) Cycle counts different in single task versus
;;;;                  dual task modes.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (0) 
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Support functions for optimization function.

;;; Computes the average proportional CU of CENTER-NAME.
;;;
;;; 01.29.2003 (sv): Wrote and debugged first version.
(defun avg-cu (center-name)
  (let* ((cent (get-center center-name))
         (cap (capacity cent)))
    (if cap
      (let ((record (rest (assoc cent *act-history*)))
            (total-act 0))
        (dotimes (mcyc *macro-cycs*)
          (incf total-act (gethash 'total (cdr (assoc (1+ mcyc) record)) 0.0)))
        (/ total-act *macro-cycs* cap))
      0.0)))

;;; Computes the correlation between two vectors.
;;;
;;; 01.29.2003 (sv): Imported this function from "recover.lsp", a file of code
;;;                  used when searching for optimal parameter values for the
;;;                  hemodynamic response function, among other things.
(defun corr (x y)
  (let* ((n (length x))
         (loop-end (1- n)))
    (do* ((i 0 (1+ i))
          (sum-x (aref x i) (+ sum-x (aref x i)))
          (sum-y (aref y i) (+ sum-y (aref y i)))
          (sum-x^2 (expt (aref x i) 2) (+ sum-x^2 (expt (aref x i) 2)))
          (sum-y^2 (expt (aref y i) 2) (+ sum-y^2 (expt (aref y i) 2)))
          (sum-xy (* (aref x i) (aref y i)) (+ sum-xy (* (aref x i) (aref y i)))))
         ((= i loop-end)
          (/ (- (* n sum-xy) (* sum-x sum-y))
             (sqrt (* (- (* n sum-x^2) (expt sum-x 2))
                      (- (* n sum-y^2) (expt sum-y 2)))))))))

;;; Computes the root mean square error between two vectors.
;;;
;;; 05.19.2003 (sv): Wrote this function to compare the additively predicted
;;;                  and observed performanc in the dual-task condition.
(defun rmse (x y)
  (sqrt (mse x y)))

;;; Computes the mean square error between two vectors.
;;;
;;; 05.19.2003 (sv): Wrote this function to compare the additively predicted
;;;                  and observed performanc in the dual-task condition.
(defun mse (x y)
  (let ((n (length x))
        (square-error 0))
    (dotimes (i n)
      (incf square-error (expt (- (aref x i) (aref y i)) 2)))
    (/ square-error n)))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Modifications of and Extension to 4CAPS.
;;;;
;;;; NOTE: Will eventually be folded into the 4CAPS source code.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;
;;; Defining models.
;;;


;; Global variables.

(defparameter *models* '())


;; Top-level commands.


; (clear-models)

(defmacro clear-models ()
  `(impl-clear-models))

(defun impl-clear-models ()
  (setq *models* '())
  (values))


; (add-model model-name &key set-up-fn macrocycle-fn summ-fn dmes)

(defmacro add-model (model-name &key set-up-fn macrocycle-fn summ-fn dmes)
  `(impl-add-model ',model-name ',set-up-fn ',macrocycle-fn ',summ-fn ',dmes))

(defun impl-add-model (model-name set-up-fn macrocycle-fn summ-fn dmes)
  (when (assoc model-name *models*)
    (impl-del-model model-name))
  (push (list* model-name nil set-up-fn macrocycle-fn summ-fn dmes)
        *models*)
  (values))


; (del-model model-name)

(defmacro del-model (model-name)
  `(impl-del-model ',model-name))

(defun impl-del-model (model-name)
  (setq *models* (delete-if #'(lambda (model-packet)
                                (eq (first model-packet) model-name))
                            *models*))
  (values))



;;;
;;; Modified recognize-act loop.
;;;


;;

;;; This function is defined in the 4CAPS interpreter.  Explicitly undefine
;;; it so that when it is redefined in the dual-task environment to record
;;; the activity/dormancy of each model on each macrocycle, warnings are not
;;; issued to the user.
(fmakunbound 'impl-run)

(defun impl-run (mcycs)
  (when (pending-dm-actions-p)
    (match))
  (let ((*running-p* t))
    (do ()
        ((or (zerop mcycs)
             (notany #'instantiations-p *centers*)))
      (incf *macro-cycs*)
      (decf mcycs)
      (reset-trace)
      (map-centers #'fire)

      ;;^^ New.
      (record-dormancy)

      (match t)
      (print-traces)
      (mapc #'funcall *post-hook-fns*)))
  (values))

(defun record-dormancy ()
  (dolist (model-packet *models*)
    (block done-p
      (dolist (dm-class (nthcdr 5 model-packet))
        (when (or (member dm-class *modifies*
                          :key #'type-of
                          :test #'(lambda (dm-class cl)
                                    (subtypep cl dm-class)))
                  (member dm-class *spews*
                          :key #'(lambda (spew-packet)
                                   (type-of (car spew-packet)))
                          :test #'(lambda (dm-class cl)
                                    (subtypep cl dm-class))))
          (setf (second model-packet) t)
          (return-from done-p)))
      (setf (second model-packet) nil)))
  (values))


;;

(defun model-dormant-p (model-name)
  (and (not (zerop *macro-cycs*))
       (or (notany #'instantiations-p *centers*)
           (not (second (assoc model-name *models*))))))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Simulate and Summarize (Multiple) Models.
;;;;
;;;; NOTE: Possibly fold into the 4CAPS source code.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; Simulation of multi-task performance.
;;;


;;

(defparameter *mcyc-timeout* nil)


;; Top-level command to run simulations.

;;; Assume these top-level commands have been defined in specific model, such
;;; as the Sentence Comprehension Model.  Explicitly undefine them so that
;;; when they are redefined to work properly in a dual-task environment,
;;; properly simulate all defined models, warnings are not issued to the user.
(fmakunbound 'sim)
(fmakunbound 'impl-sim)

(defmacro sim (&rest models-args)
  `(impl-sim ',models-args))

(defun impl-sim (models-args)
  (reset)
  (dolist (model-args models-args)
    (let ((model-packet (assoc (first model-args) *models*)))
      (when model-packet
        (apply (third model-packet) (rest model-args)))))
  (do* ((models-response-list (mapcar #'(lambda (model-packet)
                                          (funcall (fourth model-packet)))
                                      *models*)
                              (mapcar #'(lambda (model-packet)
                                          (funcall (fourth model-packet)))
                                      *models*))
        (done-p (every #'identity models-response-list)
                (every #'identity models-response-list)))
       ((or done-p (and *mcyc-timeout* (> *macro-cycs* *mcyc-timeout*))))
     (run 1))
  (values))


;; Top-level command to summarize the results of running simulations.

;;; Assume these top-level commands have been defined in specific model, such
;;; as the Sentence Comprehension Model.  Explicitly undefine them so that
;;; when they are redefined to work properly in a dual-task environment,
;;; properly simulate all defined models, warnings are not issued to the user.
(fmakunbound 'summ)
(fmakunbound 'impl-summ)

(defmacro summ (&rest model-names)
  `(impl-summ ',model-names))

(defun impl-summ (model-names)
  (unless model-names
    (setq model-names (mapcar #'first *models*)))
  (dolist (model-name model-names)
    (let ((model-packet (assoc model-name *models*)))
      (when model-packet
        (format t "~&~%MODEL: ~A" model-name)
        (funcall (fifth model-packet)))))
  (values))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Define Models.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; 
;;;


;; Clear all existing models.

(clear-models)


;; Sentence Comprehension Model.

(add-model sentence-comprehension
           :set-up-fn scm-set-up
           :macrocycle-fn scm-post-macrocycle-processing
           :summ-fn scm-summ
           :dmes (scm-dme))


;; Driving model.

(add-model driving
           :set-up-fn drv-set-up
           :macrocycle-fn drv-post-macrocycle-processing
           :summ-fn drv-summ
           :dmes (road-position end-road-position
                  perceptual-operator motor-operator
                  driving-preference
                  preferred-driving-operator
                  drive-goal control-perceive-goal control-steering-goal))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Sentence Comprehension Model.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; Global Variables.
;;;


;;

(defparameter *sentence* '())
(defparameter *segment* '())
(defparameter *segment-name* nil)
(defparameter *word* nil)
(defparameter *word-position* 0)
(defparameter *word-mcyc* 0)
(defparameter *word-mcyc-timeout* 25)



;;;
;;; Defining the Model.
;;;


;;

(defun scm-set-up (&rest sent)
  (format t "~&Sentence Trial:~{ ~A~}" sent)
  (setq *sentence* sent)
  (setq *segment* '())
  (setq *segment-name* nil)
  (setq *word* nil)
  (setq *word-position* 0)
  (spew t (clause :number 1)
          *weight*)
  (scm-next-word-set-up)
  (values))


;;

(defun scm-post-macrocycle-processing ()
  (cond ((and (null *word*) (null *segment*) (null *sentence*))
         t)
        ((or (model-dormant-p 'sentence-comprehension)
             (and *word-mcyc-timeout*
                  (= *word-mcyc* *word-mcyc-timeout*)))
         (when (null *segment*)
           (end-segment *segment-name*)
           (unless (or (tracing-p) (tracing-dm-p))
             (let ((segment (first *segment-history*)))
               (format t "~&~A~A~A~A~A" (shorten *segment-name*)
                                        #\tab (1+ (- (third segment)
                                                     (second segment)))
                                        #\tab *macro-cycs*))))
         (cond ((or *segment* *sentence*)
                (scm-next-word-set-up)
                nil)
               (t
#|
                ;; Only partially translated.  Will need to confirm this code
                ;; is still used by the model and, if so, adapt it to the new
                ;; simulation scheme and incorporate the question in the input
                ;; along with the "sentence" words.
                (unless *suppress-unselected-trs*
                  (when (or (tracing-p) (tracing-dm-p))
                    (print-scm-gap)
                    (print-scm-separator)
                    (format t "~&                               QUESTION ANSWERING")
                    (print-scm-separator))
                  (spew t (integrate)
                        *weight*)
                  (run 25)
                  (end-segment 'integrate)
                  (unless (or (tracing-p) (tracing-dm-p))
                    (let ((segment (first *segment-history*)))
                      (format t "~&INT~A~A"  #\tab (1+ (- (third segment)
                                                          (second segment)))))))
|#
                (unless (or (tracing-p) (tracing-dm-p))
                  (format t "~&~A:~A~A~A~A" (shorten 'total)
                                            #\tab *macro-cycs*
                                            #\tab *macro-cycs*))
                (setq *word* nil)
                t)))
        (t
         (when *word-mcyc-timeout*
           (incf *word-mcyc*))
         nil)))

(defun scm-next-word-set-up ()
  (unless *segment*
    (let ((next-segment (pop *sentence*)))
      (setq *segment* (if (symbolp next-segment)
                        (list next-segment)
                        next-segment))
      (setq *segment-name* (intern (format nil "~A~{-~A~}" (first *segment*)
                                                           (rest *segment*))))))
  (setq *word* (pop *segment*))
  (when *word-mcyc-timeout*
    (setq *word-mcyc* 1))
  (when (or (tracing-p) (tracing-dm-p))
    (print-scm-gap)
    (print-scm-separator)
    (format t "~&                                WORD ~A: ~A" (1+ *word-position*)
                                                              *word*)
    (print-scm-separator))
  (spew t (percept :ortho *word*
                   :start *word-position*
                   :end (1+ *word-position*))
          *weight*)
  (let ((cur-pos-dme (first (dme-list '(current-position)))))
    (if cur-pos-dme
      (modify cur-pos-dme :pos (1+ *word-position*))
      (spew t (current-position :pos (1+ *word-position*))
              *weight*)))
  (incf *word-position*)
  (values))

(defun print-scm-gap ()
  (format t "~&~2%"))

(defun print-scm-separator ()
  (format t "~&################################################################################")
  (format t "~&################################################################################"))


;; Summarize the results of a simulation.

(defun scm-summ ()
  (format t "~&")
  (trees theta-role quantifier)
#|
  ;; When simulating dual-task performance, it's better to have the model-specific
  ;; summary functions summarize task performance and let the DT-SUMM function
  ;; print center capacity utilizations.
  (history@ (associate structure rh-associate rh-structure rh-executive)
            :combination avg
            :measure prop)
|#
#|
  ;; Useful only when fitting the model to data.
  (history@ (associate lh-spatial lh-executive structure associational category visual)
            :measure act
            :time 1)
  (history@ (rh-associate rh-spatial rh-executive rh-structure rh-associational rh-category rh-visual)
            :measure act
            :time 1)
|#
  (values))



;;;
;;; Simulating a number of the sentences used in the studies of Just and
;;; Carpenter.
;;;


;;

;;; This batch simulation command is defined in the Sentence Comprehension
;;; Model.  Explicitly undefine it so that when it is redefined in the
;;; dual-task environment to make use of the generalized SIM command and the
;;; model-specific SCM-SUMM command, warnings are not issued to the user.
(fmakunbound 'jv2005)

(defun jv2005 ()
  (format t "ACTIVE")
  (sim (sentence-comprehension the senator attacked the (reporter period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%PASSIVE")
  (sim (sentence-comprehension the senator was attacked by the (reporter period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%DATIVE")
  (sim (sentence-comprehension the senator gave an interview to the (reporter period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%PASSIVE DATIVE")
  (sim (sentence-comprehension the interview was given to the reporter by the (senator period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%CLEFT-SUBJECT")
  (sim (sentence-comprehension it was the senator that attacked the (reporter period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%CLEFT-OBJECT")
  (sim (sentence-comprehension it was the senator that the reporter (attacked period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%RIGHT-BRANCHING SUBJECT-RELATIVE")
  (sim (sentence-comprehension the senator attacked the reporter that admitted the (error period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%RIGHT-BRANCHING OBJECT-RELATIVE")
  (sim (sentence-comprehension the senator attacked the reporter that the editor (fingered period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%CONJOINED ACTIVES")
  (sim (sentence-comprehension the senator attacked the reporter and admitted the (error period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%SUBJECT-RELATIVE")
  (sim (sentence-comprehension the senator that attacked the reporter admitted the (error period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%OBJECT-RELATIVE")
  (sim (sentence-comprehension the senator that the reporter attacked admitted the (error period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%UNAMBIGUOUS PREFERRED")
  (sim (sentence-comprehension (the experienced soldiers) (spoke about the dangers) (before the midnight) (raid period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%UNAMBIGUOUS UNPREFERRED")
  (sim (sentence-comprehension (the experienced soldiers) (who were told about the dangers) (conducted the midnight) (raid period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%AMBIGUOUS PREFERRED")Joseph Giampapa
  (sim (sentence-comprehension (the experienced soldiers) (warned about the dangers) (before the midnight) (raid period)))
  (format t "~%")
  (scm-summ)
  (format t "~2%AMBIGUOUS UNPREFERRED")
  (sim (sentence-comprehension (the experienced soldiers) (warned about the dangers) (conducted the midnight) (raid period)))
  (format t "~%")
  (scm-summ)
  (values))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (?) Driving model.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; Definitions for the driving model.
;;;


(defparameter *total-mcycs* nil)
(defparameter *total-feet* nil)


;; Set-up.

(defun drv-set-up (&key (rv *ccbi-rv*) (time 60))
  (setq *rv* (etypecase rv
               (symbol (eval rv))
               (road-view rv)))
  (format t "~&Drive road ~A for ~,2F seconds." rv time)
  (format t "~%")
  (setq *total-mcycs* (truncate time *secs-per-mcyc*))
  (setq *total-feet* (* time *feet-per-second*))
  (setq *deviations* 0)
  (setq *num-off-road* 0)
  (setf (min-y *rv*) (truncate (find-min-y (road *rv*) *total-feet*) 0.9))
  (setf (max-y *rv*) (truncate (find-max-y (road *rv*) *total-feet*) 0.9))
  (initialize-road-view *rv*)
  (initialize-driving-model time)
  (unless (or (tracing-p) (tracing-dm-p))
    (format t "~&TIME"))
  (values))


;;

(defun drv-post-macrocycle-processing ()
  (cond ((or (null *rv*)
             (= *macro-cycs* *total-mcycs*)
             (= (pos-x *rv*) *total-feet*)
             (model-dormant-p 'driving))
         t)
        (t
         (incf *deviations* (abs (center-deviation *rv*)))
         (when (off-road-p *rv*)
           (incf *num-off-road*)
           (when *recenter-on-bump-p*
             (recenter-position *rv*)))
         (update *rv* *secs-per-mcyc*)
         nil)))


;; Summarization

(defun drv-summ ()
  (when (and *rv* *deviations* *total-feet* *num-off-road* *secs-per-mcyc* *total-mcycs*)
    (format t "~&Distance:      ~,2F ft" *total-feet*)
    (format t "~%Avg Abs Dev:   ~,2F ft (+/- ~,2F ft)"
            (/ *deviations* *total-mcycs*)
            (/ (width (road *rv*)) 2))
    (if *recenter-on-bump-p*
      (format t "~%Num Bumps:     ~,A" *num-off-road*)
      (format t "~%Time Off-Road: ~,2F sec (~A mcycs)"
              (* *num-off-road* *secs-per-mcyc*)
              *num-off-road*))
    (format t "~&Time:          ~,2F sec (~A/~A mcycs)"
            (* *macro-cycs* *secs-per-mcyc*)
            *total-mcycs* *macro-cycs*))
  (history@ (lh-executive rh-executive lh-spatial rh-spatial)
            :combination avg
            :measure prop)
  (values))


;;

(defun drv2003 (&key (time 15))
  (format t "~&Simulation of the Just et al. (2003) single-task driving condition.")
  (format t "~2%")
  (caps)
  (format t "~2%")
  (impl-sim `((driving :time ,time)))
  (drv-summ)
  (values))


;;

(defun dt-driving (&key (time (* *secs-per-mcyc* 95)))
  (macro-caps)
  (caps)
  (format t "~3%SINGLE-TASK SENTENCE COMPREHENSION~2%")
  (sim (sentence-comprehension the senator attacked the reporter that admitted the (error period)))
  (summ)
  (history@ (lh-spatial   rh-spatial
             lh-executive rh-executive
             associate    rh-associate
             structure    rh-structure)
            :combination avg
            :measure prop)
  (format t "~3%SINGLE-TASK DRIVING~2%")
  (impl-sim `((driving :time ,time)))
  (summ)
  (history@ (lh-spatial   rh-spatial
             lh-executive rh-executive
             associate    rh-associate
             structure    rh-structure)
            :combination avg
            :measure prop)
  (format t "~3%DUAL-TASK SENTENCE COMPREHENSION AND DRIVING~2%")
  (impl-sim `((sentence-comprehension the senator attacked the reporter that admitted the (error period))
              (driving :time ,time)))
  (summ)
  (history@ (lh-spatial   rh-spatial
             lh-executive rh-executive
             associate    rh-associate
             structure    rh-structure)
            :combination avg
            :measure prop)
  (values))


;;

(set-caps@ (associate rh-associate structure rh-structure
            lh-spatial rh-spatial lh-executive rh-executive)
           100.0)

#|
(dt-driving)
|#