;;;<pre><xmp>
;;;
;;; ACT-R 4.0 model of the Runquist experiment
;;;
;;; to run the model call 
;;; (run-runquist-2 n)
;;; where n is the number of runs

(defvar *response*)
(defvar *base-level*)
(defvar *noise*)
(defvar *threshold*)
(defvar *v*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)

(setf *v* nil)
(setf *threshold* -3.37)
(setf *noise* 1.75)
(setf *base-level* 0)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)

(defparameter *runquist-data* #2a((0.406 0.293 0.331 0.114 0.108 0.11)(0.585 0.59 0.578 0.328 0.245 0.155)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Runquist Experiment model" 2)
        (:table)
        
        (:table)
        "Noise (s):"             (:string :sy *noise*   1.75)  (:new-row)
        "Threshold:"             (:string :sy *threshold*  -3.37)  (:new-row)
        "Base level:"               (:string :sy *base-level* 0)  (:new-row)
        "Number of runs (1-500):" (:string :sy *runs*    100) 
        
        (: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-runquist-2 *runquist-data* nil 1)")
       
        (:new-para)
        
        (:button "Run model" "(if (and (numberp *base-level*) (numberp *threshold*)
                                       (numberp *noise*) (numberp *runs*))
                                  (run-runquist-2 (min 500 (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 about 1 minute for 100 runs of the model"
        (:new-line)
        "- The trace of 100 runs is approximatly 1000k (750 pages) in size"
        (:new-para)))

(defun run-runquist-2 (n)
  (let ((data (make-array '(2 6) :element-type 'float :initial-element 0.0))
        (times (list (* 60 20) (* 60 60) (* 60 360) (* 60 2880) (* 60 10080) (* 60 30240))))

    (dotimes (i n)
      (dotimes (k (length times))
        (reset)
        (set-params-runquist-2)
        (actr-time-fct (nth k times))
        (dotimes (j 12)
          (setf *response* nil)
          (modwme-fct 'goal (list 'word (intern (format nil "W~a" (+ 1 (* j 2))))))
          (goal-focus goal)
          (run)
          (when *response* (incf (aref data (if (> j 5) 1 0) k))))))
    (dotimes (j 2)
      (dotimes (i (length times))
        (setf (aref data j i) (/ (aref data j i) (* 6 n)))))

    (display-runquist-2 data t n)))

(defun display-runquist-2 (data simulation runs)
  (when simulation 
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S)~%" 
            *noise* *threshold* *base-level* runs))
  
  (when *text*
    (format *standard-output* "~%~%~a recall percentages:~%" (if simulation "Simulation" "Experimental"))
    (format *standard-output* "~%Interval               Percent recalled~%")
    (format *standard-output* "                1 presentation    3 presentations~%")
    (let ((times '("20 min." "1 hour" "6 hours" "2 days" "7 days" "21 days")))
      (dotimes (i 6)
        (format *standard-output* "~9a~14,1f~17,1f~%" (nth i times) (* 100.0 (aref data 0 i)) (* 100 (aref data 1 i)))))
    (format *standard-output* "~%")
    
    (when (and simulation *overlay*)
      (format *standard-output* "~%~%Experimental recall percentages:~%")
      (format *standard-output* "~%Interval               Percent recalled~%")
      (format *standard-output* "                1 presentation    3 presentations~%")
      (let ((times '("20 min." "1 hour" "6 hours" "2 days" "7 days" "21 days")))
        (dotimes (i 6)
          (format *standard-output* "~9a~14,1f~17,1f~%" (nth i times) (* 100.0 (aref *runquist-data* 0 i)) (* 100.0 (aref *runquist-data* 1 i)))))
      (format *standard-output* "~%"))
    
    (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*
    (format *standard-output* " 
        <applet 
        code = \"DansGraphs.class\" 
        width = 700 
        height = 400> 
        <PARAM name=\"title\" value=\"Data for Runquist (1983)\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"21\">
        <PARAM name=\"ymax\" value=\"100\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"longestline\" value=\"6\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xspacing\" value=\"2\">
        <PARAM name=\"ydiv\" value=\"10\">
        <PARAM name=\"xdiv\" value=\"1\">
        <PARAM name=\"yspacing\" value=\"20\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"xval0\" value=\".00138;.0416;.25;2;7;21;\">
        <PARAM name=\"xval1\" value=\".00138;.0416;.25;2;7;21;\">" (if (and simulation *overlay*) 4 2)
            (if simulation 2 6553)
            (if simulation 2 6553))
    
    (when (and simulation *overlay*)
      (format *standard-output* "<PARAM name=\"lcolor2\" value=\"0\">
                                 <PARAM name=\"lcolor3\" value=\"1\">
                                 <PARAM name=\"lstyle2\" value=\"6553\">
                                 <PARAM name=\"lstyle3\" value=\"6553\">
                                 <PARAM name=\"xval2\" value=\".00138;.0416;.25;2;7;21;\">
                                 <PARAM name=\"xval3\" value=\".00138;.0416;.25;2;7;21;\">"))
    
    (format *standard-output* "
        <PARAM name=\"xname\" value=\"Interval (days)\">
        <PARAM name=\"yname\" value=\"Percent recalled\">
        <PARAM name=\"name0\" value=\"~a 1 presentation\">
        <PARAM name=\"name1\" value=\"~a 3 presentations\">" (if simulation "Simulation Data" "Experiment Data")(if simulation "Simulation Data" "Experiment Data"))
    
    (format *standard-output* "<PARAM name=\"yval0\" value=\"")
    
    (dotimes (x 6)
      (format *standard-output* "~3,2f;" (* 100 (aref data 0 x))))
    
    (format *standard-output* "\">")
    
    (format *standard-output* "<PARAM name=\"yval1\" value=\"")

    (dotimes (x 6)
      (format *standard-output* "~3,2f;" (* 100 (aref data 1 x))))
    
    (format *standard-output* "\">")
    
    (when (and *overlay* simulation)
      (format *standard-output* "<PARAM name=\"yval2\" value=\"")
      (dotimes (x 6)
        (format *standard-output* "~f;" (* 100 (aref *runquist-data* 0 x))))
      
     (format *standard-output* "\"><PARAM name=\"yval3\" value=\"")
      (dotimes (x 6)
        (format *standard-output* "~f;" (* 100 (aref *runquist-data* 1 x))))
      
      (format *standard-output* "\"> 
          <PARAM name=\"name2\" value=\"Experiment Data 1 presentation\">
          <PARAM name=\"name3\" value=\"Experiment Data 3 presentations\">"))
    (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 set-params-runquist-2 ()
  (sgp-fct (list :blc *base-level* :ol nil :bll .5 :ans *noise* :rt *threshold* :v *v*))

  (setia (w1 pair1 0) (w2 pair1 0)
         (w3 pair2 0) (w4 pair2 0)
         (w5 pair3 0) (w6 pair3 0)
         (w7 pair4 0) (w8 pair4 0)
         (w9 pair5 0) (w10 pair5 0)
         (w11 pair6 0) (w12 pair6 0)
         (w13 pair7 0) (w14 pair7 0)
         (w15 pair8 0) (w16 pair8 0)
         (w17 pair9 0) (w18 pair9 0)
         (w19 pair10 0) (w20 pair10 0)
         (w21 pair11 0) (w22 pair11 0)
         (w23 pair12 0) (w24 pair12 0))
  
  (sdp pair7 :references (0 0 0))
  (sdp pair8 :references (0 0 0))
  (sdp pair9 :references (0 0 0))
  (sdp pair10 :references (0 0 0))
  (sdp pair11 :references (0 0 0))
  (sdp pair12 :references (0 0 0)))

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

(clearall)

(sgp-fct (list :blc *base-level* :ol nil :bll .5 :ans *noise* :rt *threshold* :v *v*))

(chunk-type pair slot1 slot2)
(chunk-type recall word)

(add-dm (goal isa recall)
        (w1 isa chunk)
        (w2 isa chunk)
        (w3 isa chunk)
        (w4 isa chunk)
        (w5 isa chunk)
        (w6 isa chunk)
        (w7 isa chunk)
        (w8 isa chunk)
        (w9 isa chunk)
        (w10 isa chunk)
        (w11 isa chunk)
        (w12 isa chunk)
        (w13 isa chunk)
        (w14 isa chunk)
        (w15 isa chunk)
        (w16 isa chunk)
        (w17 isa chunk)
        (w18 isa chunk)
        (w19 isa chunk)
        (w20 isa chunk)
        (w21 isa chunk)
        (w22 isa chunk)
        (w23 isa chunk)
        (w24 isa chunk)
        (pair1 isa pair slot1 w1 slot2 w2)
        (pair2 isa pair slot1 w3 slot2 w4)
        (pair3 isa pair slot1 w5 slot2 w6)
        (pair4 isa pair slot1 w7 slot2 w8)
        (pair5 isa pair slot1 w9 slot2 w10)
        (pair6 isa pair slot1 w11 slot2 w12)
        (pair7 isa pair slot1 w13 slot2 w14)
        (pair8 isa pair slot1 w15 slot2 w16)
        (pair9 isa pair slot1 w17 slot2 w18)
        (pair10 isa pair slot1 w19 slot2 w20)
        (pair11 isa pair slot1 w21 slot2 w22)
        (pair12 isa pair slot1 w23 slot2 w24))

(setia (w1 pair1 0) (w2 pair1 0)
       (w3 pair2 0) (w4 pair2 0)
       (w5 pair3 0) (w6 pair3 0)
       (w7 pair4 0) (w8 pair4 0)
       (w9 pair5 0) (w10 pair5 0)
       (w11 pair6 0) (w12 pair6 0)
       (w13 pair7 0) (w14 pair7 0)
       (w15 pair8 0) (w16 pair8 0)
       (w17 pair9 0) (w18 pair9 0)
       (w19 pair10 0) (w20 pair10 0)
       (w21 pair11 0) (w22 pair11 0)
       (w23 pair12 0) (w24 pair12 0))

(sdp pair7 :references (0 0 0))
(sdp pair8 :references (0 0 0))
(sdp pair9 :references (0 0 0))
(sdp pair10 :references (0 0 0))
(sdp pair11 :references (0 0 0))
(sdp pair12 :references (0 0 0))


(p recall
   =goal>
      isa recall
      word =word
   
   =fact>
      isa pair
      slot1 =word
      slot2 =response
==>
   !output! ("the other word is ~S~%" =response)

   !eval! (setf *response* t)

   !pop!
)


(p cannot-recall
   =goal>
      isa recall
==>
   !output! ("cannot recall other word~%")

  !pop!
)

(parameters cannot-recall :r .5)