(in-package "CL-USER")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;        Name:   Driving
;;;;     Version:   0.4.3
;;;;        Date:   11.2.2004
;;;;
;;;;      Author:   Sashank Varma
;;;;       Email:   sashank@vuse.vanderbilt.edu
;;;; Organization:  Center for Cognitive Brain Imaging (CCBI)
;;;;                Carnegie Mellon University
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; History:
;;;;
;;;; v0.1 spans the initial development of support routines for representing
;;;; roads and pretty-printing driving traces.
;;;;
;;;;   6.1.2003 sv: (v0.1.1) Wrote first version, implementing the three
;;;;                  relevant phases of the "control" module of Salvucci's
;;;;                  ACT-R/PM (4.0) model of driving.  In other words, those
;;;;                  aspects of the model concerned with working the brake
;;;;                  and accelerator pedals and changing lanes in response to
;;;;                  the presence of other vehicles have been omitted for
;;;;                  now, but not in manner inconsistent with the future
;;;;                  addition of these capabilities.
;;;;
;;;;   6.2.2003 sv: (v0.1.2) Wrote the ROAD-VIEW class, which encapsulates
;;;;                  the visuo-spatial representation of the road at a
;;;;                  point in time.
;;;;
;;;;                Wrote classes that define roads as superpositions of
;;;;                  sinusoidal curves a la Strayer's empirical work.
;;;;
;;;;   6.3.2003 sv: (v0.1.3) Wrote the initial version of the UPDATE method on
;;;;                  the ROAD-VIEW class.  This computes the new heading
;;;;                  given the elapsed time and the near and far angles
;;;;                  according to Salvucci's steering formula.
;;;;
;;;;                Wrote a test routine to run ssimulations of the steering
;;;;                  logic along sinusoidal roads.
;;;;
;;;;   6.4.2003 sv: (v0.1.4) Modified how the UPDATE method of the ROAD-VIEW
;;;;                  class computes the change in heading.  It now bounds the
;;;;                  value of the near angle, following Salvucci.
;;;;
;;;;                Wrote routines for printing the car's current position on
;;;;                  the road and for printing a pretty trace of its course
;;;;                  over an enture road.   
;;;;
;;;;                Performed the initial fitting of the *C1*, *C2*, and *C3*
;;;;                  constants to produce reasonable (though not necessarily
;;;;                  perfect) performance on relatively curvy roads.  Their
;;;;                  values are somewhat different than Salvucci's estimates.
;;;;
;;;; v0.2 spans the initial development of the 4CAPS driving model on a
;;;; foundation of the initial support routines.
;;;;
;;;;   7.1.2003 sv: (v0.2.1) Began instantiating the General Executive Model
;;;;                  with the specifics of the driving domain (largely
;;;;                  inherited from Salvucci's ACT-R model).
;;;;
;;;;                Implemented a top-level command SIM for automating the
;;;;                  running of driving simulations.
;;;;
;;;;   7.2.2003 sv: (v0.2.2) Continued instantiating the General Executive
;;;;                  model for the driving domain.
;;;;
;;;;                Made design decisions about which spatial information is
;;;;                  part of the external environment, and is thus
;;;;                  encapsulated in the ROAD-POSITION class, and which
;;;;                  information is generated and represented internally, and
;;;;                  thus belongs to spatial representations in the LH-Spatial
;;;;                  center, spatial operators in the RH-Spatial center, and
;;;;                  motor operators.
;;;;
;;;;   7.3.2003 sv: (v0.2.3) Performed the initial fitting of the model's
;;;;                  parameters (i.e., the center resource capacities) to the
;;;;                  data.
;;;;
;;;; v0.3 spans modifications to the model following the summer 2003 MURI
;;;; meeting so that it operates in a manner consistent with the experimental
;;;; paradigms being used at the CCBI.
;;;;
;;;;   8.3.2003 sv: (v0.3.1) Added a new global variable *RECENTER-ON-BUMP-P*.
;;;;                  When T, cars are placed at the center of the road as soon
;;;;                  as they bump the edge.  This is consistent with the CCBI
;;;;                  driving paradigms.  When the value of this variable is
;;;;                  NIL, cars are allowed to drift off-road and the model is
;;;;                  responsible for bringing them back on-road.
;;;;
;;;;   8.4.2003 sv: (v0.3.2) The model only implements the lowest, "Control"
;;;;                  phase of Salvucci's ACT-R model.  This phase is largely
;;;;                  driven by automatic posterior visuospatial systems.  I
;;;;                  therefore, scaled back the role of LH-Executive.  It no
;;;;                  longer proposes preferences and uses them to select the
;;;;                  perceptual operator to apply next.  This work is now
;;;;                  largely handled by the Spatial centers in the sense that
;;;;                  they are more precise in the perceptual operators they
;;;;                  propose in the first place.  The primary responsibility
;;;;                  of LH-Executive is to select between motor operators;
;;;;                  this was retained because of the proximity of DLPFC to
;;;;                  the motor areas.  The primary responsibility of RH-
;;;;                  Executive is to change the current goal from perceiving
;;;;                  to steering.
;;;;
;;;;                  The striking result is an improvement in the temporal
;;;;                  mapping from cycles to seconds.  Before, it had to be
;;;;                  15 msec/cyc to achieve 3 steer/sec.  This was outside
;;;;                  of the 25-100 msec/cyc range of most other CAPS/3CAPS/
;;;;                  4CAPS models.  (By comparison, Soar and Epic enforce a
;;;;                  mapping of 50 msec/cyc; ACT-R estimates different times
;;;;                  for different productions, but is generally in the same
;;;;                  range.)  Now, the temporal mapping is 25 msec/cyc.
;;;;
;;;;   9.1.2003 sv: (v0.3.3) As a test, eliminated the lone remaining function
;;;;                  of LH-Executive -- to select between motor operators via
;;;;                  its COMPUTE-DELTA-HEADING production.  This increased the
;;;;                  temporal mapping required to achieve 3 steers/sec from
;;;;                  25 msec/cyc to 35 msec/cyc.  However, commented this out
;;;;                  because it is a somewhat implausible neural implementation.
;;;;
;;;;   9.3.2003 sv: (v0.3.4) Implemented a second way to define a road to be
;;;;                  to be driven: as a polynomial function.  This is useful
;;;;                  in conjunction with code in an another file "convert-
;;;;                  road.lsp" that estimates a polynomial road from its raw
;;;;                  (x,y) coordinates via regression.  This code allows
;;;;                  estimation of the actual roads participants drive in CCBI
;;;;                  experiments.  These polynomial estimates can be utilized
;;;;                  by the model via the new road class.  This allows closer
;;;;                  simulations of experimental conditions than was possible
;;;;                  before, when sinsuoidal proxies were used.
;;;;
;;;;                Systematized the two top-level commands for running driving
;;;;                  simulations, one via the algorithmic Lisp code (RV-TEST)
;;;;                  and one via the 4CAPS model (SIM).
;;;;
;;;; v0.4 spans work on the model during the initial write-up of all dual-
;;;; tasking work, including the dual driving models.
;;;;
;;;;  11.1.2004 sv: (v0.4.1) Streamlined comments, organized code, and cleaned-
;;;;                  up the printing of driving traces.
;;;;
;;;;                Added the boolean conditions necessary for the model to run
;;;;                  both alone and as part of a dual-task model.
;;;;
;;;;  11.2.2004 sv: (v0.4.2) The General Executive model has diverged slightly
;;;;                  in its instantiations in various domains -- TOL, mental
;;;;                  rotation, driving, and TOH.  For example, the goal that
;;;;                  represents the task being performed was called the TOP-
;;;;                  LEVEL-GOAL in earlier instantiations and the TASK-GOAL
;;;;                  in later instantiations.  Re-standardized this and other
;;;;                  differences
;;;;
;;;;                Fit the model to the driving single-task conditions of the
;;;;                  Driving Visual Sentences and "Dual Driving studies.
;;;;
;;;;  05.4.2005 sv: (v0.4.3) Cleaned-up code and comments for circulation
;;;;                  within the CCBI.  Code clean-up included re-writing some
;;;;                  Lisp functions for style rather than efficiency and
;;;;                  eliminating some now-obsolete productions of the General
;;;;                  Executive model.  Comment clean-up included deleting
;;;;                  comments that marked design choices that were ultimately
;;;;                  rejected and introducing some tutorial material.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Design Decisions, Bugs, and Errata:
;;;;
;;;; The currently visible section of road should be encoded in separate
;;;; visuospatial dmes that give the near and far points for now.  In later
;;;; versions, the DRIVING-STATES of other cars should also be encoded.
;;;;
;;;; What is the fate of old motor operators?
;;;;
;;;; Should EVALUATE ((SELF ROAD) X) push corrections into the path class
;;;; itself?
;;;;
;;;; Should NEXT-TANGENT ((SELF ROAD)...) push corrections into the path class
;;;; itself?
;;;;
;;;; Move some of the road computations (e.g., ROAD-TOP-Y) out of the ROAD-VIEW
;;;; class and into the ROAD class.
;;;;
;;;; Define default values for MIN-Y and MAX-Y in PRINC-ROAD-VIEW.
;;;;
;;;; The NEXT-TANGENT method uses a rummy way to find the next tangent, whether
;;;; for sinusoidal or polynomial road paths.  Should really use calculus
;;;; symbolically rather than faking the derivative numerically.
;;;;
;;;; There is one difference in the numerical specializations of the centers
;;;; for the various cognitive function when running in single-task versus
;;;; dual-task mode.  Eliminate this difference or document it.
;;;;
;;;; The SUPPRESS-SUPERFLUOUS-PREFERENCE production really belongs in the
;;;; General Executive model because it does not match against domain-specific
;;;; dmes.  Will it sometimes override or act redundantly with the SUPPRESS-
;;;; PREFERENCE production in LH-Executive?
;;;;
;;;; In a few places, productions of the General Executive model had to be
;;;; changed to produce dmes specific to the driving domain for the model to
;;;; work properly in dual-task mode.  This lessens their generality.  Must
;;;; think of a way to eliminate this manual kludge.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Contents
;;;;
;;;;   (1) Initialization.
;;;;   (2) Road Views.
;;;;   (2) DM Classes.
;;;;   (3) Centers.
;;;;   (4) The LH-Executive Center.
;;;;   (5) The RH-Executive Center.
;;;;   (6) The LH-Spatial Center.
;;;;   (7) The RH-Spatial Center.
;;;;   (8) Support Code.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (1) Initialization.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; 4caps.
;;;


;;

;;; We don't want to redefine the default-dme-thresh (i.e., the default amount
;;; of activation a declarative memory element must possess to be eligible to
;;; match against productions) if it has already been defined by another model.
;;; This conflict arises when we are simulating dual-tasking.  So check that
;;; this is not the case before defining the default-dme-thresh.
(unless (and (boundp '*dual-task*) *dual-task*)
  (set-default-dme-thresh 0.099))

(unless (and (boundp '*dual-task*) *dual-task*)
  (set-tracing-p nil)
  (set-tracing-dm-p nil))


;; Spewing parameters.

(unless (and (boundp '*dual-task*) *dual-task*)
  (defparameter *weight* 1.0)
  (defparameter *spew-rate* 1.0))



;;;
;;; General Executive model.
;;;


;; The choice between alternate (competing) operators is via a horse race.
;; These parameters govern the speed of that race, i.e., the rate at which
;; preferences accrue activation.

(defparameter *default-preference-weight* 0.1)

(defparameter *driving-preference-weight* 0.45)



;;;
;;; Driving Model.
;;;


;; Parameters taken directly from Salvucci's ACT-R model.

;;; 16 in Salvucci's ACT-R code, 20 in published papers.
(defparameter *c1* 0.6)

;;; 8 in Salvucci's ACT-R code, 10 in published papers.
(defparameter *c2* 0.05)

;;; 5 in Salvucci's ACT-R code, 5 in published papers.
(defparameter *c3* 1)

;;; Most extreme value of near angle permissible when computing delta-steer
;;; (i.e., the change in the steering angle). 
;;;
;;; .05 radians (2.9 degrees) in Salvucci's ACT-R code.
(defparameter *na-max* 10)


;; The CCBI driving environment.

;;; Was 40.0 in the (dual) driving experiments.
(defparameter *miles-per-hour* 30.0)

(defparameter *feet-per-second* (/ (* *miles-per-hour* 5280) (* 60 60)))

(defparameter *feet-per-radian* *feet-per-second*)

;;; Default distance to the horizon (in feet) for road paths of the SINS class.
(defparameter *default-sins-horizon* (* pi *feet-per-radian*))

;;; Distance to the horizon (in feet) for road paths of the POLYNOMIAL class.
(defparameter *default-polynomial-horizon* 250)

;;; Temporal lookahead to near point (in seconds).  Value used by Salvucci's
;;; ACT-R model based on Land's estimate.
(defparameter *near-time* 0.5)

;;; Default tick duration during non-model simulations of driving (i.e.,
;;; used by RV-TEST).
(defparameter *dt* 0.33)

;;; Value used in the (dual) driving experiments.
(defparameter *default-road-width* 20.379)

;;; When the vehicle hits the edge of the road, is it automatically re-
;;; centered (T), or is it allowed to drift off-road (NIL)?
(defparameter *recenter-on-bump-p* t)


;; Variables that track performance over the course of a simulation.

(defparameter *deviations* 0)

(defparameter *num-off-road* 0)


;; Mapping between real time and 4CAPS macrocycles.
;; 
;; Which mapping is appropriate depends on which version of the model is
;; being used, and the number of steer per second are desired.

; Use these temporal mappings if only motor operators require Executive
; intervention through preference generation and adjudication.

;;; Yields approximately 3 steer per second.
(defparameter *secs-per-mcyc* 0.026)

;;; Yields approximately 4 steer per second.
;(defparameter *secs-per-mcyc* 0.0195)


; Use these temporal mappings if all perceptual and motor operators require
; Executive intervention through preference generation and adjudication.

#|
;;; Yields approximately 3 steer per second.
;(defparameter *secs-per-mcyc* 0.0155)

;;; Yields approximately 4 steer per second.
;(defparameter *secs-per-mcyc* 0.0115)
|#


; Use these temporal mappings if no operators require Executive intervention
; through preference generation and adjudication.

#|
;;; Yields approximately 3 steer per second.
(defparameter *secs-per-mcyc* 0.034)

;;; Yields approximately 4 steer per second.
;(defparameter *secs-per-mcyc* 0.0255)
|#


;;

(defun encode-time ()
  (* *macro-cycs* *secs-per-mcyc*))


;; This variable holds the object that encapsulates the entire driving
;; environment -- the shape of the road, the vehicle's current position on
;; the road, its current heading, etc.

(defparameter *rv* nil)

;;

(defun encode-pos-x ()
  (pos-x *rv*))

(defun encode-near-point ()
  (near-point *rv*))

(defun encode-far-point ()
  (far-point *rv*))



;;;
;;; Helper functions.
;;;


;; Trigonemetric.

;;; The resolution used when computing the tangent point in the NEXT-TANGENT
;;; methods below.
(defparameter *tangent-increments* 1000)

(defun ang-from-rads (radians)
  (* radians (/ 180 pi)))

(defun rads-from-ang (angle)
  (* angle (/ pi 180)))


;; Statistical.

(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)))))))))


;;

;;; Assumes MAX-VAL is positive. 
(defun min-signed (val max-val)
  (if (plusp val)
    (min val max-val)
    (max val (- max-val))))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (2) Road Views.
;;;;
;;;; The shape of the road can be specified as a sum of sinusoidal waves using
;;;; objects of the SINS class.  This elegant method is used in many of David
;;;; Strayer's empirical studies of driving.  The shape of the road can also
;;;; be specified by a polynomial using objects of the POLYNOMIAL class.  This
;;;; is useful for encoding purely empirical roads, such as those used in the
;;;; CCBI driving experiments.
;;;;
;;;; Objects of class ROAD hide the specific shape representation used.
;;;;
;;;; Objects of class ROAD-VIEW class encapsulate an entire driving
;;;; environment.  They specify the road being driven, the current position of
;;;; the vehicle, the current geading of the vehicle, etc.
;;;;
;;;; Finally, several roads are defined, some using sinusoidal shape
;;;; definitions and one using a polynomial definition.  Driving along these
;;;; roads can be simulated using the RV-TEST Lisp function.  This is useful
;;;; for confirming that road definitions are correct and, more generally, that
;;;; the driving environment is functioning properly.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; Roads shapes.
;;;


;; Specify the shape of a road as the sum of SIN functions.


; A single SIN function A*sin(B*x+C)+D.

(defclass sin ()
  ((a :initarg :a
      :initform 1)
   (b :initarg :b
      :initform 1)
   (c :initarg :c
      :initform 0)
   (d :initarg :d
      :initform 0)))

(defmethod evaluate ((self sin) x)
  (with-slots (a b c d) self
    (+ (* a (sin (+ (* b x) c))) d)))


;; A sum of multiple SIN functions.

(defclass sins ()
  ((components :initarg :components
               :accessor components)))

(defmethod initialize-instance :after ((self sins) &rest initargs)
  (declare (ignore initargs))
  (unless (and (slot-boundp self 'components)
               (listp (components self))
               (plusp (length (components self))))
    (error "Must suppply a non-empty list of COMPONENT sin functions.")))

(defmethod evaluate ((self sins) x)
  (apply #'+ (mapcar #'(lambda (comp)
                         (evaluate comp x))
                     (components self))))

;;; Crummy way to find the next tangent.  Should really use calculus
;;; symbolically rather than faking the derivative in this numerical fashion.
(defmethod next-tangent ((self sins) init-x max-delta)
  (let* ((max-x (+ init-x max-delta))
         (incr-x (/ max-delta *tangent-increments*))
         (val-2 (evaluate self init-x))
         (val-1 (evaluate self (+ init-x incr-x))))
    (do* ((x (+ init-x incr-x incr-x) (+ x incr-x))
          (val (evaluate self x) (evaluate self x)))
         ((> x max-x))
      (when (or (and (> val-1 val) (> val-1 val-2))
                (and (< val-1 val) (< val-1 val-2)))
        (return-from next-tangent (- x incr-x)))
      (setq val-2 val-1
            val-1 val)))
  nil)


;; Specify the shape of a road as a high-degree polynomial.

(defclass polynomial ()
  ((coefficients :initarg :coefficients
                 :accessor coefficients)))

(defmethod initialize-instance :after ((self polynomial) &rest initargs)
  (declare (ignore initargs))
  (unless (and (slot-boundp self 'coefficients)
               (typep (coefficients self) '(array * (* 1)))
               (plusp (array-dimension (coefficients self) 0)))
    (error "Must supply the polynomial's COEFFICIENTS via a column vector.")))

(defmethod evaluate ((self polynomial) x)
  (let ((y 0))
    (dotimes (power (array-dimension (coefficients self) 0))
      (incf y (* (aref (coefficients self) power 0)
                 (expt x power))))
    y))

;;; Crummy way to find the next tangent.  Should really use calculus
;;; symbolically rather than faking the derivative in this numerical fashion.
(defmethod next-tangent ((self polynomial) init-x max-delta)
  (let* ((max-x (+ init-x max-delta))
         (incr-x (/ max-delta *tangent-increments*))
         (val-2 (evaluate self init-x))
         (val-1 (evaluate self (+ init-x incr-x))))
    (do* ((x (+ init-x incr-x incr-x) (+ x incr-x))
          (val (evaluate self x) (evaluate self x)))
         ((> x max-x))
      (when (or (and (> val-1 val) (> val-1 val-2))
                (and (< val-1 val) (< val-1 val-2)))
        (return-from next-tangent (- x incr-x)))
      (setq val-2 val-1
            val-1 val)))
  nil)



;;;
;;; The External Driving Environment.
;;;


;; Roads (encapsulates/abstracts over the underlying raw representation as
;; a sum of sin functions or a polynomial).

(defclass road ()
  ((path :initarg :path
         :accessor path)
   (width :initarg :width
          :initform *default-road-width*
          :accessor width)))

(defmethod initialize-instance :after ((self road) &rest initargs)
  (declare (ignore initargs))
  (unless (slot-boundp self 'path)
    (error "Must supply the road's curvature via a :PATH argument.")))

(defmethod evaluate ((self road) x)
  ;; Yikes!  Make this naturally polymorphic.
  (etypecase (path self)
    (sins
     (* (evaluate (path self) (/ x *feet-per-radian*)) *feet-per-radian*))
    (polynomial
     (evaluate (path self) x))))

(defmethod next-tangent ((self road) init-x max-delta)
  (etypecase (path self)
    (sins
     (let ((tangent-x (next-tangent (path self)
                                    (/ init-x *feet-per-radian*)
                                    (/ max-delta *feet-per-radian*))))
       (if tangent-x
         (* tangent-x *feet-per-radian*)
         nil)))
    (polynomial
     (next-tangent (path self) init-x max-delta))))


; A couple of support functions for finding the minimum and maximum road
; (y) values over a range of x values.  This information is useful for
; scaling the driving trace.

(defmethod find-min-y ((self road) max-x &optional (increments 1000))
  (let ((delta (/ max-x increments))
        (min-y nil)
        (min-y-x nil))
    (do* ((x 0 (+ x delta))
          (y (evaluate self x) (evaluate self x)))
        ((> x max-x))
      (when (or (not min-y)
              (< y min-y))
        (setq min-y y
              min-y-x x)))
    (values min-y min-y-x)))

(defmethod find-max-y ((self road) max-x &optional (increments 1000))
  (let ((delta (/ max-x increments))
        (max-y nil)
        (max-y-x nil))
    (do* ((x 0 (+ x delta))
          (y (evaluate self x) (evaluate self x)))
        ((> x max-x))
      (when (or (not max-y)
              (> y max-y))
        (setq max-y y
              max-y-x x)))
    (values max-y max-y-x)))


;; An encapsulation of the external driving environment.
;;
;; NOTE: POV stands for "Point of View."

(defclass road-view ()
  ((pov-x :initarg :pov-x
          :initform 0
          :accessor pov-x)
   (heading :initarg :heading
            :initform 0
            :accessor heading)
   (near-angle :initarg :near-angle
               :initform 0
               :accessor near-angle)
   (far-angle :initarg :far-angle
              :initform 0
              :accessor far-angle)
   (road :initarg :road
         :accessor road)
   (horizon :initarg :horizon
            :accessor horizon)
   (pos-x :initarg :pos-x
          :initform 0
          :accessor pos-x)
   (pos-y :initarg :pos-y
          :initform 0
          :accessor pos-y)
   (next-tan :initform nil
             :accessor next-tan)
   (min-y :initarg :min-y
          :initform nil
          :accessor min-y)
   (max-y :initarg :max-y
          :initform nil
          :accessor max-y)))

(defmethod initialize-instance :after ((self road-view) &rest initargs)
  (declare (ignore initargs))
  (assert (slot-boundp self 'road))
  (unless (slot-boundp self 'horizon)
    ;; Yikes!  Make this naturally polymorphic.
    (setf (horizon self) (etypecase (path (road self))
                           (sins *default-sins-horizon*)
                           (polynomial *default-polynomial-horizon*)))))

(defmethod initialize-road-view ((self road-view))
  (setf (next-tan self) nil)
  (setf (near-angle self) 0)
  (setf (far-angle self) 0)
  (setf (pos-x self) 0)
  (setf (pos-y self) (evaluate self 0))
  (setf (heading self) (projected-angle self (near-point self))))

(defmethod evaluate ((self road-view) x)
  (evaluate (road self) x))

(defmethod near-point ((self road-view))
  (let ((near-x (+ (pos-x self) (* *near-time* *feet-per-second*))))
    (cons near-x (evaluate self near-x))))

(defmethod far-point ((self road-view))
  (if (and (next-tan self)
           (> (car (next-tan self)) (pos-x self)))
    (next-tan self)
    (let* ((tan-x (next-tangent (road self) (pos-x self) (horizon self)))
           (next-tan (if tan-x
                       (cons tan-x (evaluate self tan-x))
                       (let ((horz-x (+ (pos-x self) (horizon self))))
                         (cons horz-x (evaluate self horz-x))))))
      (setf (next-tan self) next-tan)
      next-tan)))

(defmethod projected-angle ((self road-view) arg-x &optional arg-y)
  (let ((x (if (consp arg-x)
             (car arg-x)
             arg-x))
        (y (if (consp arg-x)
             (cdr arg-x)
             arg-y)))
    (ang-from-rads (atan (/ (- y (pos-y self))
                            (- x (pos-x self) (pov-x self)))))))

(defmethod update ((self road-view) &optional (dt *dt*))
  (let* ((na (- (projected-angle self (near-point self)) (heading self)))
         (dna (- na (near-angle self)))
         (fa (- (projected-angle self (far-point self)) (heading self)))
         (dfa (- fa (far-angle self)))
         (delta-heading (+ (* *c1* dfa)
                           (* *c2* dna)
                           (* *c3* (min-signed na *na-max*) dt)))
         (new-heading (+ (heading self) delta-heading))
         (delta-pos-x (* dt *feet-per-second*)))
    (setf (near-angle self) na)
    (setf (far-angle self) fa)
    (setf (heading self) new-heading)
    (incf (pos-x self) delta-pos-x)
    (incf (pos-y self) (* (tan (rads-from-ang new-heading)) delta-pos-x)))
  nil)

(defmethod center-deviation ((self road-view))
  (- (pos-y self) (evaluate self (pos-x self))))

(defmethod on-road-p ((self road-view))
  (let* ((rw (/ (width (road self)) 2))
         (road-center-y (evaluate self (pos-x self)))
         (road-top-y (+ road-center-y rw))
         (road-bottom-y (- road-center-y rw)))
    (<= road-bottom-y (pos-y self) road-top-y)))

(defmethod off-road-p ((self road-view))
  (not (on-road-p self)))

(defmethod recenter-position ((self road-view))
  (setf (pos-y self) (evaluate self (pos-x self))))

(defmethod princ-road-view ((self road-view))
  (let* ((rw (truncate (width (road self)) 2))
         (car-y (truncate (pos-y self)))
         (road-center-y (truncate (evaluate self (pos-x self))))
         (road-top-y (+ road-center-y rw))
         (road-bottom-y (- road-center-y rw))
         (min-y (min (or (min-y self) 0) -80))
         (max-y (max (or (max-y self) 0) 80))
         (delta (/ (- max-y min-y)
                   80))
         (half-delta (/ delta 2)))
    (do* ((y min-y (+ y delta))
          (int-bot (- y half-delta) (- y half-delta))
          (int-top (+ y half-delta) (+ y half-delta)))
         ((> y max-y))
      (cond ((and (<= int-bot car-y) (< car-y int-top))
             (format t "V"))
            ((and (<= int-bot road-center-y) (< road-center-y int-top))
             (format t "."))
            ((or (and (<= int-bot road-top-y) (< road-top-y int-top))
                 (and (<= int-bot road-bottom-y) (< road-bottom-y int-top)))
             (format t "*"))
            ((<= road-bottom-y y road-top-y)
             (format t " "))
            (t
             (format t "."))))))



;;;
;;; Lisp-based driving simulation.
;;;


;; Sinusoidal roads.

(defparameter *easy-rv* (make-instance 'road-view
                          :pov-x -10
                          :road (make-instance 'road
                                  :path (make-instance 'sins
                                          :components (list (make-instance 'sin :a 0.25 :b 0.33)
                                                            )))))

(defparameter *medium-rv* (make-instance 'road-view
                            :pov-x -10
                            :road (make-instance 'road
                                    :path (make-instance 'sins
                                            :components (list (make-instance 'sin :a 0.25 :b 0.33)
                                                              (make-instance 'sin :a 0.25 :b 0.66)
                                                              )))))

(defparameter *hard-rv* (make-instance 'road-view
                          :pov-x -10
                          :road (make-instance 'road
                                  :path (make-instance 'sins
                                          :components (list (make-instance 'sin :a 0.25 :b 0.33)
                                                            (make-instance 'sin :a 0.25 :b 0.66)
                                                            (make-instance 'sin :a 0.25 :b 1.00)
                                                            )))))


;; Polynomial roads.

;;; An approximation of the road used in CCBI driving experiments.
(defparameter *ccbi-rv* (make-instance 'road-view
                          :pov-x -10
                          :road (make-instance 'road
                                  :path (make-instance 'polynomial
                                          :coefficients #2a((-3.639274835586548)
                                                            (-1.719106687232852)
                                                            (0.016328601996065117)
                                                            (-9.92368900369911E-5)
                                                            (3.101222064705311E-7)
                                                            (-5.130757713221051E-10)
                                                            (4.84980429157264E-13)
                                                            (-2.7180952879288116E-16)
                                                            (8.943248066272274E-20)
                                                            (-1.5969289785060125E-23)
                                                            (1.1948646210706176E-27))))))


;; Top-level command to simulate driving over a given road (view) for a given
;; amount of time.  Driving is via the Lisp code implementation of the Salvucci
;; algorithm, not the 4CAPS model.  This is fast and useful gaining an
;; understanding of how the external driving environment is represented.

(defun rv-test (&key (rv *ccbi-rv*) (time 60))
  (let ((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)
    (format t "~&TIME")
    (do ((cur-time 0 (+ cur-time *dt*)))
        ((> cur-time time))
      (format t "~%~5,2F~A" cur-time #\tab)
      (princ-road-view rv)
      (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 *dt*)))
  (format t "~%Avg Abs Dev:   ~,2F ft (+/- ~,2F ft)"
          (/ *deviations* (/ time *dt*))
          (/ (width (road rv)) 2))
  (if *recenter-on-bump-p*
    (format t "~%Num Bumps:     ~,A" *num-off-road*)
    (format t "~%Time Off-Road: ~,2F sec" (* *num-off-road* *dt*)))
  (format t "~&Time:          ~,2F sec" time)
  nil)


;; Evaluate these Lisp-based drives.

#|
;;; Drive the easy sinsuoidal road for 60 sec.
(rv-test :rv *easy-rv*)

;;; Drive the medium sinsuoidal road for 60 sec.
(rv-test :rv *medium-rv*)

;;; Drive the hard sinsuoidal road for 60 sec.
(rv-test :rv *hard-rv*)

;;; Drive the CCBI road for 60 sec.
(rv-test)

;;; Drive the CCBI road for 15 sec.
(rv-test :time 15)
|#




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (3) Declarative Memory (DM) classes.
;;;;
;;;; The DM class hierarchy is represented schematically below. "A: B" means
;;;; that class A is a superclass of class B.
;;;;
;;;; Note that the Driving model specialized the General Executive model for
;;;; the driving domain.  The General Executive model provides general classes.
;;;; These are notated in upper-case letters.  Their specializations for the
;;;; driving domain are notated in lower-case letters.
;;;;
;;;; BASE-STATE:          STATE:                road-position
;;;;                      END-STATE:            end-road-position
;;;;
;;;; OPERATOR:            perceptual-operator:  attend-near-point
;;;;                                            attend-far-point
;;;;                                            compute-angles
;;;;                                            compute-delta-heading
;;;;                      motor-operator:       steer
;;;;
;;;; PREFERENCE:          driving-preference
;;;;
;;;; PREFERRED-OPERATOR:  preferred-driving-operator
;;;;
;;;; BASE-GOAL:           TASK-GOAL:       drive-goal
;;;;                      GOAL:            control-perceive-goal
;;;;                                       control-steering-goal
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;
;;; Executive model classes.
;;;


;; STATE related classes and methods.


;

(defdmclass base-state ()
  contents)


; 

(defdmclass state (base-state))

(defmethod more-recent-state-p ((s1 state) (s2 state))
  (> (id s1) (id s2)))


;

(defdmclass end-state (base-state))


;; The OPERATOR class.

(defdmclass operator ()
  state)


;; The PREFERENCE class.

(defdmclass preference ()
  better-operator
  worse-operator)


;; The PREFERRED-OPERATOR class.

(defdmclass preferred-operator ()
  operator)


;; GOAL-related classes and methods.


;

(defdmclass base-goal ())

(defmethod more-recent-goal-p ((bg1 base-goal) (bg2 base-goal))
  (> (id bg1) (id bg2)))


;

(defdmclass task-goal (base-goal))


;

(defdmclass goal (base-goal)
  operator)


;; General multimethods.  A multimethod is a method specialized on the class
;; of more than one of its arguments.  For this reasons, multimethods don't
;; really belong to a single class.  These multimethods are general, and must
;; be specialized for the particulars of the domain to which the General
;; Executive model is being applied.  These specializations are done below.


;

(defmethod contents-equal ((c1 t) (c2 t))
  (error "The CONTENTS-EQUAL multimethod must be specialized for the task."))

;;^^ HUGE CHANGE: NOT-SOLVED-P IS OVERRIDDEN BELOW TO *NOT* CALL CONTENTS-EQUAL.
;;^^              RATHER, IT HANDLES ROAD-POSITION AND END-ROAD-POSITION ITSELF.
;;^^              SEE THE MULTIMETHODS ON STATE AND END-STATE.
(defmethod not-solved-p ((s state) (es end-state))
  (not (contents-equal (contents s) (contents es))))


;

;;; Does the operator OP1 make faster progress towards the end state ES than
;;; the operator OP2?  This method must be defined when the general Executive
;;; Model is applied to a particular domain to reflect what counts as direct
;;; progress in that domain, e.g., moving a ball to its pocket position in
;;; the end TOL configuration,
(defmethod steeper-climbing-operator-p ((op1 operator) (op2 operator) (es end-state))
  (error "The STEEPER-CLIMBING-OPERATOR-P multimethod must be specialized for the task."))


;

;;; Perform the operator OP on the state S, yielding the contents of the new,
;;; successor state.  This method must be defined when the general Executive
;;; Model is applied to a particular domain to reflect how the contents of
;;; states are represented in that domain, e.g., by a list of lists, one for
;;; each pocket, in the TOL domain.
(defmethod perform-operator ((op operator) (s state))
  (error "The PERFORM-OPERATOR multimethod must be specialized for the task."))


;

;;; Does the state S represent satisfaction of the goal G?  This method must
;;; be defined when the general Executive Model is applied to a particular
;;; domain to reflect the vagaries of goals and how goals are represented in
;;; that domain.
(defmethod satisfied-p ((g goal) (s state))
  (error "The SATISFIED-P multimethod must be specialized for the task."))




;;;
;;; Driving model classes.
;;;


;; STATE-related classes and methods.

(defdmclass road-position (state)
  pos-x
  near-point
  far-point
  near-angle
  far-angle
  delta-heading
  timestamp)

(defmethod compute-near-angle ((self road-position))
  (- (projected-angle *rv* (near-point self)) (heading *rv*)))

(defmethod compute-far-angle ((self road-position))
  (- (projected-angle *rv* (far-point self)) (heading *rv*)))

(defmethod compute-delta-heading-initially ((self road-position))
  (let* ((dna (near-angle self))
         (dfa (far-angle self))
         (dt (timestamp self)))
    (+ (* *c1* dfa)
       (* *c2* dna)
       (* *c3* (min-signed (near-angle self) *na-max*) dt))))


;

(defdmclass end-road-position (end-state)
  pos-x)


; STATE-related multimethods.

(defmethod compute-delta-heading ((self road-position) (prev road-position))
  (let* ((dna (- (near-angle self) (near-angle prev)))
         (dfa (- (far-angle self) (far-angle prev)))
         (dt (- (timestamp self) (timestamp prev))))
    (+ (* *c1* dfa)
       (* *c2* dna)
       (* *c3* (min-signed (near-angle self) *na-max*) dt))))


;; OPERATOR-related classes.


; Perceptual operators.

(defdmclass perceptual-operator (operator)
  )

(defdmclass attend-near-point (perceptual-operator)
  )

(defdmclass attend-far-point (perceptual-operator)
  )

(defdmclass compute-angles (perceptual-operator)
  )

(defdmclass compute-delta-heading (perceptual-operator)
  )


; Motor operators.

(defdmclass motor-operator (operator)
  )

(defdmclass steer (motor-operator)
  )


;; PREFERENCE-related classes.

(defdmclass driving-preference (preference)
  )


;; PREFERRED-OPERATOR-related classes.

(defdmclass preferred-driving-operator (preferred-operator)
  )


;; GOAL classes.
;;
;; Goals sequence the phases of the "control" aspect of Salvucci's ACT-R model.


;

(defdmclass drive-goal (task-goal))


;

(defdmclass control-perceive-goal (goal)
  )

(defdmclass control-steering-goal (goal)
  )


;; Driving Model multimethods.

;;^^ HUGE CHANGE: NOT-SOLVED-P DOES *NOT* CALL CONTENTS-EQUAL.
;;^^              RATHER, IT HANDLES ROAD-POSITION AND END-ROAD-POSITION ITSELF.
(defmethod not-solved-p ((rp road-position) (erp end-road-position))
  (< (pos-x rp) (pos-x erp)))

(defmethod steeper-climbing-operator-p ((op1 operator) (op2 operator) (erp end-road-position))
  nil)

(defmethod perform-operator ((op operator) (rp road-position))
  nil)

(defmethod satisfied-p ((g goal) (rp road-position))
  nil)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (4) Centers.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; Define centers.
;;;


;; Delete existing centers.

(unless (and (boundp '*dual-task*) *dual-task*)
  (del-centers))


;; Define model centers.


; A support center used to hold representations and perform processing
; outside the scope of the current model, e.g., visual and perceptual
; processing.

(unless (and (boundp '*dual-task*) *dual-task*)
  (add-center support))


;

(add-center lh-executive)
(add-center rh-executive)


; 

(add-center lh-spatial)
(add-center rh-spatial)


;; Set the default executive specializations of each center.

(unless (and (boundp '*dual-task*) *dual-task*)
  (set-specs@ support base-dme nil))

(cond ((and (boundp '*dual-task*) *dual-task*)
       (set-specs@ lh-executive base-dme nil
                                base-state t
                                operator t

                                ;; The one difference between single-tasking
                                ;; and dual-tasking.  Eliminate this or document
                                ;; it.
                                preference 1.01

                                preferred-operator 1
                                base-goal t)
       (set-specs@ rh-executive base-dme nil
                                base-state t
                                operator t
                                preference t
                                preferred-operator t
                                base-goal 1)
       (set-specs@ lh-spatial base-dme nil
                              base-state 1
                              operator t
                              preference t
                              preferred-operator t
                              base-goal t)
       (set-specs@ rh-spatial base-dme nil
                              base-state t
                              operator 1
                              preference t
                              preferred-operator t
                              base-goal t))
      (t
       (set-specs@ lh-executive base-dme nil
                                base-state t
                                operator t
                                preference 1
                                preferred-operator 1
                                base-goal t)
       (set-specs@ rh-executive base-dme nil
                                base-state t
                                operator t
                                preference t
                                preferred-operator t
                                base-goal 1)
       (set-specs@ lh-spatial base-dme nil
                              base-state 1
                              operator t
                              preference t
                              preferred-operator t
                              base-goal t)
       (set-specs@ rh-spatial base-dme nil
                              base-state t
                              operator 1
                              preference t
                              preferred-operator t
                              base-goal t)))


;; Set the activation capacities of each center.

(unless (and (boundp '*dual-task*) *dual-task*)
  (set-caps@ support nil))

;;; Capacities for fitting the Driving Alone condition of the Driving Visual
;;; Sentences study.  (Voxel counts on the left, CUs on the right.)
;;;      L. DLPFC:    34     LH-Executive: 0.29
;;;      R. DLPFC:    30     RH-Executive: 0.25
;;;      L. Parietal: 58     LH-Spatial:   0.57
;;;      R. Parietal: 62     RH-Spatial:   0.59
;;; Correlation = 0.9985
(set-caps@ lh-executive 1.5)
(set-caps@ rh-executive 8.5)
(set-caps@ lh-spatial 10.0)
(set-caps@ rh-spatial 6.0)

#|
;;; Capacities for fitting the Driving Alone condition of the Dual Driving
;;; study.  (Voxel counts on the left, CUs on the right.)
;;;      L. DLPFC:    15     LH-Executive: 0.14
;;;      R. DLPFC:    12     RH-Executive: 0.11
;;;      L. Parietal: 34     LH-Spatial:   0.32
;;;      R. Parietal: 20     RH-Spatial:   0.18
;;; Correlation = 0.9993
(set-caps@ lh-executive 3.5)
(set-caps@ rh-executive 19.0)
(set-caps@ lh-spatial 18.0)
(set-caps@ rh-spatial 20.0)
|#




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (5) The LH-Executive Center.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; Executive model productions.
;;;


;; Assert preferences among operators.

;;; When an operator has been proposed, asserts a so-called unary preference,
;;; likely in LH-Executive, that serves as its proxy during contention
;;; scheduling.  It will accumulate activation via the assertion of preferences
;;; by other productions, and if it reaches threshold first, it will be
;;; selected as the preferred-operator.
;;;
;;; NOTE: (Driving) Changed the RHS so that a DRIVING-PREFERENCE, not generic
;;;      PREFERENCE dme is created.  This is necessary to get the Driving model
;;;      to work in dual-task mode.
(p@ lh-executive unary-preference ((s state)
                                   (es end-state)
                                   (op operator))
    (not-solved-p s es)
    (equal s (state op))
    (*no ((~s state))
      (more-recent-state-p ~s s))
    (*no ((~pop preferred-operator))
      (equal (state (operator ~pop)) s))
    (*no ((~dpr driving-preference))
      (equal (better-operator ~dpr) op)
      (null (worse-operator ~dpr)))
-->
    (spew t (driving-preference :better-operator op)
            (* *default-preference-weight* *spew-rate*))
)


;; Select preferred operator among contenders given preferences.

;;; Select the best operator through consideration of unary preferences.  Such
;;; competitions are horse races, and thus the selected operator's preference
;;; must achieve an activation level above threshold.
;;;
;;; NOTE: (Driving) Changed the RHS so that a PREFERRED-DRIVING-OPERATOR, not
;;;       a generic PREFERRED-OPERATOR dme is created.  This is necessary to
;;;       get the Driving model to work in dual-task mode.
(p@ lh-executive select-among-unary-operators ((s state)
                                               (es end-state)
                                               (op operator)
                                               (pr preference 0.95))
    (not-solved-p s es)
    (equal s (state op))
    (equal (better-operator pr) op)
    (*whole (null (worse-operator pr)))
    (*no ((~s state))
      (more-recent-state-p ~s s))
    (*no ((~pr preference))
      (equal (worse-operator ~pr) op))
    (*no ((~pdop preferred-driving-operator))
      (equal (operator ~pdop) op))
-->
    (spew t (preferred-driving-operator :operator op)
            (* *weight* *spew-rate*))
)


;; Suppress preferences after a preferred operator has been selected.

;;; Suppress preferences once an operator has been selected.
(p@ lh-executive suppress-preferrence ((pop preferred-operator)
                                       (pr preference))
    (equal (state (operator pop)) (state (better-operator pr)))
    (*no ((~pop preferred-operator))
      (> (id ~pop) (id pop)))
-->
    (spew t pr (- (* *weight* *spew-rate*)))
)


;; Suppress a preferred operator marker...

;;; ...after it is performed.
;;;
;;; NOTE: (Driving) The driving model does not call CONTENTS-EQUAL, as the
;;;       other instantiations of the Executive model do to explicitly ensure
;;;       that the preferred operator was successfully applied and produced
;;;       the *intended* new state.  Instead, it simply tests for the existence
;;;       of *any* newer state, whatever it may be.
(p@ lh-executive suppress-preferred-operator-marker ((pop preferred-operator)
                                                     (op operator)
                                                     (bs state)
                                                     (as state))
    (equal (operator pop) op)
    (equal (state op) bs)
    (more-recent-state-p as bs)
;    (contents-equal (perform-operator op bs) (contents as))
-->
    (spew t pop (- (* *weight* *spew-rate*)))
)

;;; ...if it cannot be performed, and thus caused an impasse, and thus led to
;;; the activation of a goal.
(p@ lh-executive suppress-preempted-preferred-operator-marker ((g goal)
                                                               (pop preferred-operator)
                                                               (op operator))
    (equals (operator g) (operator pop) op)
-->
    (spew t pop (- (* *weight* *spew-rate*)))
)



;;;
;;; Driving productions.
;;;


;; Assert preferences during perception.

(p@ lh-executive prefer-attend-near-point ((rp road-position)
                                           (anp attend-near-point))
    (equal (state anp) rp)
    (*no ((~pop preferred-operator))
      (equal (state (operator ~pop)) anp))
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~dpr driving-preference 0.95))
      (equal (better-operator ~dpr) anp)
      (null (worse-operator ~dpr)))
-->
    (spew t (driving-preference :better-operator anp)
            (* *driving-preference-weight* *spew-rate*))
)

(p@ lh-executive prefer-attend-far-point ((rp road-position)
                                          (afp attend-far-point))
    (equal (state afp) rp)
    (*no ((~pop preferred-operator))
      (equal (state (operator ~pop)) afp))
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~dpr driving-preference 0.95))
      (equal (better-operator ~dpr) afp)
      (null (worse-operator ~dpr)))
-->
    (spew t (driving-preference :better-operator afp)
            (* *driving-preference-weight* *spew-rate*))
)

(p@ lh-executive prefer-compute-angles ((rp road-position)
                                        (ca compute-angles))
    (equal (state ca) rp)
    (*no ((~pop preferred-operator))
      (equal (state (operator ~pop)) ca))
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~dpr driving-preference 0.95))
      (equal (better-operator ~dpr) ca)
      (null (worse-operator ~dpr)))
-->
    (spew t (driving-preference :better-operator ca)
            (* *driving-preference-weight* *spew-rate*))
)


;; Assert preferences during Steering.

(p@ lh-executive prefer-compute-delta-heading ((rp road-position)
                                               (cdh compute-delta-heading))
    (equal (state cdh) rp)
    (*no ((~pop preferred-operator))
      (equal (state (operator ~pop)) cdh))
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~dpr driving-preference 0.95))
      (equal (better-operator ~dpr) cdh)
      (null (worse-operator ~dpr)))
-->
    (spew t (driving-preference :better-operator cdh)
            (* *driving-preference-weight* *spew-rate*))
)



;; Suppress preferences about operators that have already been performed by
;; posterior centers because there is no ambiguity.

;;; This production really belongs in the General Executive model.  Will it
;;; sometimes override or act redundantly with the SUPPRESS-PREFERENCE
;;; production in LH-Executive?
(p@ lh-executive suppress-superfluous-preferrence ((pr preference)
                                                   (s1 state)
                                                   (s2 state))
    (equal s1 (state (better-operator pr)))
    (more-recent-state-p s2 s1)
-->
    (spew t pr (- (* *weight* *spew-rate*)))
)





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (6) The RH-Executive Center.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; General Executive model productions.
;;;


;;

;;; When the most recent goal G is satisfied by the current state S, then
;;; suppress the completed goal.
(p@ rh-executive suppress-satisfied-goal ((g goal)
                                          (s state))
    (satisfied-p g s)
    (*no ((~g goal))
      (more-recent-goal-p ~g g))
    (*no ((~s state))
      (more-recent-state-p ~s s))
-->
    (spew t g (- (* *weight* *spew-rate*)))
)



;;;
;;; Driving model productions.
;;;


;; Control-perceive phase.

(p@ rh-executive propose-control-steering-goal ((csg control-steering-goal)
                                                (rp road-position))
    (id csg)
    (near-point rp)
    (far-point rp)
    (near-angle rp)
    (far-angle rp)
    (delta-heading rp)
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~cpg control-perceive-goal))
      (more-recent-goal-p ~cpg csg))
-->
    (spew t (control-perceive-goal)
            (* *weight* *spew-rate*))

    (spew t (road-position :pos-x (encode-pos-x)
                           :timestamp (encode-time))
            (* *weight* *spew-rate*))
)

(p@ rh-executive suppress-satisfied-control-perceive-goal ((cpg control-perceive-goal)
                                                           (csg control-steering-goal))
    (more-recent-goal-p csg cpg)
    (*no ((~g goal))
      (more-recent-goal-p ~g csg))
-->
    (spew t cpg (- (* *weight* *spew-rate*)))
)


;; Control-steering phase.

(p@ rh-executive propose-control-steering-goal ((cpg control-perceive-goal)
                                                (rp road-position))
    (id cpg)
    (near-point rp)
    (far-point rp)
    (near-angle rp)
    (far-angle rp)
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~csg control-steering-goal))
      (more-recent-goal-p ~csg cpg))
-->
    (spew t (control-steering-goal)
            (* *weight* *spew-rate*))
)

(p@ rh-executive suppress-satisfied-control-steering-goal ((csg control-steering-goal)
                                                           (cpg control-perceive-goal))
    (more-recent-goal-p cpg csg)
    (*no ((~g goal))
      (more-recent-goal-p ~g cpg))
-->
    (spew t csg (- (* *weight* *spew-rate*)))
)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (7) The LH-Spatial Center.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; General Executive model productions.
;;;



;;;
;;; Driving model productions.
;;;


;; Perform perceptual operators.

;;; Achieved a better temporal mapping by commenting out the preferred
;;; operator, eliminating the role of the Executive centers in selecting
;;; between perceptual operators.
(p@ lh-spatial encode-near-point ((rp road-position)
                                  (erp end-road-position)
                                  (anp attend-near-point)
;                                  (pop preferred-operator)
                                  )
    (not-solved-p rp erp)
    (equal (state anp) rp)
;    (equal (operator pop) anp)
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~rp road-position))
      (>= (pos-x ~rp) (pos-x rp))
      (not (null (near-point ~rp))))
-->
    (spew t (road-position :pos-x (encode-pos-x)
                           :timestamp (encode-time)
                           :near-point (encode-near-point))
            (* *weight* *spew-rate*))
)

;;; Achieved a better temporal mapping by commenting out the preferred
;;; operator, eliminating the role of the Executive centers in selecting
;;; between perceptual operators.
(p@ lh-spatial encode-far-point ((rp road-position)
                                 (erp end-road-position)
                                 (afp attend-far-point)
;                                 (pop preferred-operator)
                                 )
    (not-solved-p rp erp)
    (equal (state afp) rp)
;    (equal (operator pop) anp)
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~rp road-position))
      (>= (pos-x ~rp) (pos-x rp))
      (equal (near-point ~rp) (near-point rp))
      (not (null (far-point ~rp))))
-->
    (spew t (road-position :pos-x (encode-pos-x)
                           :timestamp (encode-time)
                           :near-point (near-point rp)
                           :far-point (encode-far-point))
            (* *weight* *spew-rate*))
)

;;; Achieved a better temporal mapping by commenting out the preferred
;;; operator, eliminating the role of the Executive centers in selecting
;;; between perceptual operators.
(p@ lh-spatial compute-angles ((rp road-position)
                               (erp end-road-position)
                               (ca compute-angles)
;                                  (pop preferred-operator)
                               )
    (not-solved-p rp erp)
    (equal (state ca) rp)
;    (equal (operator pop) anp)
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~rp road-position))
      (>= (pos-x ~rp) (pos-x rp))
      (not (null (near-angle ~rp))))
-->
    (spew t (road-position :pos-x (encode-pos-x)
                           :timestamp (encode-time)
                           :near-point (near-point rp)
                           :far-point (far-point rp)
                           :near-angle (compute-near-angle rp)
                           :far-angle (compute-far-angle rp))
            (* *weight* *spew-rate*))
)

;;; Achieved a better temporal mapping by commenting out the preferred
;;; operator, eliminating the role of the Executive centers in selecting
;;; between perceptual operators.
(p@ lh-spatial compute-delta-heading-initially ((rp road-position)
                                                (erp end-road-position)
                                                (cdh compute-delta-heading)
;                                                (pop preferred-operator)
                                                )
    (not-solved-p rp erp)
    (equal (state cdh) rp)
;    (equal (operator pop) anp)
    (*no ((~rp road-position))
      (near-angle ~rp)
      (far-angle ~rp)
      (more-recent-state-p rp ~rp))
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~rp road-position))
      (>= (pos-x ~rp) (pos-x rp))
      (not (null (delta-heading ~rp))))
-->
    (let ((delta-heading (compute-delta-heading-initially rp)))
      (incf (heading *rv*) delta-heading)
      (spew t (road-position :pos-x (encode-pos-x)
                             :timestamp (encode-time)
                             :near-point (near-point rp)
                             :far-point (far-point rp)
                             :near-angle (near-angle rp)
                             :far-angle (far-angle rp)
                             :delta-heading delta-heading)
              (* *weight* *spew-rate*)))

    (format t "~%~5,2F~A" (* *macro-cycs* *secs-per-mcyc*) #\tab)
    (princ-road-view *rv*)
)

;;; CAN achieve a better temporal mapping by commenting out the preferred
;;; operator, eliminating the role of the Executive centers in selecting
;;; between motor operators.  However, didn't do this because then no role
;;; is left for LH-Executive in driving.
(p@ lh-spatial compute-delta-heading ((rp road-position)
                                      (prp road-position)
                                      (erp end-road-position)
                                      (cdh compute-delta-heading)
                                      
                                      ;; Comment this out to bypass Executive
                                      ;; centers.
                                      (pop preferred-operator)
                                      
                                      )
    (not-solved-p rp erp)
    (equal (state cdh) rp)

    ;; Comment this out to bypass Executive centers.
    (equal (operator pop) cdh)

    (near-angle prp)
    (far-angle prp)
    (more-recent-state-p rp prp)
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~rp road-position))
      (>= (pos-x ~rp) (pos-x rp))
      (not (null (delta-heading ~rp))))
-->
    (let ((delta-heading (compute-delta-heading rp prp)))
      (incf (heading *rv*) delta-heading)
      (spew t (road-position :pos-x (encode-pos-x)
                             :timestamp (encode-time)
                             :near-point (near-point rp)
                             :far-point (far-point rp)
                             :near-angle (near-angle rp)
                             :far-angle (far-angle rp)
                             :delta-heading delta-heading)
              (* *weight* *spew-rate*)))

    (format t "~%~5,2F~A" (* *macro-cycs* *secs-per-mcyc*) #\tab)
    (princ-road-view *rv*)
)


;; Suppress previous road positions.

(p@ lh-spatial suppress-old-road-position ((rp1 road-position)
                                           (rp2 road-position)
                                           (rp3 road-position))
    (far-angle rp1)
    (far-angle rp2)
    (more-recent-state-p rp1 rp2)
    (more-recent-state-p rp2 rp3)
-->
    (spew t rp3 (- (* *weight* *spew-rate*)))
)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (8) The RH-Spatial Center.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; General Executive model productions.
;;;


;; Suppress operators if...

;;; ...they are not selected.
(p@ rh-spatial suppress-unpreferred-operator ((pop preferred-operator)
                                              (op1 operator)
                                              (op2 operator))
    (equal (operator pop) op1)
    (not-equal op1 op2)
    (equal (state op1) (state op2))
    (*no ((~pop preferred-operator))
      (> (id ~pop) (id pop)))
    (*no ((~pop preferred-operator))
      (equal (operator ~pop) op2))
-->
    (spew t op2 (- (* *weight* *spew-rate*)))
)

;;; ...they are selected and performed successfully.
(p@ rh-spatial suppress-performed-preferred-operator ((pop preferred-operator)
                                                      (op operator)
                                                      (bs state)
                                                      (as state))
    (equal (operator pop) op)
    (equal (state op) bs)
    (contents-equal (perform-operator op bs) (contents as))
-->
    (spew t op (- (* *weight* *spew-rate*)))
)

;;; ...they cannot be performed, causing an impasse (which leads to a goal
;;; to resolve the impasse).
(p@ rh-spatial suppress-preempted-preferred-operator ((g goal)
                                                      (pop preferred-operator)
                                                      (op operator))
    (equals (operator g) (operator pop) op)
-->
    (spew t op (- (* *weight* *spew-rate*)))
)


;;;
;;; Driving model productions.
;;;


;; Attending points.

(p@ rh-spatial attend-near-point ((g control-perceive-goal)
                                  (rp road-position))
    (id g)
    (id rp)
    (*always (not (near-point rp)))
    (*no ((~g goal))
      (more-recent-goal-p ~g g))
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~anp attend-near-point))
      (equal (state ~anp) rp))
    (*no ((~pop preferred-operator))
      (equal (state (operator ~pop)) rp))
-->
    (spew t (attend-near-point :state rp)
            (* *weight* *spew-rate*))
)

(p@ rh-spatial attend-far-point ((g control-perceive-goal)
                                 (rp road-position))
    (id g)
    (near-point rp)
    (*always (not (far-point rp)))
    (*no ((~g goal))
      (more-recent-goal-p ~g g))
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~afp attend-far-point))
      (equal (state ~afp) rp))
    (*no ((~pop preferred-operator))
      (equal (state (operator ~pop)) rp))
-->
    (spew t (attend-far-point :state rp)
            (* *weight* *spew-rate*))
)


;; Computing angles.

(p@ rh-spatial compute-angles ((g control-perceive-goal)
                               (rp road-position))
    (id g)
    (near-point rp)
    (far-point rp)
    (*always (not (near-angle rp)))
    (*no ((~g goal))
      (more-recent-goal-p ~g g))
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~ca compute-angles))
      (equal (state ~ca) rp))
    (*no ((~pop preferred-operator))
      (equal (state (operator ~pop)) rp))
-->
    (spew t (compute-angles :state rp)
            (* *weight* *spew-rate*))
)


;; Computing heading.

(p@ rh-spatial compute-delta-heading ((g control-steering-goal)
                                      (rp road-position))
    (id g)
    (id rp)
    (*always (not (delta-heading rp)))
    (*no ((~g goal))
      (more-recent-goal-p ~g g))
    (*no ((~rp road-position))
      (more-recent-state-p ~rp rp))
    (*no ((~cdh compute-delta-heading))
      (equal (state ~cdh) rp))
    (*no ((~pop preferred-operator))
      (equal (state (operator ~pop)) rp))
-->
    (spew t (compute-delta-heading :state rp)
            (* *weight* *spew-rate*))
)


;; Suppress previous road positions.

(p@ lh-spatial suppress-old-operator ((po perceptual-operator))
    (id po)
    (*no ((~rp road-position))
      (equal ~rp (state po)))
-->
    (spew t po (- (* *weight* *spew-rate*)))
)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; (9) Support Code.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;
;;; Top-level commands for running batch simulations.
;;;


;; Top-level command that prints a useful summary of the results of a driving
;; simulation.

(when (and (boundp '*dual-task*) *dual-task*)
  (fmakunbound 'summ)
  (fmakunbound 'impl-summ))

(defmacro summ ()
  `(impl-summ))

(defun impl-summ ()
  (format t "~&")
  (history@ (lh-executive rh-executive lh-spatial rh-spatial)
            :combination avg
            :measure prop)
  (values))


;; Initialize the model immediately prior to running a simulation.

(defun initialize-driving-model (time)
  (spew t (drive-goal)
          *weight*)
  (spew t (control-perceive-goal)
          *weight*)
  (spew t (road-position :pos-x (pos-x *rv*)
                         :timestamp 0)
          *weight*)
  (spew t (end-road-position :pos-x (* *feet-per-second* time))
          *weight*)
  (values))


;; Top-level command for running a driving simulation in an easy way.
;;
;; The :RV keyword argument is an object of class ROAD-VIEW specifying
;; the driving environment to be traversed.  It defaults to the one that
;; CCBI participants drive.
;;
;; The :TIME keyword argument is the duration of driving.  It defaults to
;; the 60 s CCBI participants spend-driving.

(when (and (boundp '*dual-task*) *dual-task*)
  ;; Assume defined in the Sentence Comprehension Model.  Explicitly undefine
  ;; them so that when they are redefined for the Driving model, warnings are
  ;; not issued to the user.
  (fmakunbound 'sim)
  (fmakunbound 'impl-sim)
  )

(defmacro sim (&rest args)
  `(impl-sim ,@args))

(defun impl-sim (&key (rv *ccbi-rv*) (time 60))
  (reset)
  (let ((*rv* rv)
        (total-mcycs (truncate time *secs-per-mcyc*))
        (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)
    (format t "~&TIME")
    (dotimes (i total-mcycs)
      (run 1)
      (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*))
    (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 mcycs)"
          (* *macro-cycs* *secs-per-mcyc*)
          *macro-cycs*)
  (summ)
  (values))


;; Evaluate these model simulations.

#|
;;; Drive the CCBI road for 60 sec.
(sim)

;;; Drive the easy sinsuoidal road for 15 sec.
(sim :rv *easy-rv* :time 15)

;;; Drive the medium sinsuoidal road for 15 sec.
(sim :rv *medium-rv* :time 15)

;;; Drive the hard sinsuoidal road for 15 sec.
(sim :rv *hard-rv* :time 15)

;;; Drive the CCBI road for 15 sec.
(sim :time 15)
|#