;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>

;;;
;;;  Word Problem Solving Model
;;;  for "Atomic Components of Thought"
;;;  Dario Salvucci & John Anderson
;;;

;;; ACT-R 4.0 model
;;; to run the model call:
;;; (physdl-initialize-variables)
;;; then
;;; (physdl-run)

;;;=========================================================================================
;;;
;;;  Model Interface Code (bypasses visual interface)
;;;

(defvar *physdl-action-trace* nil)
(defvar *physdl-action-traces* nil)
(defvar *physdl-stimuli* nil)
(defvar *physdl-mouse-loc* nil)
(defvar *physdl-short-move-latency* 0.3)
(defvar *physdl-long-move-latency* 0.8)
(defvar *physdl-long-move-threshold* 50)
(defvar *physdl-short-attend-latency* 0)
(defvar *physdl-long-attend-latency* 1.0)
(defvar *physdl-type-latency* 1.0)

(defparameter *physdl-pos2str-mappings*
  #((20 20) (0 0) (130 20) (20 50) (0 0) (130 50) (20 80) (0 0) (130 80)
    (20 120) (130 120) (150 120) (170 120) (190 120) (210 120) (230 120)
    (130 150) (150 150) (170 150) (190 150) (210 150) (230 150)
    (270 20) (0 0) (380 20) (270 50) (0 0) (380 50) (270 80) (0 0) (380 80)
    (270 120)))

(defparameter *physdl-loc-names*
  #("SP Quantity 1" nil "SP Value 1"
    "SP Quantity 2" nil "SP Value 2"
    "SP Quantity 3" nil "SP Value 3"
    "Problem Type"
    "S1 Item 1" "S1 Item 2" "S1 Item 3" "S1 Item 4" "S1 Item 5" "S1 Item 6"
    "S2 Item 1" "S2 Item 2" "S2 Item 3" "S2 Item 4" "S2 Item 5" "S2 Item 6"
    "TP Quantity 1" nil "TP Value 1"
    "TP Quantity 2" nil "TP Value 2"
    "TP Quantity 3" nil "TP Value 3"
    "Problem Type"))

(defparameter *physdl-pc-stimuli*
      '(
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "a" "/" "s" "" "" ""
         "9" "/" "7" "" "" "" "spacing" "=" "5" "area" "=" "8" "" "" "" "capacitance")
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "a" "/" "s" "" "" ""
         "9" "/" "7" "" "" "" "spacing" "=" "9" "area" "=" "2" "" "" "" "capacitance")
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "a" "/" "s" "" "" ""
         "9" "/" "7" "" "" "" "area" "=" "6" "spacing" "=" "1" "" "" "" "capacitance")
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "a" "/" "s" "" "" ""
         "9" "/" "7" "" "" "" "spacing" "=" "7" "area" "=" "5" "" "" "" "capacitance")
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "a" "/" "s" "" "" ""
         "9" "/" "7" "" "" "" "area" "=" "5" "spacing" "=" "4" "" "" "" "capacitance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "t" "/" "m" "" "" ""
         "8" "/" "3" "" "" "" "thickness" "=" "9" "mass" "=" "6" "" "" "" "resistance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "t" "/" "m" "" "" ""
         "8" "/" "3" "" "" "" "mass" "=" "7" "thickness" "=" "2" "" "" "" "resistance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "t" "/" "m" "" "" ""
         "8" "/" "3" "" "" "" "mass" "=" "3" "thickness" "=" "5" "" "" "" "resistance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "t" "/" "m" "" "" ""
         "8" "/" "3" "" "" "" "thickness" "=" "4" "mass" "=" "9" "" "" "" "resistance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "t" "/" "m" "" "" ""
         "8" "/" "3" "" "" "" "mass" "=" "1" "thickness" "=" "8" "" "" "" "resistance")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "L" "/" "f" "" "" ""
         "5" "/" "9" "" "" "" "factor" "=" "5" "length" "=" "4" "" "" "" "new-length")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "L" "/" "f" "" "" ""
         "5" "/" "9" "" "" "" "length" "=" "6" "factor" "=" "8" "" "" "" "new-length")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "L" "/" "f" "" "" ""
         "5" "/" "9" "" "" "" "factor" "=" "3" "length" "=" "4" "" "" "" "new-length")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "L" "/" "f" "" "" ""
         "5" "/" "9" "" "" "" "length" "=" "1" "factor" "=" "5" "" "" "" "new-length")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "L" "/" "f" "" "" ""
         "5" "/" "9" "" "" "" "factor" "=" "3" "length" "=" "8" "" "" "" "new-length")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "c" "*" "d" "" ""
         "-" "4" "*" "7" "" "" "distance" "=" "6" "constant" "=" "9" "" "" "" "force")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "c" "*" "d" "" ""
         "-" "4" "*" "7" "" "" "distance" "=" "3" "constant" "=" "5" "" "" "" "force")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "c" "*" "d" "" ""
         "-" "4" "*" "7" "" "" "constant" "=" "4" "distance" "=" "9" "" "" "" "force")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "c" "*" "d" "" ""
         "-" "4" "*" "7" "" "" "distance" "=" "2" "constant" "=" "7" "" "" "" "force")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "c" "*" "d" "" ""
         "-" "4" "*" "7" "" "" "constant" "=" "1" "distance" "=" "8" "" "" "" "force")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "3" "" "" "" "" "" "" "velocity")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "7" "" "" "" "" "" "" "velocity")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "2" "" "" "" "" "" "" "velocity")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "9" "" "" "" "" "" "" "velocity")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "6" "" "" "" "" "" "" "velocity")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "n" "*" "w" "/" "s" "a"
         "2" "*" "7" "/" "s" "5" "wavelength" "=" "7" "number" "=" "1" "angle" "=" "9" "width")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "n" "*" "w" "/" "s" "a"
         "2" "*" "7" "/" "s" "5" "number" "=" "2" "angle" "=" "6" "wavelength" "=" "5" "width")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "n" "*" "w" "/" "s" "a"
         "2" "*" "7" "/" "s" "5" "wavelength" "=" "4" "number" "=" "3" "angle" "=" "8" "width")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "n" "*" "w" "/" "s" "a"
         "2" "*" "7" "/" "s" "5" "number" "=" "9" "angle" "=" "5" "wavelength" "=" "6" "width")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "n" "*" "w" "/" "s" "a"
         "2" "*" "7" "/" "s" "5" "wavelength" "=" "3" "number" "=" "7" "angle" "=" "8" "width")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "t" "/" "p" ""
         "r" "*" "7" "/" "4" "" "pressure" "=" "6" "temperature" "=" "3" "" "" "" "volume")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "t" "/" "p" ""
         "r" "*" "7" "/" "4" "" "temperature" "=" "9" "pressure" "=" "7" "" "" "" "volume")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "t" "/" "p" ""
         "r" "*" "7" "/" "4" "" "pressure" "=" "4" "temperature" "=" "3" "" "" "" "volume")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "t" "/" "p" ""
         "r" "*" "7" "/" "4" "" "temperature" "=" "6" "pressure" "=" "2" "" "" "" "volume")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "t" "/" "p" ""
         "r" "*" "7" "/" "4" "" "pressure" "=" "1" "temperature" "=" "7" "" "" "" "volume")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "n" "*" "f" "/" "c" ""
         "9" "*" "4" "/" "2" "" "current" "=" "3" "number" "=" "2" "flux" "=" "5" "inductance")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "n" "*" "f" "/" "c" ""
         "9" "*" "4" "/" "2" "" "number" "=" "7" "current" "=" "2" "flux" "=" "3" "inductance")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "n" "*" "f" "/" "c" ""
         "9" "*" "4" "/" "2" "" "current" "=" "3" "flux" "=" "8" "number" "=" "1" "inductance")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "n" "*" "f" "/" "c" ""
         "9" "*" "4" "/" "2" "" "flux" "=" "9" "current" "=" "7" "number" "=" "4" "inductance")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "n" "*" "f" "/" "c" ""
         "9" "*" "4" "/" "2" "" "current" "=" "5" "number" "=" "1" "flux" "=" "3" "inductance")
        ))

(defparameter *physdl-nc-stimuli*
      '(
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "s" "/" "a" "" "" ""
         "9" "/" "7" "" "" "" "spacing" "=" "5" "area" "=" "8" "" "" "" "capacitance")
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "s" "/" "a" "" "" ""
         "9" "/" "7" "" "" "" "spacing" "=" "9" "area" "=" "2" "" "" "" "capacitance")
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "s" "/" "a" "" "" ""
         "9" "/" "7" "" "" "" "area" "=" "6" "spacing" "=" "1" "" "" "" "capacitance")
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "s" "/" "a" "" "" ""
         "9" "/" "7" "" "" "" "spacing" "=" "7" "area" "=" "5" "" "" "" "capacitance")
        ("area" "=" "9" "spacing" "=" "7" "" "" "" "capacitance" "s" "/" "a" "" "" ""
         "9" "/" "7" "" "" "" "area" "=" "5" "spacing" "=" "4" "" "" "" "capacitance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "m" "/" "t" "" "" ""
         "8" "/" "3" "" "" "" "thickness" "=" "9" "mass" "=" "6" "" "" "" "resistance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "m" "/" "t" "" "" ""
         "8" "/" "3" "" "" "" "mass" "=" "7" "thickness" "=" "2" "" "" "" "resistance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "m" "/" "t" "" "" ""
         "8" "/" "3" "" "" "" "mass" "=" "3" "thickness" "=" "5" "" "" "" "resistance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "m" "/" "t" "" "" ""
         "8" "/" "3" "" "" "" "thickness" "=" "4" "mass" "=" "9" "" "" "" "resistance")
        ("thickness" "=" "8" "mass" "=" "3" "" "" "" "resistance" "m" "/" "t" "" "" ""
         "8" "/" "3" "" "" "" "mass" "=" "1" "thickness" "=" "8" "" "" "" "resistance")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "f" "/" "L" "" "" ""
         "5" "/" "9" "" "" "" "factor" "=" "5" "length" "=" "4" "" "" "" "new-length")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "f" "/" "L" "" "" ""
         "5" "/" "9" "" "" "" "length" "=" "6" "factor" "=" "8" "" "" "" "new-length")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "f" "/" "L" "" "" ""
         "5" "/" "9" "" "" "" "factor" "=" "3" "length" "=" "4" "" "" "" "new-length")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "f" "/" "L" "" "" ""
         "5" "/" "9" "" "" "" "length" "=" "1" "factor" "=" "5" "" "" "" "new-length")
        ("length" "=" "5" "factor" "=" "9" "" "" "" "new-length" "f" "/" "L" "" "" ""
         "5" "/" "9" "" "" "" "factor" "=" "3" "length" "=" "8" "" "" "" "new-length")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "d" "*" "c" "" ""
         "-" "4" "*" "7" "" "" "distance" "=" "6" "constant" "=" "9" "" "" "" "force")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "d" "*" "c" "" ""
         "-" "4" "*" "7" "" "" "distance" "=" "3" "constant" "=" "5" "" "" "" "force")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "d" "*" "c" "" ""
         "-" "4" "*" "7" "" "" "constant" "=" "4" "distance" "=" "9" "" "" "" "force")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "d" "*" "c" "" ""
         "-" "4" "*" "7" "" "" "distance" "=" "2" "constant" "=" "7" "" "" "" "force")
        ("constant" "=" "4" "distance" "=" "7" "" "" "" "force" "-" "d" "*" "c" "" ""
         "-" "4" "*" "7" "" "" "constant" "=" "1" "distance" "=" "8" "" "" "" "force")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "3" "" "" "" "" "" "" "velocity")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "7" "" "" "" "" "" "" "velocity")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "2" "" "" "" "" "" "" "velocity")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "9" "" "" "" "" "" "" "velocity")
        ("index" "=" "5" "" "" "" "" "" "" "velocity" "c" "/" "i" "" "" ""
         "c" "/" "5" "" "" "" "index" "=" "6" "" "" "" "" "" "" "velocity")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "w" "*" "a" "/" "s" "n"
         "2" "*" "7" "/" "s" "5" "wavelength" "=" "7" "number" "=" "1" "angle" "=" "9" "width")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "w" "*" "a" "/" "s" "n"
         "2" "*" "7" "/" "s" "5" "number" "=" "2" "angle" "=" "6" "wavelength" "=" "5" "width")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "w" "*" "a" "/" "s" "n"
         "2" "*" "7" "/" "s" "5" "wavelength" "=" "4" "number" "=" "3" "angle" "=" "8" "width")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "w" "*" "a" "/" "s" "n"
         "2" "*" "7" "/" "s" "5" "number" "=" "9" "angle" "=" "5" "wavelength" "=" "6" "width")
        ("number" "=" "2" "angle" "=" "5" "wavelength" "=" "7" "width" "w" "*" "a" "/" "s" "n"
         "2" "*" "7" "/" "s" "5" "wavelength" "=" "3" "number" "=" "7" "angle" "=" "8" "width")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "p" "/" "t" ""
         "r" "*" "7" "/" "4" "" "pressure" "=" "6" "temperature" "=" "3" "" "" "" "volume")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "p" "/" "t" ""
         "r" "*" "7" "/" "4" "" "temperature" "=" "9" "pressure" "=" "7" "" "" "" "volume")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "p" "/" "t" ""
         "r" "*" "7" "/" "4" "" "pressure" "=" "4" "temperature" "=" "3" "" "" "" "volume")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "p" "/" "t" ""
         "r" "*" "7" "/" "4" "" "temperature" "=" "6" "pressure" "=" "2" "" "" "" "volume")
        ("pressure" "=" "4" "temperature" "=" "7" "" "" "" "volume" "r" "*" "p" "/" "t" ""
         "r" "*" "7" "/" "4" "" "pressure" "=" "1" "temperature" "=" "7" "" "" "" "volume")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "c" "*" "n" "/" "f" ""
         "9" "*" "4" "/" "2" "" "current" "=" "3" "number" "=" "2" "flux" "=" "5" "inductance")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "c" "*" "n" "/" "f" ""
         "9" "*" "4" "/" "2" "" "number" "=" "7" "current" "=" "2" "flux" "=" "3" "inductance")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "c" "*" "n" "/" "f" ""
         "9" "*" "4" "/" "2" "" "current" "=" "3" "flux" "=" "8" "number" "=" "1" "inductance")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "c" "*" "n" "/" "f" ""
         "9" "*" "4" "/" "2" "" "flux" "=" "9" "current" "=" "7" "number" "=" "4" "inductance")
        ("flux" "=" "4" "number" "=" "9" "current" "=" "2" "inductance" "c" "*" "n" "/" "f" ""
         "9" "*" "4" "/" "2" "" "current" "=" "5" "number" "=" "1" "flux" "=" "3" "inductance")
        ))

;;;
;;;  Utility Routines
;;;

(defun physdl-loc-dist (loc1 loc2)
  (let ((dx (- (first loc1) (first loc2)))
        (dy (- (second loc1) (second loc2))))
    (isqrt (+ (* dx dx) (* dy dy)))))

(defun physdl-get-location-value (location)
  (when *physdl-stimuli*
    (let* ((value (elt (car *physdl-stimuli*)
                       (position location *physdl-pos2str-mappings* :test #'equalp))))
      (unless (equal value "") value))))

(defun physdl-get-location-name (location)
  (let* ((pos (position location *physdl-pos2str-mappings* :test #'equalp)))
    (elt *physdl-loc-names* pos)))

(defun physdl-prefix-p (prefix string)
  (if (<= (length prefix) (length string))
      (string= prefix string :end1 (length prefix) :end2 (length prefix))
      nil))

(defun physdl-average-lists (lsts)
  (when lsts
    (apply #'mapcar (cons #'(lambda (&rest args)
                              (if (null args) 0 (/ (apply #'+ args) (length args))))
                          lsts))))

;;;
;;;  Model Routines
;;;

(defun physdl-find-location (&key attended nearest value isa screen-x screen-y feat)
  (declare (ignore attended nearest value isa feat))
  (let ((location (list screen-x screen-y)))
    (if (physdl-get-location-value location) location)))

(defun physdl-move-attention (&key location scale)
  (declare (ignore scale))
  (if (member location '((20 20) (20 50) (20 80)) :test #'equalp)
      (actr-time-fct *physdl-long-attend-latency*)
      (actr-time-fct *physdl-short-attend-latency*))
  (let ((value (physdl-get-location-value location)))
    (if value
        (let ((gen (read-from-string (string (gensym "word")))))
          (eval `(add-dm (,gen isa visual-object value ,value screen-pos ,location)))
          (get-wme gen))
        (get-wme 'nothing))))

(defun physdl-move-mouse (location)
  (if (>= (physdl-loc-dist *physdl-mouse-loc* location) *physdl-long-move-threshold*)
      (actr-time-fct *physdl-long-move-latency*)
      (actr-time-fct *physdl-short-move-latency*))
  (setf *physdl-mouse-loc* location))

(defun physdl-click-mouse (&optional location)
  (let* ((loc (if location location *physdl-mouse-loc*)))
    (if (equalp loc '(400 150))
        (progn
          (push (list 'done (actr-time-fct))
                *physdl-action-trace*)
          (setf *physdl-stimuli* (cdr *physdl-stimuli*)))
        (push (list 'click (actr-time-fct) (physdl-get-location-name loc)
                    (physdl-get-location-value loc))
              *physdl-action-trace*))))

(defun physdl-press-key (key)
  (actr-time-fct *physdl-type-latency*)
  (push (list 'type (actr-time-fct) (format nil "~a" key))
        *physdl-action-trace*))

(defun physdl-record-epiphany ()
  (push (list 'epiphany (actr-time-fct))
        *physdl-action-trace*))

;;;
;;;  Main Routines
;;;

(defun physdl-experiment (&optional (condition 'pc))
  (setq *physdl-mouse-loc* '(0 0))
  (setq *physdl-stimuli*  (case condition
                               (pc *physdl-pc-stimuli*) (nc *physdl-nc-stimuli*)))
  nil)

(defun physdl-use-every (n lst)
  (let ((ue-lst nil))
    (do ((i 1 (if (= i n) 1 (1+ i)))
         (ilst lst (cdr ilst)))
        ((null ilst) (reverse ue-lst))
      (when (= i n) (push (car ilst) ue-lst)))))

(defun physdl-set-latencies ()
  (physdl-average-lists
   (mapcar #'(lambda (trace)
               (let* ((dones (remove-if-not #'(lambda (a) (equalp 'done (first a))) trace))
                      (set-dones (physdl-use-every 5 dones))
                      (times (mapcar #'second set-dones)))
                 (mapcar #'- times (cons 0 times))))
           *physdl-action-traces*)))

(defun physdl-set-correct ()
  (physdl-average-lists
   (mapcar #'(lambda (trace)
               (let* ((epilist (remove-if-not #'(lambda (a) (equalp 'epiphany (first a))) trace))
                      (dones (remove-if-not #'(lambda (a) (equalp 'done (first a))) trace))
                      (set-dones (physdl-use-every 5 dones))
                      (times (mapcar #'second set-dones)))
                 (if epilist
                     (let ((epi-time (second (first epilist)))
                           (res nil))
                       (dolist (time times (reverse res))
                         (push (if (< epi-time time) 1 0) res)))
                     '(1 1 1 1 1 1 1 1))))
           *physdl-action-traces*)))

;;;=========================================================
;;;
;;;  Web Interface
;;;

(defvar *physdl-base-level-decay* 0.5)
(defvar *physdl-strength-decay* 0.5)
(defvar *physdl-activation-noise* 0.1)
(defvar *physdl-gain-noise* 0.2)
(defvar *physdl-pc-condition* t)
(defvar *physdl-nruns* 1)
(defvar *physdl-acttrace* nil)
(defvar *physdl-ct* nil)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)

(defparameter *physdl-observed-setlats* '((143.23 90.76 79.78 102.40 72.12 184.58 101.29 114.19)
                                              (172.54 98.84 84.99 116.73 71.87 188.80 119.33 125.22)))
(defparameter *physdl-reported-setlats* '((149.95 92.29 81.45 85.04 67.24 121.76 92.15 100.04)
                                              (144.37 97.44 94.55 85.24 67.91 129.19 109.65 114.21)))
(defparameter *physdl-observed-correct* '((0.92 0.99 0.94 0.97 0.98 0.78 0.95 0.99)
                                              (0.57 0.65 0.81 0.71 0.99 0.83 0.87 0.86)))
(defparameter *physdl-reported-correct* '((1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)
                                              (0.40 0.40 0.70 0.80 0.80 0.90 1.00 1.00)))

(defparameter *physdl-all-exp-data* '(((143.23 90.76 79.78 102.40 72.12 184.58 101.29 114.19)
                                          (0.92 0.99 0.94 0.97 0.98 0.78 0.95 0.99))
                                         ((172.54 98.84 84.99 116.73 71.87 188.80 119.33 125.22)
                                          (0.57 0.65 0.81 0.71 0.99 0.83 0.87 0.86))))

(defun physdl-output-tables (data sim)
  (format *standard-output* "~A results in the PC and NC conditions.~%~%" (if sim "Model" "Experiment"))
  (let ((pc (first (first data)))
        (nc (first (second data))))
    (format *standard-output* "Set Latencies:~%~%")
    (format *standard-output* "  Set                1       2       3       4       5       6       7       8~%")
    (format *standard-output* "  ------------------------------------------------------------------------------~%")
    (format *standard-output* "  PC Condition: ")
    (dolist (x pc) (format *standard-output* "~8,2f" x))
    (format *standard-output* "~%  NC Condition: ")
    (dolist (x nc) (format *standard-output* "~8,2f" x))
    (format *standard-output* "~%~%~%"))
  (let ((pc (second (first data)))
        (nc (second (second data))))
    (format *standard-output* "Set Correctness:~%~%")
    (format *standard-output* "  Set               1      2      3      4      5      6      7      8~%")
    (format *standard-output* "  ----------------------------------------------------------------------~%")
    (format *standard-output* "  PC Condition: ")
    (dolist (x pc) (format *standard-output* "~7,2f" x))
    (format *standard-output* "~%  NC Condition: ")
    (dolist (x nc) (format *standard-output* "~7,2f" x))
    (format *standard-output* "~%~%~%")))

(defun physdl-output-action-trace ()
  (format *standard-output* "Action Trace:~%~%")
  (when (> *physdl-nruns* 1)
    (format *standard-output* "(Note: This trace represents the first of the ~a simulations).~%~%"
            *physdl-nruns*))
  (dolist (a (first *physdl-action-traces*))
    (let ((s *standard-output*))
      (case (first a)
        (click (format s "  (click ~,2f \"~a\" \"~a\")~%" (second a) (third a) (fourth a)))
        (type  (format s "  (type  ~,2f \"~a\")~%" (second a) (third a)))
        (done  (format s "  (done  ~,2f)~%~%" (second a)))
        (epiphany  (format s "  (epiphany  ~,2f)~%~%" (second a)))
        (t     nil))))
  (format *standard-output* "~%~%"))

(defun physdl-run ()
  (let ((pc-results nil)
        (nc-results nil))
    (unless (<= *physdl-nruns* 3)
      (format *standard-output* "Sorry, server can only execute 3 simulations.~%"))
    (when (<= *physdl-nruns* 3)
      (setf *physdl-action-traces* nil)
      (setf *physdl-pc-condition* t)
      (dotimes (n *physdl-nruns*)
        (reset)

        (physdl-experiment 'pc)
        (sgp-fct (list :sl *physdl-strength-decay*))
        (mod-chunk goal first t)

        (sgp-fct (list :bll *physdl-base-level-decay*  :an *physdl-activation-noise*
                       :egn *physdl-gain-noise*        :v  *physdl-ct*
                       :ct  *physdl-ct*))
        (setf *physdl-action-trace* nil)
        (run)
        (setf *physdl-action-trace* (reverse *physdl-action-trace*))
        (push *physdl-action-trace* *physdl-action-traces*))

      (when *physdl-acttrace* (physdl-output-action-trace))

      (setf pc-results (list (physdl-set-latencies) (physdl-set-correct)))

      (setf *physdl-action-traces* nil)
      (setf *physdl-pc-condition* nil)
      (dotimes (n *physdl-nruns*)
        (reset)

        (physdl-experiment 'nc)
        (sgp-fct (list :sl *physdl-strength-decay*))
        (mod-chunk goal first t)
        
        (sgp-fct (list :bll *physdl-base-level-decay*  :an *physdl-activation-noise*
                       :egn *physdl-gain-noise*        :v  *physdl-ct*
                       :ct  *physdl-ct*))
        (setf *physdl-action-trace* nil)
        (run)
        (setf *physdl-action-trace* (reverse *physdl-action-trace*))
        (push *physdl-action-trace* *physdl-action-traces*))
      (when *physdl-acttrace* (physdl-output-action-trace))

      (setf nc-results (list (physdl-set-latencies) (physdl-set-correct)))

      (physdl-output-tables (list pc-results nc-results) t))))

(defvar *www-interface*)
(setf *WWW-interface*
      '((:heading "Physics Declarative Learning Model" 2)
        (:table)
          (:table)
            "Base-level decay: "      (:string :sy *physdl-base-level-decay* 0.5) (:new-row)
            "Strength decay: "        (:string :sy *physdl-strength-decay*   0.5) (:new-row)
            "Activation noise: "      (:string :sy *physdl-activation-noise* 0.1) (:new-row)
            "Expected gain noise: "   (:string :sy *physdl-gain-noise*       0.2)

          (:table-end)
          (:table)
            ;(:checkbox "Trace model"   :sy *physdl-ct*        nil)  (:new-row)
            ;(:checkbox "Trace actions"          :sy *physdl-acttrace*  nil) (:new-row)
            (:checkbox "Text output" :sy *text*  t) (:new-row)
            (:checkbox "Graphic output" :sy *graphic*  nil) (:new-row)
            (:checkbox "Show simulation and experiment data on same graph" :sy *overlay*  nil)
      (:table-end)
        (:table-end)
        (:new-para)
        (:button "Show Experiment Results" "(physdl-output-tables *physdl-all-exp-data* nil)")
        (:new-para)
        (:button "Run model" "(if (and (numberp *physdl-base-level-decay*) (numberp *physdl-strength-decay*)
                                  (numberp *physdl-activation-noise*)
                                  (numberp *physdl-gain-noise*) (numberp *physdl-nruns*))
                                     (progn (physdl-initialize-variables)

                                        (physdl-run))
                                     (format *standard-output* \"All parameters must be numbers~%\"))")

        (:reset "Default values")
        (:button "Production rules" "(let ((prods (no-output (pp))))
                                       (dolist (x prods)
                                         (pp-fct (list x))
                                         (spp-fct (list x))
                                         (format *standard-output* \"~%\")))")
        (:button "Chunk types" "(chunk-type)")
        (:button "Chunks" "(dm)")
        (:new-para)
        "TIME and SIZE:"
        (:new-para)
        "- It usually takes about 2 minutes for a model simulation."
        (:new-line)
        "- The model trace of 1 run is approximately 95k (50 pages) in size."
        (:new-line)
        "- The cycle trace of 1 run is approximately 5k (3 pages) in size."
        (:new-para)
        ))

(defun physdl-initialize-variables ()
  (setf *physdl-action-trace* nil)
  (setf *physdl-action-traces* nil)
  (setf *physdl-stimuli* nil)
  (setf *physdl-mouse-loc* nil)
  (setf *physdl-short-move-latency* 0.3)
  (setf *physdl-long-move-latency* 0.8)
  (setf *physdl-long-move-threshold* 50)
  (setf *physdl-short-attend-latency* 0)
  (setf *physdl-long-attend-latency* 1.0)
  (setf *physdl-type-latency* 1.0))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;;=========================================================
;;;
;;;  ACT-R Model
;;;
;;;  works like old visual interface, not ACT-R/PM
;;;

(clear-all)

(sgp :era t
     :bll 0.5
     :er t
     :ct nil
     :lt nil
     :cst nil
     :act nil
     :an 0.1
     :egn 0.2
)

(setf *optimize-visual* t)
(setf *actr-enabled-p* t)

;;;=========================================================
;;;
;;;  BASICS
;;;
;;;=========================================================

(chunk-type visual-object screen-pos value status)
(chunk-type abstract-object value line-pos bin-pos)
(chunk-type (abstract-letter (:include abstract-object)))
(chunk-type (abstract-number (:include abstract-object)))

(chunk-type method)
(chunk-type current-method method)

(chunk-type object string type)
(chunk-type (quantity (:include object)) letter)
(chunk-type (variable (:include object)))
(chunk-type (integer (:include object)) value next)
(chunk-type (operator (:include object)))

(chunk-type area)

(add-dm

 (t isa chunk)
 (done isa chunk)
 (success isa chunk)
 (failure isa chunk)
 (correct isa chunk)
 (incorrect isa chunk)
 (covered isa chunk)
 (uncovered isa chunk)
 (quantity isa chunk)
 (nothing isa chunk)
 (result isa chunk)
 (variable isa chunk)
 (integer isa chunk)
 (operator isa chunk)

 (solve-by-variable isa method)
 (solve-by-value isa method)
 (current-method isa current-method method solve-by-variable)

 (angle isa quantity letter a string "angle" type quantity)
 (area isa quantity letter a string "area" type quantity)
 (capacitance isa quantity letter c string "capacitance" type quantity)
 (constant isa quantity letter c string "constant" type quantity)
 (current isa quantity letter c string "current" type quantity)
 (distance isa quantity letter d string "distance" type quantity)
 (factor isa quantity letter f string "factor" type quantity)
 (flux isa quantity letter f string "flux" type quantity)
 (force isa quantity letter f string "force" type quantity)
 (index isa quantity letter i string "index" type quantity)
 (inductance isa quantity letter i string "inductance" type quantity)
 (length isa quantity letter l string "length" type quantity)
 (mass isa quantity letter m string "mass" type quantity)
 (new-length isa quantity letter n string "new-length" type quantity)
 (number isa quantity letter n string "number" type quantity)
 (pressure isa quantity letter pv string "pressure" type quantity)
 (resistance isa quantity letter r string "resistance" type quantity)
 (spacing isa quantity letter s string "spacing" type quantity)
 (temperature isa quantity letter tv string "temperature" type quantity)
 (thickness isa quantity letter tv string "thickness" type quantity)
 (velocity isa quantity letter v string "velocity" type quantity)
 (volume isa quantity letter v string "volume" type quantity)
 (wavelength isa quantity letter w string "wavelength" type quantity)
 (width isa quantity letter w string "width" type quantity)

 (a isa variable string "a" type variable)
 (c isa variable string "c" type variable)
 (d isa variable string "d" type variable)
 (f isa variable string "f" type variable)
 (i isa variable string "i" type variable)
 (l isa variable string "L" type variable)
 (m isa variable string "m" type variable)
 (n isa variable string "n" type variable)
 (pv isa variable string "p" type variable)
 (r isa variable string "r" type variable)
 (s isa variable string "s" type variable)
 (tv isa variable string "t" type variable)
 (v isa variable string "v" type variable)
 (w isa variable string "w" type variable)

 (type isa area)
 (sp isa area)
 (ss isa area)
 (tp isa area)
 (ts isa area)

 (i1 isa integer value 1 next i2 string "1" type integer)
 (i2 isa integer value 2 next i3 string "2" type integer)
 (i3 isa integer value 3 next i4 string "3" type integer)
 (i4 isa integer value 4 next i5 string "4" type integer)
 (i5 isa integer value 5 next i6 string "5" type integer)
 (i6 isa integer value 6 next i7 string "6" type integer)
 (i7 isa integer value 7 next i8 string "7" type integer)
 (i8 isa integer value 8 next i9 string "8" type integer)
 (i9 isa integer value 9 next nil string "9" type integer)

 (+ isa operator string "+" type operator)
 (- isa operator string "-" type operator)
 (* isa operator string "*" type operator)
 (/ isa operator string "/" type operator))

(sdp :references 1000.0)

;;;=========================================================
;;;
;;;  VISUAL INTERFACE
;;;
;;;=========================================================

(chunk-type word-position area row col x y cover)

(add-dm
 (type-1   isa word-position area type row i1 col i1 x 270 y 120 cover uncovered)
 (sp-qty1  isa word-position area sp row i1 col i1 x 20  y 20    cover covered)
 (sp-val1  isa word-position area sp row i1 col i2 x 130 y 20    cover uncovered)
 (sp-qty2  isa word-position area sp row i2 col i1 x 20  y 50    cover covered)
 (sp-val2  isa word-position area sp row i2 col i2 x 130 y 50    cover uncovered)
 (sp-qty3  isa word-position area sp row i3 col i1 x 20  y 80    cover covered)
 (sp-val3  isa word-position area sp row i3 col i2 x 130 y 80    cover uncovered)
 (s1q-pos1 isa word-position area ss row i1 col i1 x 130 y 120   cover covered)
 (s1o-pos2 isa word-position area ss row i1 col i2 x 150 y 120   cover covered)
 (s1q-pos3 isa word-position area ss row i1 col i3 x 170 y 120   cover covered)
 (s1o-pos4 isa word-position area ss row i1 col i4 x 190 y 120   cover covered)
 (s1q-pos5 isa word-position area ss row i1 col i5 x 210 y 120   cover covered)
 (s1-pos6  isa word-position area ss row i1 col i6 x 230 y 120   cover covered)
 (s2q-pos1 isa word-position area ss row i2 col i1 x 130 y 150   cover covered)
 (s2o-pos2 isa word-position area ss row i2 col i2 x 150 y 150   cover covered)
 (s2q-pos3 isa word-position area ss row i2 col i3 x 170 y 150   cover covered)
 (s2o-pos4 isa word-position area ss row i2 col i4 x 190 y 150   cover covered)
 (s2q-pos5 isa word-position area ss row i2 col i5 x 210 y 150   cover covered)
 (s2-pos6  isa word-position area ss row i2 col i6 x 230 y 150   cover covered)
 (tp-qty1  isa word-position area tp row i1 col i1 x 270 y 20    cover uncovered)
 (tp-val1  isa word-position area tp row i1 col i2 x 380 y 20    cover covered)
 (tp-qty2  isa word-position area tp row i2 col i1 x 270 y 50    cover uncovered)
 (tp-val2  isa word-position area tp row i2 col i2 x 380 y 50    cover covered)
 (tp-qty3  isa word-position area tp row i3 col i1 x 270 y 80    cover uncovered)
 (tp-val3  isa word-position area tp row i3 col i2 x 380 y 80    cover covered)
 (ts-ok    isa word-position area ts row i1 col i1 x 400 y 150   cover uncovered)
)

(sdp :references 1000.0)

(chunk-type read-screen-object area row col x y cover object string result result-type)
(chunk-type type-symbol symbol)
(chunk-type goto-next-screen)

(p retrieve-word-position
   =goal>
      isa read-screen-object
      area =area
      row =row
      col =col
      x nil
   =word-position>
      isa word-position
      area =area
      row =row
      col =col
      x =x
      y =y
      cover =cover
==>
   =goal>
      x =x
      y =y
      cover =cover)

(p read-screen-object-covered
   =goal>
      isa read-screen-object
      area =area
      row =row
      col =col
      x =x
      y =y
      cover covered
      object nil
   !bind! =loc (physdl-find-location :attended nil :screen-x =x :screen-y =y)
==>
   !eval! (physdl-move-mouse =loc)
   !eval! (physdl-click-mouse)
   !bind! =object (physdl-move-attention :location =loc :scale 'word)
   =goal>
      object =object)

(p read-screen-object-uncovered
   =goal>
      isa read-screen-object
      area =area
      row =row
      col =col
      x =x
      y =y
      cover uncovered
      object nil
   !bind! =loc (physdl-find-location :attended nil :screen-x =x :screen-y =y)
==>
   !bind! =object (physdl-move-attention :location =loc :scale 'word)
   =goal>
      object =object)

(p read-screen-object-attended-covered
   =goal>
      isa read-screen-object
      area =area
      row =row
      col =col
      x =x
      y =y
      cover covered
      object nil
   !bind! =loc (physdl-find-location :attended t :screen-x =x :screen-y =y)
==>
   !eval! (physdl-move-mouse =loc)
   !eval! (physdl-click-mouse)
   !bind! =object (physdl-move-attention :location =loc :scale 'word)
   =goal>
      object =object)

(p read-screen-object-attended-uncovered
   =goal>
      isa read-screen-object
      area =area
      row =row
      col =col
      x =x
      y =y
      cover uncovered
      object nil
   !bind! =loc (physdl-find-location :attended t :screen-x =x :screen-y =y)
==>
   !bind! =object (physdl-move-attention :location =loc :scale 'word)
   =goal>
      object =object)

(p read-screen-object-nothing
   =goal>
      isa read-screen-object
      object nil
==>
   =goal>
      result nothing
   !pop!)
(spp read-screen-object-nothing :r .3)

(p return-screen-object
   =goal>
      isa read-screen-object
      object =object
   =object>
      isa visual-object
      value =string
   =something>
      isa object
      string =string
      type =type
==>
   =goal>
      result =something
      result-type =type
   !pop!)
(spp return-screen-object :strength 10)

(p type-symbol
   =goal>
      isa type-symbol
      symbol =symbol
   =symbol>
      isa object
      string =string
==>
   !eval! (physdl-press-key =string)
   !pop!)
(spp type-symbol :strength 10)

(p goto-next-screen
   =goal>
      isa goto-next-screen
   =word-position>
      isa word-position
      area ts
      x =x
      y =y
==>
   !bind! =loc (list =x =y)
   !eval! (physdl-move-mouse =loc)
   !eval! (physdl-click-mouse)
   !pop!)

;;;=========================================================
;;;
;;;  ANALOGY HELPER PRODUCTIONS
;;;
;;;=========================================================

;=============================================================================
;;;
;;;  equation representation
;;;

(chunk-type equation type)
(chunk-type eqsym type equation pos value)

(p pop-equation
   =goal>
      isa equation
==>
   !pop!)

(p pop-eqsym
   =goal>
      isa eqsym
==>
   !pop!)

;=============================================================================
;;;
;;;  recall-or-create-equation
;;;

(chunk-type recall-or-create-equation type result)

(p subgoal-equation
   =goal>
      isa recall-or-create-equation
      type =type
      result nil
==>
   =equation>
      isa equation
      type =type
   =goal>
      result t
   !push! =equation)

(p return-equation
   =goal>
      isa recall-or-create-equation
      type =type
      result t
   =equation>
      isa equation
      type =type
==>
   =goal>
      result =equation
   !pop!)

;=============================================================================
;;;
;;;  read-problem-type
;;;

(chunk-type read-problem-type result)

(p subgoal-read-problem-type
   =goal>
      isa read-problem-type
      result nil
==>
   =subgoal1>
      isa read-screen-object
      area type
      row i1
      col i1
      result =result
   =goal>
      result =result
   !push! =subgoal1)

(p done-read-problem-type
   =goal>
      isa read-problem-type
      - result nil
==>
   !pop!)

;=============================================================================
;;;
;;;  read-problem-line
;;;

(chunk-type read-problem-line pos quantity value result)
(chunk-type problem-mapping quantity value)

(p read-problem-line-quantity
   =goal>
      isa read-problem-line
      pos =pos
      quantity nil
==>
   =subgoal1>
      isa read-screen-object
      area sp
      col i1
      row =pos
      result =result
   =goal>
      quantity =result
   !push! =subgoal1)

(p read-problem-line-value
   =goal>
      isa read-problem-line
      pos =pos
      value nil
==>
   =subgoal1>
      isa read-screen-object
      area sp
      col i2
      row =pos
      result =result
   =goal>
      value =result
   !push! =subgoal1)

(p return-problem-mapping
   =goal>
      isa read-problem-line
      quantity =quantity
      - quantity nothing
      value =value
      - value nothing
==>
   =problem-mapping>
      isa problem-mapping
      quantity =quantity
      value =value
   =goal>
      result =problem-mapping
   !pop!)

(p empty-problem-line
   =goal>
      isa read-problem-line
==>
   =goal>
      result done
   !pop!)
(spp empty-problem-line :r .5)

;=============================================================================
;;;
;;;  read-problem
;;;

(chunk-type read-problem pos mapping)

(p subgoal-read-problem-line
   =goal>
      isa read-problem
      pos =pos
      mapping nil
==>
   =subgoal1>
      isa read-problem-line
      pos =pos
      result =result
   =goal>
      mapping =result
   !push! =subgoal1)

(p read-next-problem-line
   =goal>
      isa read-problem
      pos =pos
      - mapping nil
      - mapping done
   =pos>
      isa integer
      next =next
==>
   =goal>
      pos =next
      mapping nil)

(p done-read-problem
   =goal>
      isa read-problem
      mapping done
==>
   !pop!)

;=============================================================================
;;;
;;;  find-sample-problem-quantity
;;;

(chunk-type find-sample-problem-quantity value pos symbol result)

(p subgoal-read-value
   =goal>
      isa find-sample-problem-quantity
      pos =pos
      symbol nil
==>
   =subgoal1>
      isa read-screen-object
      area sp
      row =pos
      col i2
      result =result
   =goal>
      symbol =result
   !push! =subgoal1)

(p found-value
   =goal>
      isa find-sample-problem-quantity
      value =value
      pos =pos
      - symbol nil
      symbol =value
      result nil
==>
   =subgoal1>
      isa read-screen-object
      area sp
      row =pos
      col i1
      result =result
   =goal>
      result =result
   !push! =subgoal1)

(p done-find-sample-problem-quantity
   =goal>
      isa find-sample-problem-quantity
      - result nil
==>
   !pop!)

(p value-not-found
   =goal>
      isa find-sample-problem-quantity
      value =value
      pos =pos
      - symbol nil
      - symbol =value
   =pos>
      isa integer
      next =next
==>
   =goal>
      pos =next
      symbol nil)

;=============================================================================
;;;
;;;  read-step1
;;;

(chunk-type read-step1 pos value)

(p subgoal-read-variable
   =goal>
      isa read-step1
      pos =pos
      value nil
==>
   =subgoal1>
      isa read-screen-object
      area ss
      row i1
      col =pos
      result =result
   =goal>
      value =result
   !push! =subgoal1)

(p read-next-variable
   =goal>
      isa read-step1
      pos =pos
      - value nil
      - value nothing
   =pos>
      isa integer
      next =next
==>
   =goal>
      pos =next
      value nil)

(p done-read-step1
   =goal>
      isa read-step1
      value nothing
==>
   !pop!)

;=============================================================================
;;;
;;;  find-same-letter-quantity
;;;

(chunk-type find-same-letter-quantity letter pos qletter result)

(p read-test-quantity
   =goal>
      isa find-same-letter-quantity
      pos =pos
      result nil
==>
   =subgoal1>
      isa read-screen-object
      area tp
      row =pos
      col i1
      result =result
   =goal>
      result =result
   !push! =subgoal1)

(p retrieve-quantity-letter
   =goal>
      isa find-same-letter-quantity
      qletter nil
      result =quantity
   =quantity>
      isa quantity
      letter =letter
==>
   =goal>
      qletter =letter)

(p found-quantity
   =goal>
      isa find-same-letter-quantity
      letter =letter
      qletter =letter
==>
   !pop!)

(p try-next-quantity
   =goal>
      isa find-same-letter-quantity
      letter =letter
      - qletter nil
      - qletter =letter
      pos =pos
   =pos>
      isa integer
      next =next
==>
   =goal>
      pos =next
      qletter nil
      result nil)

(p quantity-not-found
   =goal>
      isa find-same-letter-quantity
      letter =letter
      pos =pos
      result nothing
==>
   !pop!)
(spp quantity-not-found :r .5)

;=============================================================================
;;;
;;;  study-step1-symbol
;;;

(chunk-type study-step1-symbol equation pos symbol symtype quantity result)

(p read-step1-symbol
   =goal>
      isa study-step1-symbol
      pos =pos
      symbol nil
==>
   =subgoal1>
      isa read-screen-object
      area ss
      row i1
      col =pos
      result =result
      result-type =symtype
   =goal>
      symbol =result
      symtype =symtype
   !push! =subgoal1)

(p study-step1-symbol-done
   =goal>
      isa study-step1-symbol
      symbol nothing
==>
   =goal>
      result done
   !pop!)

(p store-equation-operator
   =goal>
      isa study-step1-symbol
      equation =equation
      pos =pos
      symbol =operator
      symtype operator
      result nil
==>
   =eqsym>
      isa eqsym
      type constant
      equation =equation
      pos =pos
      value =operator
   =goal>
      result success
   !push! =eqsym)

(p store-equation-integer
   =goal>
      isa study-step1-symbol
      equation =equation
      pos =pos
      symbol =integer
      symtype integer
      result nil
==>
   =eqsym>
      isa eqsym
      type constant
      equation =equation
      pos =pos
      value =integer
   =goal>
      result success
   !push! =eqsym)

(p subgoal-find-same-letter-quantity
   =goal>
      isa study-step1-symbol
      symbol =var
      symtype variable
      quantity nil
      result nil
==>
   =subgoal1>
      isa find-same-letter-quantity
      letter =var
      pos i1
      result =result
   =goal>
      quantity =result
   !push! =subgoal1)

(p store-equation-quantity
   =goal>
      isa study-step1-symbol
      equation =equation
      pos =pos
      symbol =symbol
      quantity =quantity
      - quantity nothing
      result nil
==>
   =eqsym>
      isa eqsym
      type quantity
      equation =equation
      pos =pos
      value =quantity
   =goal>
      result success
   !push! =eqsym)

(p store-equation-quantity-constant
   =goal>
      isa study-step1-symbol
      equation =equation
      pos =pos
      symbol =symbol
      quantity nothing
      result nil
==>
   =eqsym>
      isa eqsym
      type constant
      equation =equation
      pos =pos
      value =symbol
   =goal>
      result success
   !push! =eqsym)

(p study-step1-symbol-success
   =goal>
      isa study-step1-symbol
      result success
==>
   !pop!)

;=============================================================================
;;;
;;;  study-step1
;;;

(chunk-type study-step1 equation pos result)

(p study-step1-symbol
   =goal>
      isa study-step1
      equation =equation
      pos =pos
      result nil
==>
   =subgoal1>
      isa study-step1-symbol
      equation =equation
      pos =pos
      result =result
   =goal>
      result =result
   !push! =subgoal1)

(p study-next-step1-symbol
   =goal>
      isa study-step1
      pos =pos
      result success
   =pos>
      isa integer
      next =next
==>
   =goal>
      pos =next
      result nil)

(p done-study-step1
   =goal>
      isa study-step1
      result done
==>
   !pop!)

;=============================================================================
;;;
;;;  study-step2
;;;

(chunk-type study-step2 equation pos symbol symtype quantity)

(p study-value-symbol
   =goal>
      isa study-step2
      pos =pos
      symbol nil
==>
   =subgoal1>
      isa read-screen-object
      area ss
      row i2
      col =pos
      result =result
      result-type =symtype
   =goal>
      symbol =result
      symtype =symtype
   !push! =subgoal1)

(p done-study-step2
   =goal>
      isa study-step2
      symbol nothing
==>
   !pop!)

(p store-value-equation-operator
   =goal>
      isa study-step2
      equation =equation
      pos =pos
      symbol =operator
      symtype operator
   =pos>
      isa integer
      next =next
==>
   =eqsym>
      isa eqsym
      type constant
      equation =equation
      pos =pos
      value =operator
   =goal>
      pos =next
      symbol nil
   !push! =eqsym)

(p store-value-equation-constant-variable
   =goal>
      isa study-step2
      equation =equation
      pos =pos
      symbol =variable
      symtype variable
   =pos>
      isa integer
      next =next
==>
   =eqsym>
      isa eqsym
      type constant
      equation =equation
      pos =pos
      value =variable
   =goal>
      pos =next
      symbol nil
   !push! =eqsym)

(p subgoal-find-sample-problem-quantity
   =goal>
      isa study-step2
      symbol =integer
      symtype integer
      quantity nil
==>
   =subgoal1>
      isa find-sample-problem-quantity
      value =integer
      pos i1
      result =result
   =goal>
      quantity =result
   !push! =subgoal1)

(p store-value-equation-quantity
   =goal>
      isa study-step2
      equation =equation
      pos =pos
      symbol =symbol
      quantity =quantity
      - quantity nil
   =pos>
      isa integer
      next =next
==>
   =eqsym>
      isa eqsym
      type quantity
      equation =equation
      pos =pos
      value =quantity
   =goal>
      pos =next
      symbol nil
      quantity nil
   !push! =eqsym)

;=============================================================================
;;;
;;;  check-step2-symbol
;;;

(chunk-type check-step2-symbol equation pos symbol type value quantity result)

(p read-step2-symbol
   =goal>
      isa check-step2-symbol
      pos =pos
      symbol nil
==>
   =subgoal1>
      isa read-screen-object
      area ss
      row i2
      col =pos
      result =result
   =goal>
      symbol =result
   !push! =subgoal1)

(p check-step2-symbol-done
   =goal>
      isa check-step2-symbol
      symbol nothing
==>
   =goal>
      result done
   !pop!)

(p retrieve-eqsym-for-step2
   =goal>
      isa check-step2-symbol
      equation =equation
      pos =pos
      - symbol nil
      - symbol nothing
      type nil
      value nil
   =eqsym>
      isa eqsym
      type =type
      equation =equation
      pos =pos
      value =value
==>
   =goal>
      type =type
      value =value)

(p correct-step2-constant
   =goal>
      isa check-step2-symbol
      - symbol nothing
      symbol =constant
      type constant
      value =constant
==>
   =goal>
      result correct
   !pop!)

(p find-integer-quantity
   =goal>
      isa check-step2-symbol
      symbol =integer
      type quantity
      quantity nil
==>
   =subgoal1>
      isa find-sample-problem-quantity
      value =integer
      pos i1
      result =result
   =goal>
      quantity =result
   !push! =subgoal1)

(p correct-step2-integer
   =goal>
      isa check-step2-symbol
      type quantity
      value =quantity
      quantity =quantity
==>
   =goal>
      result correct
   !pop!)

(p incorrect-step2-integer
   =goal>
      isa check-step2-symbol
      - quantity nil
==>
   =goal>
      result incorrect
   !pop!)
(spp incorrect-step2-integer :r .1)

;=============================================================================
;;;
;;;  check-step2
;;;

(chunk-type check-step2 equation pos check result)

(p check-step2-symbol
   =goal>
      isa check-step2
      equation =equation
      pos =pos
      check nil
==>
   =subgoal1>
      isa check-step2-symbol
      equation =equation
      pos =pos
      result =result
   =goal>
      check =result
   !push! =subgoal1)

(p check-next-step2-symbol
   =goal>
      isa check-step2
      pos =pos
      check correct
   =pos>
      isa integer
      next =next
==>
   =goal>
      pos =next
      check nil)

(p check-step2-symbol-failed
   =goal>
      isa check-step2
      check incorrect
==>
   =goal>
      result incorrect
   !pop!)

(p done-check-step2
   =goal>
      isa check-step2
      check done
==>
   =goal>
      result correct
   !pop!)

;=============================================================================
;;;
;;;  find-test-problem-value
;;;

(chunk-type find-test-problem-value quantity pos found result)

(p init-find-tp-value
   =goal>
      isa find-test-problem-value
      pos nil
==>
   =goal>
      pos i1)

(p read-test-quantity2
   =goal>
      isa find-test-problem-value
      pos =pos
      found nil
      result nil
==>
   =subgoal1>
      isa read-screen-object
      area tp
      row =pos
      col i1
      result =result
   =goal>
      result =result
   !push! =subgoal1)

(p subgoal-read-value2
   =goal>
      isa find-test-problem-value
      quantity =quantity
      pos =pos
      found nil
      result =quantity
==>
   =subgoal1>
      isa read-screen-object
      area tp
      row =pos
      col i2
      result =result
   =goal>
      found t
      result =result
   !push! =subgoal1)

(p done-find-test-problem-value
   =goal>
      isa find-test-problem-value
      - pos nil
      found t
      - result nil
==>
   !pop!)

(p try-next-test-quantity
   =goal>
      isa find-test-problem-value
      quantity =quantity
      pos =pos
      found nil
      - result nil
      - result =quantity
   =pos>
      isa integer
      next =next
==>
   =goal>
      pos =next
      result nil)

;=============================================================================
;;;
;;;  solve-problem
;;;

(chunk-type solve-problem equation pos type value qvalue)

(p retrieve-eqsym-for-solve
   =goal>
      isa solve-problem
      equation =equation
      pos =pos
      type nil
      value nil
   =eqsym>
      isa eqsym
      type =type
      equation =equation
      pos =pos
      value =value
==>
   =goal>
      type =type
      value =value)

(p subgoal-type-constant
   =goal>
      isa solve-problem
      pos =pos
      type constant
      value =constant
   =pos>
      isa integer
      next =next
==>
   =subgoal1>
      isa type-symbol
      symbol =constant
   =goal>
      pos =next
      type nil
      value nil
   !push! =subgoal1)

(p find-quantity-value
   =goal>
      isa solve-problem
      type quantity
      value =quantity
      qvalue nil
==>
   =subgoal1>
      isa find-test-problem-value
      quantity =quantity
      pos i1
      result =result
   =goal>
      qvalue =result
   !push! =subgoal1)

(p subgoal-type-value
   =goal>
      isa solve-problem
      pos =pos
      qvalue =qvalue
   =pos>
      isa integer
      next =next
==>
   =subgoal1>
      isa type-symbol
      symbol =qvalue
   =goal>
      pos =next
      type nil
      value nil
      qvalue nil
   !push! =subgoal1)

(p done-solve-problem
   =goal>
      isa solve-problem
      type nil
      value nil
==>
   !pop!)
(spp done-solve-problem :r .2)

;;;=========================================================
;;;
;;;  SBVAR and SBVAL PRODUCTIONS
;;;
;;;=========================================================

;;;
;;;  Types that are different for PC and NC
;;;

(chunk-type read-top-down method type)
(chunk-type study-equation method equation)
(chunk-type check-equation method equation result)

(p read-top-down-get-method
   =goal>
      isa read-top-down
      method nil
   =current-method>
      isa current-method
      method =method
==>
   =goal>
      method =method)

(p study-equation-get-method
   =goal>
      isa study-equation
      method nil
   =current-method>
      isa current-method
      method =method
==>
   =goal>
      method =method)

(p check-equation-get-method
   =goal>
      isa check-equation
      method nil
   =current-method>
      isa current-method
      method =method
==>
   =goal>
      method =method)

;;;
;;;  Solve-by-variable productions
;;;

(p sbvar-read-top-down
   =goal>
      isa read-top-down
      method solve-by-variable
==>
   !output! ("SP~%")
   =subgoal1>
      isa read-problem
      pos i1
   !focus-on! =subgoal1)

(p sbvar-study-equation
   =goal>
      isa study-equation
      method solve-by-variable
      equation =equation
==>
   !output! ("S1~%")
   =subgoal1>
      isa study-step1
      equation =equation
      pos i1
   !focus-on! =subgoal1)

(p sbvar-subgoal-check-equation
   =goal>
      isa check-equation
      method solve-by-variable
      equation =equation
      result nil
==>
   !output! ("SPS2~%")
   =subgoal1>
      isa check-step2
      equation =equation
      pos i1
      result =result
   =goal>
      result =result
   !push! =subgoal1)

(p sbvar-done-check-equation
   =goal>
      isa check-equation
      method solve-by-variable
      equation =equation
      - result nil
==>
   !pop!)

;;;
;;;  Solve-by-value productions
;;;

(p sbval-read-top-down
   =goal>
      isa read-top-down
      method solve-by-value
      type =type
==>
   !output! ("SP~%")
   !output! ("S1~%")
   =subgoal1>
      isa read-problem
      pos i1
   =subgoal2>
      isa recall-or-create-equation
      type nothing
      result =result
   =subgoal3>
      isa study-step1
      equation =result
      pos i1
   !focus-on! =subgoal3
   !push! =subgoal2
   !push! =subgoal1)

(p sbval-study-equation
   =goal>
      isa study-equation
      method solve-by-value
      equation =equation
==>
   !output! ("SPS2~%")
   =subgoal1>
      isa study-step2
      equation =equation
      pos i1
   !focus-on! =subgoal1)

(p sbval-check-equation
   =goal>
      isa check-equation
      method solve-by-value
==>
   =goal>
      result correct
   !pop!)

;;;=========================================================
;;;
;;;  MAIN ANALOGY PRODUCTIONS
;;;
;;;=========================================================

(chunk-type solve-by-analogy stage type equation lasttype read-top checked check first)

(p stage1-read-problem-type
   =goal>
      isa solve-by-analogy
      stage i1
==>
   !output! ("(")
   !output! ("(")
   =subgoal1>
      isa read-problem-type
      result =result
   =goal>
      stage i2
      type =result
   !push! =subgoal1)
(spp stage1-read-problem-type :effort 2.0)

(p stage2-first-read-top-down
   =goal>
      isa solve-by-analogy
      type =type
      stage i2
      read-top nil
      first t
==>
   =subgoal1>
      isa read-top-down
      type =type
   =goal>
      read-top t
      first nil
   !push! =subgoal1)

(p stage2-read-top-down
   =goal>
      isa solve-by-analogy
      type =type
      stage i2
      first nil
==>
   =subgoal1>
      isa read-top-down
      type =type
   =goal>
      read-top t
   !push! =subgoal1)
(spp stage2-read-top-down :a 5.0)

(p stage2-skip-ahead
   =goal>
      isa solve-by-analogy
      stage i2
      read-top nil
      first nil
==>
   =goal>
      stage i3)
(spp stage2-skip-ahead :r .73) ;; estimated, p=.22

(p stage2-move-on
   =goal>
      isa solve-by-analogy
      stage i2
      read-top t
==>
   =goal>
      read-top nil
      stage i3)
(spp stage2-move-on :r .78) ;; estimated, p=.83

(p stage3-study-equation
   =goal>
      isa solve-by-analogy
      stage i3
      type =type
==>
   =subgoal1>
      isa recall-or-create-equation
      type =type
      result =result
   =subgoal2>
      isa study-equation
      equation =result
   !push! =subgoal2
   !push! =subgoal1)
(spp stage3-study-equation :a 5.0)

(p stage3-retrieve-equation
   =goal>
      isa solve-by-analogy
      stage i3
      type =type
   =equation>
      isa equation
      type =type
==>
   =goal>
      stage i4
      equation =equation)
(spp stage3-retrieve-equation :r .75) ;; estimated, p=dynamic

(p stage4-check-equation
   =goal>
      isa solve-by-analogy
      stage i4
      equation =equation
      - checked done
==>
   =subgoal1>
      isa check-equation
      equation =equation
      result =result
   =goal>
      checked t
      check =result
   !push! =subgoal1)
(spp stage4-check-equation :a 5.0)

(p stage4-skip-check
   =goal>
      isa solve-by-analogy
      stage i4
      checked nil
==>
   =goal>
      stage i6)
(spp stage4-skip-check :r .72) ;; estimated, p=.13

(p stage4-move-on
   =goal>
      isa solve-by-analogy
      stage i4
      checked t
==>
   =goal>
      checked done)
(spp stage4-move-on :r .80) ;; estimated, p=.94

(p stage4-ignore-check-result
   =goal>
      isa solve-by-analogy
      stage i4
      checked done
      - check nil
==>
   =goal>
      stage i6
      checked nil
      check nil)

(p stage4-check-correct
   =goal>
      isa solve-by-analogy
      stage i4
      checked done
      check correct
==>
   =goal>
      stage i6
      checked nil
      check nil)

(p stage4-check-incorrect
   =goal>
      isa solve-by-analogy
      stage i4
      equation =equation
      checked done
      check incorrect
   =current-method>
      isa current-method
   =equation>
      isa equation
==>
   !output! ("EPI~%")
   !eval! (physdl-record-epiphany)
   =current-method>
      method solve-by-value
   =equation>
      type nil
   =goal>
      stage i3
      equation nil
      checked nil
      check nil)

(p stage5-review-equation
   =goal>
      isa solve-by-analogy
      stage i5
      type =type
==>
   =subgoal1>
      isa recall-or-create-equation
      type =type
      result =result
   =subgoal2>
      isa study-equation
      equation =result
   !push! =subgoal2
   !push! =subgoal1)
(spp stage5-review-equation :a 5.0)

(p stage5-retrieve-equation
   =goal>
      isa solve-by-analogy
      stage i5
      type =type
   =equation>
      isa equation
      type =type
==>
   =goal>
      stage i6
      equation =equation)
(spp stage5-retrieve-equation :r .81) ;; estimated, p=dynamic

(p stage6-solve-problem
   =goal>
      isa solve-by-analogy
      stage i6
      equation =equation
==>
   !output! ("TPTS~%")
   =subgoal1>
      isa solve-problem
      equation =equation
      pos i1
   =subgoal2>
      isa goto-next-screen
   =goal>
      stage i7
      equation nil
   !push! =subgoal2
   !push! =subgoal1)

(p stage7-read-problem-type
   =goal>
      isa solve-by-analogy
      stage i7
      type =type
==>
   !output! (")")
   =subgoal1>
      isa read-problem-type
      result =result
   =goal>
      stage i8
      lasttype =type
      type =result
   !push! =subgoal1)
(spp stage7-read-problem-type :effort 2.0)

(p stage8-next-problem
   =goal>
      isa solve-by-analogy
      stage i8
      - type nothing
      type =type
      lasttype =type
==>
   !output! ("(")
   =goal>
      stage i5)

(p stage8-next-set
   =goal>
      isa solve-by-analogy
      stage i8
      - type nothing
      type =type
      - lasttype =type
      lasttype =lasttype
==>
   !output! ("(")
   =goal>
      stage i2
      equation nil)

(p stage8-done-problems
   =goal>
      isa solve-by-analogy
      stage i8
      type nothing
==>
   !output! (")")
   !pop!)

(spp :creation-time -3000)

(add-dm (goal isa solve-by-analogy stage i1))
(goal-focus goal)