;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;; This file contains the ACT-R model of the
;;; Glenberg free recall experiment
;;; presented in Chapter 5
;;;
;;; ACT-R version 4 required
;;; 
;;; A WWW interface and a command line interface
;;; are provided.  
;;; To run the command line version, call
;;; (do-glenberg n)
;;; replacing n with the number of runs to
;;; simulate.

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This section contains the LISP functions to simulate
;;; the experiment, implement the interface, collect the
;;; data, and display the results
;;;
;;; The ACT-R Model starts further down
;;;

;;; Global variables

(defvar *history*)
(defvar *items*)
(defvar *data*)
(defvar *index*)
(defvar *counter*)
(defvar *predictions*)
(defvar *thresh*)
(defvar *noise*)
(defvar *respond*)
(defvar *factor*)
(defvar *runs*)
(defvar *v*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)

(setf *thresh* 1.4)
(setf *noise* .6)
(setf *respond* 0.5)
(setf *factor* 2)
(setf *runs* 1)
(setf *v* nil)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)


(defparameter *glenberg-contexts* '(l1 l2 l3 l4 l5 l6 l7 l8 l9 l10
                     l11 l12 l13 l14 l15 l16 l17 l18 l19 l20))

(defparameter  *glenberg-results* (make-array '(2 36) :initial-contents 
'(( 0.18 0.17 0.19 0.19 0.24 0.18 0.15 0.41 0.68 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)																																																																																											
(0.10 0.08 0.08 0.05 0.07 0.05 0.07 0.10 0.10 0.06 0.10 0.11 0.06 0.06 0.06 0.10 0.02 0.07 0.05 0.09 0.09
 0.09 0.06 0.08 0.07 0.07 0.14 0.11 0.10 0.10 0.13 0.19 0.21 0.18 0.20 0.33))))																																																																

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Glenberg Experiment model" 2)
        (:table)
        
        (:table)
        "Noise (s): "             (:string :sy *noise*   .6)   (:new-row)
        "Threshold: "             (:string :sy *thresh*  1.4)  (:new-row)
        "Factor (F):"             (:string :sy *factor*  2)    (:new-row)
        "Response time (sec.): " (:string :sy *respond* .5)        (: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-glenberg-data *glenberg-results* 1 nil)")
       
        (:new-para)
        
        
        (:button "Run model" "(if (and (numberp *thresh*) (numberp *noise*) 
                                       (numberp *factor*) (numberp *runs*)
                                       (numberp *respond*))
                                  (do-glenberg (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 2k (2 pages) in size"
        (:new-para)))


;;; reset-wme-number-glenberg 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-glenberg (instantiation)
  (declare (ignore instantiation))
  (setf *wme-number* 100))

;;; set-glenberg-params is used to set
;;; the parameters of the model before each run
;;; it is needed for the WWW interface

(defun set-glenberg-params ()
  (setf *cycle-hook-fn* #'reset-wme-number-glenberg)
  
  (sgp-fct (list  :bll 0.5 :ans *noise* :rt *thresh* :er t 
                  :lf *factor* :v *v* :al nil))
  
  (parameters-fct 'recall-a-word  (list :effort *respond*)))


;;; display-glenberg-data takes 3 parameters
;;; an array containg data for a simulation
;;; of the glenberg experiment, the 
;;; number of runs that the array contains 
;;; data for, and whether the data is for the
;;; simulation, or experimental data.
;;; it displays the data in either text, a graph (on the web),
;;; or both, depending on the settings of *text* and *graphic*

(defun display-glenberg-data (data count simulation)
  (when simulation
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S ~S)~%" 
            *noise* *thresh* *factor* *respond* count))

  (when *text*
    (format *standard-output* "~%~A data:~%" (if simulation "Simulation" "Experimental"))
    (format *standard-output* "~%Percentage recalled:~%")
    (format *standard-output* "9 pairs:~%")
    (dotimes (x 9)
      (format *standard-output* "~3D% " (round (* 100 (/ (aref data 0 x) count)))))
    (format *standard-output* "~%36 pairs:~%")
    (dotimes (x 36)
      (format *standard-output* "~3D% " (round (* 100 (/ (aref data 1 x) count)))))
    (format *standard-output* "~%")
    
    (when (and simulation *overlay*)
      (format *standard-output* "~%Experimental data:~%")
      (format *standard-output* "~%Percentage recalled:~%")
      (format *standard-output* "9 pairs:~%")
      (dotimes (x 9)
        (format *standard-output* "~3D% " (round (* 100  (aref *glenberg-results* 0 x)))))
      (format *standard-output* "~%36 pairs:~%")
      (dotimes (x 36)
        (format *standard-output* "~3D% " (round (* 100 (aref *glenberg-results* 1 x)))))
      (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 = 600 
        height = 300> 

        <PARAM name=\"title\" value=\"Data for Glenberg Experiemnt\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"36\">
        <PARAM name=\"ymax\" value=\"100\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"xdiv\" value=\"1\">
        <PARAM name=\"xspacing\" value=\"2\">
        <PARAM name=\"longestline\" value=\"36\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"ydiv\" value=\"10\">
        <PARAM name=\"yspacing\" value=\"20\">
        <PARAM name=\"xval0\" value=\"1;2;3;4;5;6;7;8;9;\">
        <PARAM name=\"xval1\" value=\"1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20;21;22;23;24;25;26;27;28;29;30;31;32;33;34;35;36;\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"xname\" value=\"Word Position\">
        <PARAM name=\"yname\" value=\"% recalled\">
        <PARAM name=\"name0\" value=\"~a 9 pairs\">" 
            (if (and simulation *overlay*) 4 2)
            (if simulation 2 6553)
            (if simulation 2 6553)
            (if simulation "Simulation Data" "Experiment Data"))
    
    (format *standard-output* "<PARAM name=\"yval0\" value=\"")
    
    (dotimes (x 9)
      (format *standard-output* "~3,1f;" (* 100 (/ (aref data 0 x) count))))
    
    (format *standard-output* "\">
        <PARAM name=\"name1\" value=\"~a 36 pairs\">" (if simulation "Simulation Data" "Experiment Data"))
    
    (format *standard-output* "<PARAM name=\"yval1\" value=\"")
    
    (dotimes (x 36)
      (format *standard-output* "~3,1f;" (* 100 (/ (aref data 1 x) count))))
    
    (format *standard-output* "\">")
    
    (when (and *overlay* simulation)
      (format *standard-output* "<PARAM name=\"xval2\" value=\"1;2;3;4;5;6;7;8;9;\">
        <PARAM name=\"lcolor2\" value=\"0\">
        <PARAM name=\"lcolor3\" value=\"1\">
        <PARAM name=\"lstyle2\" value=\"6553\">
        <PARAM name=\"lstyle3\" value=\"6553\">
        
        <PARAM name=\"xval3\" value=\"1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20;21;22;23;24;25;26;27;28;29;30;31;32;33;34;35;36;\">
        <PARAM name=\"name2\" value=\"Experimental 9 pairs\">")
      
      (format *standard-output* "<PARAM name=\"yval2\" value=\"")
      
      (dotimes (x 9)
        (format *standard-output* "~3,1f;" (* 100 (aref *glenberg-results* 0 x) )))
      
      (format *standard-output* "\">
             <PARAM name=\"name3\" value=\"Experimental 36 pairs\">
             <PARAM name=\"yval3\" value=\"")
      
      (dotimes (x 36)
        (format *standard-output* "~3,1f;" (* 100 (aref *glenberg-results* 1 x) )))
      
      (format *standard-output* "\">"))
    
    (format *standard-output* "
             <HR> Either your browser does not support JAVA or this graph has scrolled off the top of the display.~%
             </HR></applet>")))


  
 

;;; setup-glenberg takes 2 parameters
;;; a name for a word chunk, and
;;; the number of previous contexts that word occured
;;; in, and returns the list of chunk definitions
;;; for the previous contexts

(defun setup-glenberg (word n)
  (add-dm-fct (list (list word 'isa 'word)))
  (do ((count 0 (1+ count))
       (result nil (cons   `(,(gentemp "C") isa memory-token 
                             context ,(nth count *glenberg-contexts*)
                             name ,word) result)))
      ((= count n) result)))


;;; setup-glenberg-materials takes one parameter
;;; the number of words to create, and
;;; generates the word chunks, and the 
;;; previous context chunks for the words,
;;; and the sets the base levels for the items,
;;; and returns the list of word chunk
;;; names

(defun setup-glenberg-materials (n)
   (do ((count 0 (1+ count))
        (items nil (append (setup-glenberg (gentemp "I") 1) items)))
       ((= count n) 
        (eval `(addwm ,@items))
        (setallbaselevels 10 -400)
        (remove-duplicates (mapcar 'seventh items)))))


;;; do-glenberg takes one parameter
;;; the number of runs to simulate,
;;; and runs the experiment
;;; that many times, displaying a table
;;; of the results when finished

(defun do-glenberg (n)
  (let ((final (make-array '(2 36) :initial-element 0)))
  (do ((count 0 (1+ count)))
      ((equal count n) (setf  *predictions* final))
    (let ((temp (glenberg-conditions)))
        (do ((j 0 (1+ j)))
            ((equal j 2) nil)
          (do ((k 0 (1+ k)))
              ((equal k 36) nil)
            (setf (aref final j k) (+ (aref final j k) (/ (aref temp j k) 2.0)))))))
  (display-glenberg-data *predictions* n t)))


;;; glenberg-conditions takes no parameters
;;; and runs one simulation of each condition 
;;; of the glenberg experiment in a random order
;;; and returns the data array of the results

(defun glenberg-conditions ()
  (setf *data* (make-array '(2 36) :initial-element 0))
  (let ((ordered (list '(run-glenberg-experiment 9 24 0) 
                       '(run-glenberg-experiment 36 6 1) )))
    (dotimes (i 2)
      (let ((exp-run (nth (random (- 2 i)) ordered)))
        (setf ordered (delete exp-run ordered))
        (reset)
        (set-glenberg-params)
        (eval exp-run)))
    *data*))

;;; run-glenberg-experiment takes 3 parameters,
;;; the number of word pairs for the run, the amount
;;; of time for study (in seconds), and the index
;;; of this condition in the data array *data*
;;; it then creates the memory tokens to simulate
;;; the studying of the items and runs the simulation
;;; of the recall

(defun run-glenberg-experiment (n time index)  
  (setf *index* index)
  (setf *wme-number* 100)
   (let* ((materials (setup-glenberg-materials (* n 2))))
     (setallbaselevels 500 -1000)
     (reset-wme-number-glenberg nil)
     (reset-ia)
     (setf *items* (no-output (wm-fct materials)))
     (setf *history* *items*)
     
     (do ((items materials (cddr items)))
         ((null items) nil)
       (actr-time-fct time)
       (eval `(addwm (,(gentemp "C") isa memory-token 
                      context L0
                      name ,(car items))
                     (,(gentemp "C") isa memory-token 
                      context L0
                      name ,(cadr items)))))
     (actr-time 20)

     (addwm (goal isa recall-words context L0))
     (wmfocus goal) 
     (setf *counter* 1)
     (run)))


;;; analyze-glenberg takes one parameter
;;; a word chunk, and updates the results
;;; array for the position of the word in
;;; the study list

(defun analyze-glenberg (word)
  (setf (aref *data* *index* (floor (/ (position word *history*) 2))) 
        (1+ (aref *data* *index* (floor (/ (position word *history*) 2)))))      
  (setf *counter* (1+ *counter*)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; ACT-R Model of the task
;;;
;;;


(clearall)

(sgp-fct (list :bll 0.5 :ans *noise* :rt *thresh* :er t :lf *factor* :v nil :al nil))

(chunk-type study-words first position context)
(chunk-type memory-token name status context)
(chunk-type context)
(chunk-type rehearse target)
(chunk-type output target)
(chunk-type recall-words context)
(chunk-type type-word position word)
(chunk-type dump-words first position context)
(chunk-type word)

; adds the contexts to working memory

(add-dm (l0 isa context)
        (l1 isa context))


(setallbaselevels 500 -1000)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Productions
;;;

(p recall-a-word
"
  IF the goal is to recall words
     and a memory token with the 
     current context that has not
     been previously recalled can be
     recalled 
  THEN mark the memory token as having been recalled
     and respond with the word
"
   =goal>
      isa recall-words
      context =context

   =token>
      isa memory-token
      status nil
      name =name
      context =context
==>
   =token>
      status recalled

   !eval! (analyze-glenberg =name)
)

(parameters-fct 'recall-a-word  (list :effort *respond*))


(p stop-recall
"
  IF the goal is to recall words
  THEN pop the goal
"
   =goal>
      isa recall-words
==>
   !pop!
)

(parameters stop-recall :r .25)