;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;; This file contains the ACT-R model of the
;;; serial recall task presented in Chapter 7
;;; for the experiment done by Burrows. 
;;;
;;; ACT-R version 4 required
;;; 
;;; A WWW interface and a command line interface
;;; are provided.  
;;; To run the command line version, call
;;; (do-burrows)

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 *precord* nil)
(defvar *stop-it*)
(defvar *plan* nil)
(defvar *target* nil)
(defvar *results* nil)
(defvar *factor* 2.29)
(defvar *encode* .4)
(defvar *say-it* .50)
(defvar *v* nil)
(defvar *encode*)
(defvar *penalty*)
(defvar *intercept*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)

(setf *factor* 4.15)
;(setf *encode* .2)
(setf *encode* .4)
(setf *say-it* .50)
(setf *v* nil)
(setf *encode* .4)
(setf *penalty* 2.5)
(setf *intercept* .5)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)

;;; experiment results
;;; 

(defparameter *burrows-data* '(.602 .665 .752 .802 .826 .815 .870 .955))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Burrows and Okada Experiment model" 2)
        (:table)
        
        (:table)
        "Latence factor F: "      (:string :sy *factor*  4.15)  (:new-row)
        "Mismatch penalty D: "    (:string :sy *penalty* 2.5)           (:new-row)
        "Intercept time (sec.): " (:string :sy *intercept* .5)         
        (: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)

        (:hidden :sy *encode* .4)

        (:new-para)
        
        (:button "Show Experiment Results" "(display-burrows *burrows-data* nil)")
       
        (:new-para)
        
        (:button "Run model" "(progn 
			        (when (numberp *penalty*) 
				   (setf *penalty* (* *penalty* 10))) 
                                (if (and (numberp *penalty*)
                                         (numberp *intercept*) 
                                         (numberp *factor*))
                                   (do-burrows)
                                  (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 to run the model"
        (:new-line)
        "- The trace of a run is approximatly 3k (2 pages) in size"
        (:new-para)))


;;; set-burrows-params is used to set the 
;;; parameters for the model before a run
;;; it is needed for use with the WWW interface

(defun set-burrows-params ()
  (sgp-fct (list :v *v*
                 :lf *factor*  
                 :bll .5 
                 :le 1.0 
                 :an nil 
                 :rt -2.0
                 :mp *penalty*
                 :g 100 
                 :ol t 
                 :act nil
                 :lt t))
  
  (parameters-fct 'encode-target (list :effort *encode*))
  (parameters-fct 'retrieve-yes (list :effort (max 0 (- *intercept* *encode* .05))))
  (parameters-fct 'retrieve-no (list :effort (max 0 (- *intercept* *encode* .05)))))

;;; display-burrows takes two parameters
;;; the list of 8 response times to
;;; display and a flag to specify if the
;;; data is for a simulation
;;; and outputs a display of the
;;; values for the data, in either text, a graph (on the web),
;;; or both, depending on the settings of *text* and *graphic*

(defun display-burrows (times simulation)
  (when simulation
     (format *standard-output* "~%Parameters for simulation: (~S ~S ~S ~S)~%" *factor* *penalty* *encode* *intercept*))

 (when *text*
   (format *standard-output* "~%~a data:~%~%list length        RT (sec)~%" (if simulation "Simulation" "Experimental"))
   (do ((lengths '(2 4 6 8 10 12 16 20) (cdr lengths))
        (rts times (cdr rts)))
       ((null lengths))
     (format *standard-output* "     ~2d           ~4,3f~%" (car lengths) (car rts)))

   (when (and simulation *overlay*)
     (format *standard-output* "~%Experimental data:~%~%list length        RT (sec)~%")
     (do ((lengths '(2 4 6 8 10 12 16 20) (cdr lengths))
          (rts *burrows-data* (cdr rts)))
         ((null lengths))
       (format *standard-output* "     ~2d           ~4,3f~%" (car lengths) (car rts))))

   (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 = 400 
        height = 350> 

        <PARAM name=\"title\" value=\"Data for Burrows and Okada Experiment\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"20\">
        <PARAM name=\"ymax\" value=\"1.0\">
        <PARAM name=\"ymin\" value=\".5\">
        <PARAM name=\"longestline\" value=\"8\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xspacing\" value=\"2\">
        <PARAM name=\"yspacing\" value=\"0.1\">
        <PARAM name=\"xval0\" value=\"2;4;6;8;10;12;16;20;\">
        <PARAM name=\"xname\" value=\"List Length\">
        <PARAM name=\"yname\" value=\"RT sec\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a\">"
            (if (and simulation *overlay*) 2 1)
            (if simulation 2 6553)
            (if simulation "Simulation Data" "Experiment Data"))
    
    (format *standard-output* "<PARAM name=\"yval0\" value=\"")
    
    (dolist (x times)
      (format *standard-output* "~s;" x))
    
    (format *standard-output* "\">")
    
    (when (and *overlay* simulation)
      (format *standard-output* "<PARAM name=\"xval1\" value=\"2;4;6;8;10;12;16;20;\">
        <PARAM name=\"yval1\" value=\"")
      (dolist (x *burrows-data*)
        (format *standard-output* "~S;" x))
      
      (format *standard-output* "\"> 
        <PARAM name=\"lcolor1\" value=\"0\">
        <PARAM name=\"lstyle1\" value=\"6553\">
        <PARAM name=\"name1\" value=\"Experiment Data\">"))
    (format *standard-output* "
             <HR> Your browser does not support JAVA, so you cannot view the graphs.~%
             </HR></applet>")))



;;; make-study-burrows takes one parameter,
;;; the number of items to return, and returns 
;;; the list containing the first n letters of the alphabet

(defun make-study-burrows (n)
  (subseq '(a b c d e f g h i j k l m n o p q r s u) 0 n ))

;;; get-item-burrows returns the chunk
;;; that represents the first item on the 
;;; *target* list, and removes the item
;;; from the list

(defun get-item-burrows ()
  (let ((x (car *target*)))
    (setf *target* (cdr *target*))
    (car (no-output (wm-fct (list x))))))


;;; do-burrows runs the simulation of the burrows
;;; experiment and returns the list of the
;;; results

(defun do-burrows ()
  
  (do ((temp '(2 4 6 8 10 12 16 20) (cdr temp))
       (result nil (cons (run-sternberg-burrows (car temp)) result)))
      ((null temp) (display-burrows (reverse result) t))))

;;; run-sternberg-burrows takes on parameter,
;;; the length of the study set
;;; chunks are created for the study items
;;; the goal is set to recognize an item
;;; the ia's between the study items and the 
;;; letters and list are set
;;; and then the model is run

(defun run-sternberg-burrows (c)
  (setf *target* (make-study-burrows c))
  (reset)
  (set-burrows-params)
  (setallbaselevels 50 -100)
  
  (do ((count 0 (1+ count))
       (temp *target* (cdr temp)) )
      ((= count c) nil) 
    (eval `(add-dm (,(gentemp "C") isa create-token
                    name ,(car temp) list list))))
  
  (setf *target* (list (nth (1- c) '(a b c d e f g h i j k l 
                                             m n o p q r s u))))    
  (eval `(addwm (newgoal isa recognize target encode piece list)))
  (do ((temp (no-output (swm-fct '(isa create-token))) (cdr temp))
       (letters (make-study-burrows c) (cdr letters)))
      ((null temp) nil)
    (setia-fct (list (list (car (no-output (wm-fct (list (car letters)))))
                           (car temp) 1.22)
                     (list 'list (car temp) (- 4.00 (log c)))))) 
  (wmfocus newgoal)
  
  (run))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; This section contains the ACT-R model
;;;

(clearall)

;;; chunk types for the goals

(chunk-type study-words position group count index rc rp rehearse rs)
(chunk-type create-token parent position name list)
(chunk-type recognize piece target retrieved)

;;; chunk types for things

(chunk-type item)
(chunk-type list-item)
(chunk-type plan size next)
(chunk-type position)

(sgp-fct (list  :v t :lf *factor*  :bll .5 :le 1.0 :an nil :rt -2.0
            :mp *penalty* :g 100 :ol t :act nil :lt t))

(add-dm  (plan1 isa plan next plan2)
         (a isa item)(b isa item)(c isa item)(d isa item)(e isa item)
         (f isa item)(g isa item)(h isa item) (i isa item)(j isa item)
         (k isa item)(l isa item)(m isa item)(n isa item)(o isa item)
         (p isa item)(q isa item)(r isa item) (s isa item)(u isa item)
         (plan5 isa plan) (go isa item) (encode isa item)
         (current isa item)
         (list isa list-item)
         (first isa position)(second isa position)(third isa position)
         (fourth isa position)(fifth isa position)
         (plan2 isa plan  next plan3)
         (plan3 isa plan  next plan4)
         (plan4 isa plan  next plan5))

(setallbaselevels 50 -100)

(p encode-target
"
   IF the goal is to recognize and encode
      a word
   THEN set the target slot to the word
"
   =goal>
      isa recognize
      target encode

   !bind! =word (get-item-burrows)
==>
   =goal>
      target =word
)

(parameters-fct 'encode-target (list :effort *encode*))


(p retrieve-trace
"
  IF the goal is to recognize a word
     and a create-token representing 
     the word can be retrieved
  THEN set the goal slot to the retrieved item
"
   =goal>
      isa recognize
    - target encode
    - target nil
      retrieved nil

  =token>
      isa create-token
      name =word
==>
   =goal>
      retrieved =word
)


(p retrieve-yes
"
   IF the goal is to recognize an item
      and the retrieved token matches the
      item presented
   THEN pop the goal
"
   =goal>
      isa recognize
      target =targ
      retrieved =targ
==>
   !pop!
)

(parameters-fct 'retrieve-yes (list :effort (max 0 (- *intercept* *encode* .05))))


(p retrieve-no
"
   IF the goal is to recognize an item
      and the token retrieved does not match the
      item presented
   THEN pop the goal
"
   =goal>
      isa recognize
      target =targ
      retrieved =mem
  
   !eval! (not (equal =targ =mem))
==>
   !pop!
)

(parameters-fct 'retrieve-no (list :effort (max 0 (- *intercept* *encode* .05))))