;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;; This file contains the ACT-R model of the
;;; raeburn task presented in Chapter 7
;;;
;;; ACT-R version 4 required
;;; 
;;; A WWW interface and a command line interface
;;; are provided.  
;;; To run the command line version, call
;;; (run-raeburn)

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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*)
(defvar *encode*)
(defvar *intercept*)
(defvar *say-it*)
(defvar *v* nil)
(defvar *penalty*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)

(setf *factor* 2.35)
(setf *encode* .2)
(setf *say-it* .50)
(setf *v* nil)
(setf *intercept* .6)
(setf *penalty* 25)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)


;;; time to reccognize by positions - foil as last one
;;; list length -1 items presented

(defparameter *raeburn-data* '((.658 .692 .667 .717) 
                              (.726 .718 .691 .660 .754)
                              (.733 .758 .752 .726 .663 .780)
                              (.780 .812 .819 .758 .765 .692 .853)))



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

(defvar *local-symbols*)

(setf *local-symbols*
      '(*stop-it*
        *plan*
        *target*
        *results* 
        *factor*
        *encode*
        *say-it*
        *v*
        *intercept*
        *precord*
        *text*
        *graphic*))

(defvar *WWW-interface*)

(setf  *WWW-interface* 
      '((:heading "Raeburn recognition model" 2)
        (:table)
        
        (:table)
        "Latence factor F: "     (:string :sy *factor*   2.35)  (:new-row)
        "Mismatch penalty D:"    (:string :sy *penalty* 2.5) (:new-row)
        "Encode time (sec):"     (:string :sy *encode*   .2)    (:new-row)
        "Rehersal time (sec): "  (:string :sy *say-it* .5)  (:new-row)
        "Intercept time (sec):"  (:string :sy *intercept* .6)
        (: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-raeburn-data *raeburn-data* nil)")
       
        (:new-para)
        
        (:button "Run model" "(progn 
                                (when (numberp *penalty*) 
                                   (setf *penalty* (* 10 *penalty*)))
                               (if (and (numberp *factor*)
                                        (numberp *encode*) 
                                        (numberp *intercept*) 
                                        (numberp *say-it*) 
                                        (numberp *penalty*))
                                  (run-raeburn) 
                                 (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 50k (35 pages) in size"
        (:new-para)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This section contains the functions to simulate
;;; the experiment and call the ACT-R model


;;; display-raeburn-data takes two parameters,
;;; the lists of response times for the experiment and
;;; a flag to indicate if the data is for the simulation
;;; then displays a table of the results and possibly
;;; a graph (on the web) depending on the settings of 
;;; *text* and *graphic*

(defun display-raeburn-data (data simulation)
  (when simulation
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S ~S)"
            *factor* (/ *penalty* 10) *encode* *say-it* *intercept*))

  (when *text*
    (format *standard-output* "~%~%~a data:~%~%" (if simulation "Simulation" "Experimental"))

    (let ((count 3))
      (format *standard-output* "Response time in milliseconds~%")
      (format *standard-output* "                   Position~%")
      (format *standard-output* "            1      2      3      4      5      6      Foil~%")
      (format *standard-output* "Set Size~%")
      (dolist (x data)
        (format *standard-output* "   ~S      " count)
        (do ((i 0 (1+ i)))
            ((= i 7))
          (if (= i 6)
              (format *standard-output* "~5,0F  " (* 1000 (nth count x)))
              (if (< i count)
                  (format *standard-output* "~5,0F  " (* 1000 (nth i x)))
                  (format *standard-output* "       "))))
        (incf count)
        (format *standard-output* "~%")))
    
    (when (and simulation *overlay*)
      (format *standard-output* "~%~%Experimental data:~%~%")
      
      (let ((count 3))
        (format *standard-output* "Response time in milliseconds~%")
        (format *standard-output* "                   Position~%")
        (format *standard-output* "            1      2      3      4      5      6      Foil~%")
        (format *standard-output* "Set Size~%")
        (dolist (x *raeburn-data*)
          (format *standard-output* "   ~S      " count)
          (do ((i 0 (1+ i)))
              ((= i 7))
            (if (= i 6)
                (format *standard-output* "~5,0F  " (* 1000 (nth count x)))
                (if (< i count)
                    (format *standard-output* "~5,0F  " (* 1000 (nth i x)))
                    (format *standard-output* "       "))))
          (incf count)
          (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 = 600> 

        <PARAM name=\"title\" value=\"Data for Raeburn Experiment\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"6\">
        <PARAM name=\"ymax\" value=\"1000\">
        <PARAM name=\"ymin\" value=\"500\">
        <PARAM name=\"ydiv\" value=\"50\">
        <PARAM name=\"yspacing\" value=\"100\">
        <PARAM name=\"numxlabels\" value=\"7\">
        <PARAM name=\"numlines\" value=\"~s\">
        <PARAM name=\"longestline\" value=\"7\">
        <PARAM name=\"xlabels\" value=\"Foil;1;2;3;4;5;6;\">
        <PARAM name=\"widestxlabel\" value=\"Foil\">
        <PARAM name=\"xval0\" value=\"0;1;2;3;\">
        <PARAM name=\"xval1\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval2\" value=\"0;1;2;3;4;5;\">
        <PARAM name=\"xval3\" value=\"0;1;2;3;4;5;6;\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lcolor3\" value=\"3\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"lstyle3\" value=\"~s\">
        <PARAM name=\"xname\" value=\"Position\">
        <PARAM name=\"yname\" value=\"RT msec\">"
            (if (and simulation *overlay*) 8 4)
            (if simulation 2 6553)
            (if simulation 2 6553)
            (if simulation 2 6553)
            (if simulation 2 6553)
)

    (dotimes (i 4)
      (format *standard-output* "<PARAM name=\"name~s\" value=\"~a size = ~s\">"
              i (if simulation "Simulation Data" "Experiment Data") (+ i 3))
    
      (format *standard-output* "<PARAM name=\"yval~s\" value=\"~6,1f;" i (* 1000 (car (last (nth i data)))))
      (dotimes (j (+ i 3))
        (format *standard-output* "~6,1f;" (* 1000 (nth j (nth i data)))))
      (format *standard-output* "\">"))

    (when (and simulation *overlay*)
      
      (dotimes (i 4)
        (format *standard-output* "
        <PARAM name=\"lcolor4\" value=\"0\">
        <PARAM name=\"lcolor5\" value=\"1\">
        <PARAM name=\"lcolor6\" value=\"2\">
        <PARAM name=\"lcolor7\" value=\"3\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"lstyle6\" value=\"6553\">
        <PARAM name=\"lstyle7\" value=\"6553\">
        <PARAM name=\"xval4\" value=\"0;1;2;3;\">
        <PARAM name=\"xval5\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval6\" value=\"0;1;2;3;4;5;\">
        <PARAM name=\"xval7\" value=\"0;1;2;3;4;5;6;\">")

        (format *standard-output* "<PARAM name=\"name~s\" value=\"Experimental Data size = ~s\">"
               (+ 4 i)  (+ i 3))
        
        (format *standard-output* "<PARAM name=\"yval~s\" value=\"~6,1f;" (+ 4 i) (* 1000 (car (last (nth i *raeburn-data*)))))
        (dotimes (j (+ i 3))
          (format *standard-output* "~6,1f;" (* 1000 (nth j (nth i *raeburn-data*)))))
        (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>")))


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

(defun set-raeburn-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))
  
  (setf *pop-upon-failure* nil)

  (parameters-fct 'rehearse-item (list :effort *say-it* :a *say-it*))
  (parameters-fct 'rehearse-current (list :effort *say-it* :a *say-it*))
  
  (parameters-fct 'attend-start (list :effort *encode* :a 2))
  (parameters-fct 'attend (list :effort *encode* :a 2))
  
  
  (parameters-fct 'encode-target (list :effort *encode*))
  (parameters-fct 'retrieve-yes (list :effort (- *intercept* *encode* .05)))
  (parameters-fct 'retrieve-no (list :effort (- *intercept* *encode* .05)))
  
  (setallbaselevels 50 -100))

;;; plan-raeburn takes one parameter
;;; the number of items to present
;;; and returns a list of the number of items in each
;;; group for the presentation of that many
;;; study items

(defun plan-raeburn (n)
  (case n
    (3 '(3))
    (4 '(4))
    (5 '(3 2))
    (6 '(3 3))
    (7 '(3 4))
    (8 '(3 3 2))
    (9 '(3 3 3))
    (10 '(3 3 4))
    (11 '(3 3 3 2))
    (12 '(3 3 3 3))))

;;; make-study-raeburn takes one parameter
;;; the number of items in the study set,
;;; and returns a list of the first n letters
;;; in the alphabet

(defun make-study-raeburn (n)
  (subseq '(a b c d e f g h i j) 0 n))

;;; get-item-raeburn takes no parameters
;;; the first item on the *target* list
;;; is removed, and the chunk that represents
;;; it is returned

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

;;; run-raeburn takes no parameters,
;;; and runs the simulation of the raeburn
;;; experiment, displaying the output in 
;;; a table

(defun run-raeburn ()
  (do ((length 3 (1+ length))
       (result nil (cons (raeburn-help length) result)))
      ((> length 6) (setf *results* (reverse result))))
  (display-raeburn-data *results* t))

;;; raeburn-help takes one parameter,
;;; the length of the list to test,
;;; and runs the test for each position
;;; in the list, and a foil
;;; returning a list of the results of the 
;;; tests

(defun raeburn-help (length)
  (do ((position 1 (1+ position))
       (result nil (cons (run-sternberg-raeburn length position) result)))
      ((> position length) 
       (reverse (cons (run-sternberg-raeburn length nil) result)))))

;;; run-sternberg-raeburn takes two parameters,
;;; the length of the study set
;;; and the index of the target item
;;; a goal is set to study the items, 
;;; and then the model is run for the study phase
;;; then 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
;;; to recgnize the item or not
;;; returning the time of the recognition
;;; phase

(defun run-sternberg-raeburn (c target)
  (setf *plan* (plan-raeburn c))
  (setf *precord* *plan*)
  (setf *target* (make-study-raeburn c))
  (reset)
  (set-raeburn-params )
  (addwm (goal isa study-words index list group start 
               count 0 position first rc first rp first))
  (do ((count 0 (1+ count)))
      ((equal count c) ) 
    
    (setf *stop-it* (* 1.5 (1+ count))) 
    
    (wmfocus goal) 
    (run))           
  
  (cond (target (setf *target* (list (nth (1- target)
                                                  '(a b c d e f g h i j)))))
        (t (setf *target* (list 'z))))
  
  (addwm (newgoal isa recognize target encode piece list))
  (do ((temp (no-output (swm isa create-token)) (cdr temp))
       (letters (make-study-raeburn 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)
  
  (actr-time-fct (+ 1.2 (- (* 1.5 c) (actr-time))))
  
  (run))

;;; pos-raeburn takes one parameter,
;;; a position chunk, and returns the 
;;; number of the corresponding index

(defun pos-raeburn (pos) 
  
  (position  pos
            '(start first second third fourth fifth)))

;;; next-count-raeburn takes no parameters nad
;;; returns the number of items in the next group

(defun next-count-raeburn () 
  (let ((ans (car *plan*)))
    (setf *plan* (cdr *plan*))
    ans))

;;; next-position-raeburn takes one parameter,
;;; a position chunk, and returns the position
;;; chunk that comes next in the order
 
(defun next-position-raeburn (x)
  
 (car (no-output (wm-fct (list (case x
                                  (start 'first)
                                  (first 'second)
                                  (second 'third)
                                  (third 'fourth)
                                  (fourth 'fifth)))))))
 
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; This section contains the ACT-R
;;; model for the task


(clearall)

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

;;; chunk types for the goals

(chunk-type study-words position group count index rc rp rehearse rs)
(chunk-type recognize piece target retrieved)

;;; chunk types for the things

(chunk-type group list position size)
(chunk-type item)
(chunk-type plan size next)
(chunk-type position)
(chunk-type create-token parent position name list recalled (eval 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)
         (z isa item) (plan5 isa plan) (go isa item) (encode isa item)
         (current isa item) (list isa item) (start isa position)
         (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 attend
"
  IF the goal is to study words
     and there are words to study
  THEN create a chunk to encode the current word
     and mark the goal to rehearse 
     and decrement the number of words to study
" 
   =goal>
      isa study-words
      rehearse nil
      index =index
      group =group
      position =pos
      count =count
   
   !eval! (> =count 0)

   !bind! =name (get-item-raeburn)
==>
   =newgoal>
      isa create-token
      list =index
      parent =group
      position =pos
      name =name

   =goal>
      rehearse 1
      position (!eval! (next-position-raeburn =pos))
      count (!eval! (1- =count))
)

(parameters-fct 'attend (list :effort *encode* :a 2))


(p attend-start
"
  IF the goal is to study words
     and this is the first word of the list
  THEN create a chunk to encode the group of words
     and create a chunk to encode the current word
     and mark the goal to rehearse
     and mark the goal with the count of words remaining
"
   =goal>
      isa study-words
      rehearse nil
      index =index
      group =group
      count 0

   !bind! =count (next-count-raeburn)

   !bind! =name (get-item-raeburn)
==>
   !bind! =newgroup  (next-position-raeburn =group)

   =thing>
      isa group
      position =newgroup
      list =index
      size =count

   =newgoal>
      isa create-token
      list =index
      parent =newgroup
      position first
      name =name

   =goal>
       rehearse 1
       position second
       group =newgroup
       count (!eval! (1- =count))
)

(parameters-fct 'attend-start (list :effort *encode* :a 2))


(p rehearse-current
"
  IF the goal is to rehearse the current item 
     and an item can be recalled
  THEN mark the goal to rehearse other items
"
   =goal>
      isa study-words
      rehearse 1
      index =index
      position =pos
      group =group

   =item>
      isa create-token
      parent =group2
      list =index
      position =pos2
      eval (!eval! (and (equal  =group  =group2) 
               (equal  =pos  (next-position-raeburn =pos2))))
==>
   =goal>
      rehearse 2
)

(parameters-fct 'rehearse-current (list :effort *say-it* :a *say-it*))


(p rehearse-item
"
  IF the goal is to rehearse items other than the current
     and an item can be recalled
  THEN update the rehersal position in the goal
"
   =goal>
      isa study-words
      rehearse 2
      index =index
      rp =pos
      rc =group
      position =pos1
      group =group1

   !eval! (not (and (equal =pos1 =pos) (equal =group1 =group)))

   =item>
      isa create-token
      parent =group2
      list =index
      position =pos2
      eval (!eval! (and (equal  =group  =group2) 
               (equal  =pos  =pos2)))
==>
   =goal>
       rp (!eval! (next-position-raeburn =pos))
)

(parameters-fct 'rehearse-item (list :effort *say-it* :a *say-it*))


(p rehearse-next-group
"
  IF the goal is to study items other than the current
     and the position to rehearse is in the next group
  THEN mark the goal to rehearse the first item in
     the next group
"
   =goal>
      isa study-words
      rehearse 2
      index =index
      group =group
      rc =rgroup
      rp =pos

   !eval! (< (pos-raeburn =rgroup) (pos-raeburn =group))

   !eval! (> (pos-raeburn =pos) 3)
==>
   =goal>
      rc (!eval! (next-position-raeburn =rgroup))
      rp first
)


(p rehearse-reset
"
  IF the goal is to study words other than the current
     and all of the words have been rehearsed
  THEN mark the goal to rehearse from the start
"
   =goal>
      isa study-words
      rehearse 2
      index =index
      group =group
      rc =group
      rp =pos
      position =pos
==>
   =goal>
      rc first
      rp first
)


(p rehearse-abort-last
"
  IF the goal is to rehearse words
     and the time for the current word is over
     and this is the last word
     and an item can be recalled
  THEN mark the goal to stop rehearsing
"
   =goal>
      isa study-words
      rehearse 2
      position =pos
      group =group

   !eval! (and (>= *time* *stop-it*) 
             (equal *stop-it* (* 1.5 (apply '+ *precord*))))

   =item>
      isa create-token
      parent =group2
      list =index
      position =pos2
      eval (!eval! (and (equal  =group  =group2) 
               (equal  =pos  (next-position-raeburn =pos2))))
==>
   =goal>
      rehearse nil

   !pop!
)

(parameters rehearse-abort-last :a 0)


(p rehearse-abort
"
  IF the goal is to rehearse words
     and the time for the word has passed
  THEN mark the goal to stop rehearsing
"
   =goal>
      isa study-words
      rehearse 2

   !eval! (>= *time* *stop-it*)
==>
   =goal>
      rehearse nil

   !pop!
)

(parameters rehearse-abort :a 0)


(p encode-target
"
  IF the goal is to encode a target item
  THEN mark the item as the target in the goal
"
   =goal>
      isa recognize
      target encode

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

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


(p retrieve-trace
"
  IF the goal is to recognize an item
     and the most active item from memory is retrieved
  THEN mark the goal with the item retrieved
"
   =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 item retrieved from memory matches
     the item displayed
  THEN pop the goal 
"
   =goal>
      isa recognize
      target =targ
      retrieved =targ
==>
   !pop!
)

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


(p retrieve-no
"
  IF the goal is to recognize an item 
     and the item retrieved from memory does not match
     the item displayed
  THEN pop the goal 
"
   =goal>
      isa recognize
      target =targ
      retrieved =mem

   !eval! (not (equal =targ =mem))
==>
   !pop!
)

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