;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;; ACT-R model of the Zbrodoff Task
;;;
;;; This model works with ACT-R 4.0
;;;
;;; interface coded by: Dan Bothell
;;;
;;; This file contains the ACT-R model that
;;; can perform the Zbrodoff task. 
;;;
;;; To run the model call:
;;; (start-zbrodoff n)
;;; where n is the number of runs

(defvar *thresh*)
(defvar *noise*)
(defvar *factor*)
(defvar *say*) 
(defvar *intercept*)

(defvar *v*)
(defvar *runs*)

(defvar *control-pred*)
(defvar *standard-pred*)
(defvar *reverse-pred*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)

(setf *thresh* 2.27)
(setf *noise* .66)
(setf *factor* 1.0)
(setf *say* 1.00) 
(setf *intercept* 1.0)

(setf *v* nil)
(setf *runs* 1)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)


(defparameter *zbrodoff-table-names* '("Control Group" "Standard Group" "Reverse Group"))

(defparameter *zbrodoff-control-data* '(1.84 2.46 2.82 1.21 1.45 1.42 1.14 1.21 1.17))
(defparameter *zbrodoff-standard-data* '(1.84 2.65 3.55 1.08 1.45 1.92 0.91 1.08 1.43))
(defparameter *zbrodoff-reverse-data* '(2.25 2.53 2.42 1.47 1.46 1.10 1.24 1.12 0.87))
(defparameter *zbrodoff-subject-data* 
  (list *zbrodoff-control-data* *zbrodoff-standard-data* *zbrodoff-reverse-data*))




(defun display-zbrodoff (data simulation runs)
  (when simulation 
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S ~S ~S)~%" 
            *thresh* *noise* *factor* *say* *intercept* runs))
  
  (when *text*
    (format *standard-output* "~%~%~a latencies:~%~%" (if simulation "Simulation" "Experimental"))
    (zbrodoff-draw-tables data)

    (when (and simulation *overlay*)
      (format *standard-output* "~%~%Experimental latencies:~%~%")
      (zbrodoff-draw-tables *zbrodoff-subject-data*))
    
    (unless *graphic* (format *standard-output* 
                              "~%</pre>If your browser supports JAVA, you 
                               can display the data in a graph by checking 
                               the Graphic output box on the interface page.<pre>~%~%")))
  (when *graphic*
    (dotimes (i 3)
      (output-graph-zbrodoff (nth i data) (nth i *zbrodoff-table-names*) simulation (nth i *zbrodoff-subject-data*)))))

(defun output-graph-zbrodoff (data title simulation exp-data)

  (format *standard-output* " 
         <applet 
        code = \"DansGraphs.class\" 
        width = 300 
        height = 600> 
        <PARAM name=\"title\" value=\"~a\">
        <PARAM name=\"xmin\" value=\"2\">
        <PARAM name=\"xmax\" value=\"4\">
        <PARAM name=\"ymax\" value=\"4\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"longestline\" value=\"3\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"ydiv\" value=\".5\">
        <PARAM name=\"yspacing\" value=\"1\">
        <PARAM name=\"xval0\" value=\"2;3;4;\">
        <PARAM name=\"xval1\" value=\"2;3;4;\">
        <PARAM name=\"xval2\" value=\"2;3;4;\">
        <PARAM name=\"xname\" value=\"Addend\">
        <PARAM name=\"yname\" value=\"Latency sec.\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a Block 1\">
        <PARAM name=\"name1\" value=\"~a Block 2\">
        <PARAM name=\"name2\" value=\"~a Block 3\">" title 
          (if (and simulation *overlay*) 6 3)
          (if simulation 2 6553)
          (if simulation 2 6553)
          (if simulation 2 6553)
          (if simulation "Simulation" "Experiment")
          (if simulation "Simulation" "Experiment") 
          (if simulation "Simulation" "Experiment"))
    
  (dotimes (i 3)
    (format *standard-output* "<PARAM name=\"yval~S\" value=\"~4,2f;~4,2f;~4,2f;\">"
            i (nth (* 3 i) data) (nth (+ 1 (* 3 i)) data) (nth (+ 2 (* 3 i)) data)))
    
     
    (when (and *overlay* simulation)
      (format *standard-output* "
        <PARAM name=\"xval3\" value=\"2;3;4;\">
        <PARAM name=\"xval4\" value=\"2;3;4;\">
        <PARAM name=\"xval5\" value=\"2;3;4;\">
        <PARAM name=\"lcolor3\" value=\"0\">
        <PARAM name=\"lcolor4\" value=\"1\">
        <PARAM name=\"lcolor5\" value=\"2\">
        <PARAM name=\"lstyle3\" value=\"6553\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"name3\" value=\"Experimental Block 1\">
        <PARAM name=\"name4\" value=\"Experimental Block 2\">
        <PARAM name=\"name5\" value=\"Experimental Block 3\">")
      (dotimes (i 3)
        (format *standard-output* "<PARAM name=\"yval~S\" value=\"~4,2f;~4,2f;~4,2f;\">"
                (+ 3 i) (nth (* 3 i) exp-data)
                (nth (+ 1 (* 3 i)) exp-data)
                (nth (+ 2 (* 3 i)) exp-data)))
 
       )

    (format *standard-output* "
             <HR> Either your browser does not support JAVA or this graph has scrolled off the top of the display.~%
             </HR></applet>"))





(defun zbrodoff-draw-tables (vals)
  (let ((count 0))
    (dolist (x vals)
      (format *standard-output* "~A~%" (nth count *zbrodoff-table-names*))
      (format *standard-output* "                   block ~%")
      (format *standard-output* "  addend   1         2         3~%")
      (format *standard-output* "    2~9,2F ~9,2F ~9,2F~%" 
              (nth 0 x) (nth 3 x) (nth 6 x))
      (format *standard-output* "    3~9,2F ~9,2F ~9,2F~%"
              (nth 1 x) (nth 4 x) (nth 7 x) ) 
      (format *standard-output* "    4~9,2F ~9,2F ~9,2F~%~%"
              (nth 2 x) (nth 5 x) (nth 8 x))
      (incf count))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This section contains the interface for the WWW using the
;;; ACT-R on the Web application by Elmar Schwarz

(defvar *WWW-interface*)

(setf  *WWW-interface* 
      '((:heading "Zbrodoff Experiment Model" 2)
        (:table)
        
        (:table)
        "Threshold: "        (:string :sy *thresh*      2.27)  (:new-row)
        "Noise: "            (:string :sy *noise*       .66)   (:new-row)
        "Scale factor: "     (:string :sy *factor*      1)     (:new-row)
        "Count time (sec.): "(:string :sy *say*         1)     (:new-row)
        "Intercept (sec.): " (:string :sy *intercept*   1)     (:new-row)
        "Number of runs (1-20): "   (:string :sy *runs*        1)
        (:table-end)
        
        (:table)
        (:checkbox "Trace" :sy *v*  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 one graph" :sy *overlay*  nil) 
       
        (:table-end)
        
        (:table-end)
        (:new-para)
        (:button "Show Experiment Results" "(display-zbrodoff *zbrodoff-subject-data* nil 1)")
       
        
        (:new-para)
        
        (:button "Run model" "(if (and (numberp *thresh*) (numberp *noise*) (numberp *factor*)
                                       (numberp *say*) (numberp *intercept*) (numberp *runs*))
                                  (start-zbrodoff (min 20 (max 1 *runs*)))
                                  (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 less than 1 minute for 1 run of the model"
        (:new-line)
        "- The trace of 1 run is approximatly 1500k (1000 pages) in size"
        (:new-para)))



(defun start-zbrodoff (n)
  (display-zbrodoff (zbrodoff-cycle n) t n))



(defun set-zbrodoff-params ()
  (parameters-fct 'terminate-yes (list :a *intercept*))
  (parameters-fct 'terminate-no (list :a *intercept*))
  (parameters-fct 'one-more (list :a *say*))
  (spp :chance nil)
  (spp :effort nil)
  (sgp-fct (list :era t 
                 :bll .5 
                 :rt *thresh* 
                 :ans *noise* 
                 :lf *factor*
                 :v *v*))
  ;(setallbaselevels 10000 -1000)
  (setf *cycle-hook-fn* #'reset-wme-number-zbrodoff))

;;; reset-wme-number-zbrodoff takes one parameter
;;; which is ignored, and sets the number of
;;; chunks to be 100 
;;; this function is hooked to the actr 
;;; cycle-hook-fn, so that the number
;;; of chunks is always 100
;;; to prevent problems with ia's 
;;; changing for the different size lists

(defun reset-wme-number-zbrodoff (instantiation)
  (declare (ignore instantiation))
  (setf *wme-number* 100))


(defun zbrodoff-cycle (n)
  (list 
   (control-zbrodoff-cycle n)
   (standard-zbrodoff-cycle n)
   (reverse-zbrodoff-cycle n)))

(defun zbrodoff-permut (lis)
  (do ((result  (list (nth (random (length lis)) lis))
                (cons (nth (random (length lis)) lis) result)))
      ((null lis) result)
    (setf lis (remove (car result) lis))
    (cond ((null lis) (return result)))))


(defun control-zbrodoff-run ()
  (let (start 
        cond
        data
        (lis (no-output (wm two three four)))
        (new  (zbrodoff-permut 
               (list (make-zbrodoff-goal 'a 'two 'c)(make-zbrodoff-goal 'd 'two 'f)
                     (make-zbrodoff-goal 'b 'three 'e)(make-zbrodoff-goal 'e 'three 'h)
                     (make-zbrodoff-goal 'c 'four 'g)(make-zbrodoff-goal 'f 'four 'j)
                     (make-zbrodoff-goal 'a 'two 'd)(make-zbrodoff-goal 'd 'two 'g)
                     (make-zbrodoff-goal 'b 'three 'f)(make-zbrodoff-goal 'e 'three 'i)
                     (make-zbrodoff-goal 'c 'four 'h)(make-zbrodoff-goal 'f 'four 'k)
                     (make-zbrodoff-goal 'a 'two 'c)(make-zbrodoff-goal 'd 'two 'f)
                     (make-zbrodoff-goal 'b 'three 'e)(make-zbrodoff-goal 'e 'three 'h)
                     (make-zbrodoff-goal 'c 'four 'g)(make-zbrodoff-goal 'f 'four 'j)
                     (make-zbrodoff-goal 'a 'two 'd)(make-zbrodoff-goal 'd 'two 'g)
                     (make-zbrodoff-goal 'b 'three 'f)(make-zbrodoff-goal 'e 'three 'i)
                     (make-zbrodoff-goal 'c 'four 'h)(make-zbrodoff-goal 'f 'four 'k)))))
    (resetia)
    (do ((temp new (cdr temp)))
        ((null temp) data)
      (setf cond  (position (chunk-slot-value-fct (car temp) 'arg2) lis))
      (setf start (actr-time))
      (wmfocus-fct (list (car temp)))
      (run)
      (setf data (cons (list cond (- (actr-time) start)) data))
      (actr-time 2.5))))

(defun standard-zbrodoff-run ()
  (let (start cond data
              (lis (no-output (wm two three four)))
              (new  (zbrodoff-permut 
                     (list (make-zbrodoff-goal 'a 'two 'c)(make-zbrodoff-goal 'd 'two 'f)
                           (make-zbrodoff-goal 'b 'three 'e)(make-zbrodoff-goal 'e 'three 'h)
                           (make-zbrodoff-goal 'c 'four 'g)(make-zbrodoff-goal 'f 'four 'j)
                           (make-zbrodoff-goal 'a 'two 'd)(make-zbrodoff-goal 'd 'two 'g)
                           (make-zbrodoff-goal 'b 'three 'f)(make-zbrodoff-goal 'e 'three 'i)
                           (make-zbrodoff-goal 'c 'four 'h)(make-zbrodoff-goal 'f 'four 'k)
                           (make-zbrodoff-goal 'a 'two 'c)(make-zbrodoff-goal 'd 'two 'f)
                           (make-zbrodoff-goal 'b 'three 'e)(make-zbrodoff-goal 'e 'three 'h)
                           (make-zbrodoff-goal 'a 'two 'c)(make-zbrodoff-goal 'd 'two 'f)
                           (make-zbrodoff-goal 'a 'two 'd)(make-zbrodoff-goal 'd 'two 'g)
                           (make-zbrodoff-goal 'b 'three 'f)(make-zbrodoff-goal 'e 'three 'i)
                           (make-zbrodoff-goal 'a 'two 'd)(make-zbrodoff-goal 'd 'two 'g)))))
    (resetia)
    (do ((temp new (cdr temp)))
       ((null temp) data)
    (setf cond  (position (chunk-slot-value-fct (car temp) 'arg2) lis))
    (setf start (actr-time))
       (wmfocus-fct (list (car temp)))
       (run)
       (setf data (cons (list cond (- (actr-time) start)) data))
       (actr-time 2.5))))

(defun reverse-zbrodoff-run ()
  (let (start cond data
              (lis (no-output (wm two three four)))
              (new  (zbrodoff-permut 
                     (list (make-zbrodoff-goal 'a 'two 'c)(make-zbrodoff-goal 'd 'two 'f)
                           (make-zbrodoff-goal 'b 'three 'e)(make-zbrodoff-goal 'e 'three 'h)
                           (make-zbrodoff-goal 'c 'four 'g)(make-zbrodoff-goal 'f 'four 'j)
                           (make-zbrodoff-goal 'a 'two 'd)(make-zbrodoff-goal 'd 'two 'g)
                           (make-zbrodoff-goal 'b 'three 'f)(make-zbrodoff-goal 'e 'three 'i)
                           (make-zbrodoff-goal 'c 'four 'h)(make-zbrodoff-goal 'f 'four 'k)
                           (make-zbrodoff-goal 'c 'four 'g)(make-zbrodoff-goal 'f 'four 'j)
                           (make-zbrodoff-goal 'b 'three 'e)(make-zbrodoff-goal 'e 'three 'h)
                           (make-zbrodoff-goal 'c 'four 'g)(make-zbrodoff-goal 'f 'four 'j)
                           (make-zbrodoff-goal 'c 'four 'h)(make-zbrodoff-goal 'f 'four 'k)
                           (make-zbrodoff-goal 'b 'three 'f)(make-zbrodoff-goal 'e 'three 'i)
                           (make-zbrodoff-goal 'c 'four 'h)(make-zbrodoff-goal 'f 'four 'k)))))
    (resetia)
    (do ((temp new (cdr temp)))
       ((null temp) data)
    (setf cond  (position (chunk-slot-value-fct (car temp) 'arg2) lis))
    (setf start (actr-time))
       (wmfocus-fct (list (car temp))) 
       (run)
       (setf data (cons (list cond (- (actr-time) start)) data))
       (actr-time 2.5))))

(defun control-exp-zbrodoff ()
  
  (do ((count 0 (1+ count))
       (data (list 0 0 0) (list 0 0 0))
       (result nil (append  result
                            (do ((i 0 (1+ i)))
                                ((eq i 8) (list (/ (first data) 64)
                                                (/ (second data) 64)
                                                (/ (third data) 64)))
                              (do ((temp (control-zbrodoff-run) (cdr temp)))
                                  ((null temp) nil)
                                (rplaca (nthcdr (caar temp) data)
                                        (+ (nth (caar temp) data) (cadar temp))))
                              (cond ((equal (mod (+ (* count 8) i) 3) 2)
                                     (actr-time 60))))
                            )))
      ((equal count 3) result)))

(defun standard-exp-zbrodoff ()
  
  (do ((count 0 (1+ count))
       (data (list 0 0 0) (list 0 0 0))
       (result nil (append  result
                         (do ((i 0 (1+ i)))
                             ((eq i 8) (list (/ (first data) 96)
                                             (/ (second data) 64)
                                             (/ (third data) 32)))
                           (do ((temp (standard-zbrodoff-run) (cdr temp)))
                               ((null temp) nil)
                            (rplaca (nthcdr (caar temp) data)
                                     (+ (nth (caar temp) data) (cadar temp))))
                             (cond ((equal (mod (+ (* count 8) i) 3) 2)
                                    (actr-time 60))))
                      )))
      ((equal count 3) result)))

(defun reverse-exp-zbrodoff ()
  
  (do ((count 0 (1+ count))
       (data (list 0 0 0) (list 0 0 0))
       (result nil (append  result
                         (do ((i 0 (1+ i)))
                             ((eq i 8) (list (/ (first data) 32)
                                             (/ (second data) 64)
                                             (/ (third data) 96)))
                           (do ((temp (reverse-zbrodoff-run) (cdr temp)))
                               ((null temp) nil)
                            (rplaca (nthcdr (caar temp) data)
                                     (+ (nth (caar temp) data) (cadar temp))))
                             (cond ((equal (mod (+ (* count 8) i) 3) 2)
                                    (actr-time 60))))
                      )))
      ((equal count 3) result)))

(defun control-zbrodoff-cycle (n)
  (let ((result '(0 0 0 0 0 0 0 0 0)))
    (do ((count 0 (1+ count)))
        ((equal count n) (setf *control-pred*
                               (mapcar #'(lambda (x) (/ x n)) result)))
      (reset)
      (set-zbrodoff-params)
      (do ((temp1 (control-exp-zbrodoff) (cdr temp1))
           (temp2 result (cdr temp2))
           (new nil (cons (+ (car temp1) (car temp2)) new)))
          ((null temp1) (setf result (reverse new)))))))

(defun standard-zbrodoff-cycle (n)
  (let ((result '(0 0 0 0 0 0 0 0 0)))
  (do ((count 0 (1+ count)))
      ((equal count n) (setf *standard-pred*
       (mapcar #'(lambda (x) (/ x n)) result)))
    (reset)
    (set-zbrodoff-params)
    (do ((temp1 (standard-exp-zbrodoff) (cdr temp1))
         (temp2 result (cdr temp2))
         (new nil (cons (+ (car temp1) (car temp2)) new)))
        ((null temp1) (setf result (reverse new)))))))

(defun reverse-zbrodoff-cycle (n)
  (let ((result '(0 0 0 0 0 0 0 0 0)))
  (do ((count 0 (1+ count)))
      ((equal count n) (setf *reverse-pred*
       (mapcar #'(lambda (x) (/ x n)) result)))
    (reset)
    (set-zbrodoff-params)
    (do ((temp1 (reverse-exp-zbrodoff) (cdr temp1))
         (temp2 result (cdr temp2))
         (new nil (cons (+ (car temp1) (car temp2)) new)))
        ((null temp1) (setf result (reverse new)))))))


(defun make-zbrodoff-goal (a b c)
  (car (addwm-fct (list (list  (gentemp "GOAL") 'isa 'problem 'arg1 a 'arg2 b 'ans c)))))
    
    

  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>

(clearall)
(sgp-fct (list :era t :bll .5 :rt *thresh* :ans *noise* :lf *factor* :v nil))

(setf *cycle-hook-fn* #'reset-wme-number-zbrodoff)

(chunk-type problem arg1 arg2 ans count result)
(chunk-type character next)

(add-dm
   (one ISA character next two)
   (two ISA character next three)
   (three ISA character next four)
   (four ISA character next five)
   (zero ISA character next one)
   (five isa character)
   (a ISA character next b)
   (b ISA character next c)
   (c ISA character next d)
   (d ISA character next e)
   (e ISA character next f)
   (f ISA character next g)
   (g ISA character next h)
   (h ISA character next i)
   (i ISA character next j)
   (j ISA character next k)
   (k isa character))

(setallbaselevels 10000 -1000)


(P terminate-yes
   =goal>
      ISA         problem
      arg1        =arg
      arg2        =count
      count       =count
      result      =x
      ans         =x
==>
   !output!       ("yes")
!pop!
)

(parameters-fct 'terminate-yes (list :effort *intercept*))


(P terminate-no
   =goal>
      ISA         problem
      arg2        =count
     count       =count
      result      =x
     - ans         =x
==>
   !output!       ("no")
   !pop!
)

(parameters-fct 'terminate-no (list :effort *intercept*))

(P one-more
   =goal>
      ISA         problem
      result      =x
      arg2        =count
      count       =num
    - count       =count
   =x>
      ISA         character
      next        =y
   =num>
      ISA         character
      next        =next
==>
   =goal>
      result      =y
      count       =next
)

(parameters-fct 'one-more (list :effort *say*))

(P initiate
   =goal>
      ISA         problem
      arg1        =x
      count       nil
==>
   =goal>
      count       zero
      result      =x
)

(parameters initiate :b 2.5)

(P retrieve
   =goal>
      ISA         problem
      count       nil
      arg1        =x
      arg2        =count
      ans         =ans
   =fact>
      ISA         problem
      count       =count
      arg1        =x
      arg2        =count
      result      =new
==>
    =goal>
       count      =count
       result     =new
)