;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;; This file contains the ACT-R model of the
;;; length-strength effect presented in Chapter 7
;;; 
;;; A WWW interface and a command line interface
;;; are provided.  
;;; To run the command line version, call
;;; (do-len-str n)
;;; replacing n with the number of runs to
;;; simulate.
;;;
;;; requires ACT-R 4.0


;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 *stop-it*)
(defvar *items*)
(defvar *h*)
(defvar *f*)
(defvar *t*)
(defvar *t1*) 
(defvar *t4*)
(defvar *data*)
(defvar *index*)
(defvar *thresh*)
(defvar *penalty*)
(defvar *noise*)
(defvar *d-sim*)
(defvar *v*)
(defvar *runs*)
(defvar *factor*)
(defvar *rehearsals*)
(defvar *respond*)
(defvar *encode*)
(defvar *rehearse*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)

(setf *respond* .5)
(setf *encode* .2)
(setf *rehearse* .5)
(setf *thresh* 1.8)
(setf *penalty* 15)
(setf *noise* .55)
(setf *factor* 2)
(setf *v* nil)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)


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

(defparameter *len-str-cumul* '(-2.58 -2.17 -1.96 -1.81 -1.70 -1.60 -1.51 -1.44 -1.37 -1.31
                -1.25 -1.20 -1.15 -1.10 -1.06 -1.02 -0.97 -0.93 -0.90 -0.86
                -0.82 -0.79 -0.76 -0.72 -0.69 -0.66 -0.63 -0.60 -0.57 -0.54
                -0.51 -0.48 -0.45 -0.43 -0.40 -0.37 -0.34 -0.32 -0.29 -0.27
                -0.24 -0.21 -0.19 -0.16 -0.14 -0.11 -0.09 -0.06 -0.04 -0.01 0))

(defparameter *len-str-d-data* '(2.62 2.32 2.38 1.49 1.48 1.09))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Ratcliff Experiment model" 2)
        (:table)
        
        (:table)
        "Noise (s):"             (:string :sy *noise*   .55)  (:new-row)
        "Threshold:"             (:string :sy *thresh*  1.8)  (:new-row)
        "Latency scale (F):"     (:string :sy *factor*  2)    (:new-row)
        "Penalty:"               (:string :sy *penalty* 1.5)  (:new-row)
        "Response time (sec.): " (:string :sy *respond* .5)        (:new-row)
        "Encoding time (sec.): " (:string :sy *encode* .2)         (:new-row)
        "Rehearsal time (sec.): " (:string :sy *rehearse* .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-len-str *len-str-d-data* nil)")
       
        (:new-para)
        
        (:button "Run model" "(progn 
                                (when (numberp *penalty*) 
                                   (setf *penalty* (* 10 *penalty*)))
                               (if (and (numberp *penalty*) (numberp *thresh*)
                                        (numberp *noise*) (numberp *factor*) 
                                        (numberp *runs*) (numberp *encode*) 
                                        (numberp *rehearse*) 
                                        (numberp *respond*))                  
                                       (do-len-str (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 150k (100 pages) in size"
        (:new-para)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This section contains the LISP functions to simulate
;;; the experiment, and display the results


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

(defun set-len-str-params ()
  (sgp-fct (list  :bll .5 :ans *noise* :mp *penalty* :ol t
            :pm t :rt *thresh* :lf 2 :v *v*))

  (parameters-fct 'attend (list :effort *encode*))
  (parameters-fct 'rehearse-token-1 (list :effort *rehearse*))
  (parameters-fct 'rehearse-token-2 (list :effort *rehearse* :r .9))
  (parameters-fct 'rehearse-token-3 (list :effort *rehearse* :r .8))
  (parameters-fct 'rehearse-skip (list :r .5 :effort *rehearse*))
  (parameters-fct 'attend-test (list :a *encode*))
  (parameters-fct 'accept-word (list :effort *respond*))
  (parameters-fct 'reject-a-word-2 (list :r .5 :effort *respond*))

  (setf *rehearsals* nil))

;;; len-str-innorm takes one parameter,
;;; a probability, and returns the value
;;; from the *len-str-cumul* with the correct
;;; sign for calculation of the d' value

(defun len-str-innorm (p)
  (let ((index (round (* p 100))))
    (cond ((> index 50) (* -1 (nth (- 100 index) *len-str-cumul*)))
          ((< index 50) (nth index *len-str-cumul*))
          (t 0))))

;;; len-str-setup takes 2 parameters,
;;; a word to add to memory,
;;; and the number of memory-tokens that
;;; should be created for the word.
;;; each memory-token is created with a
;;; different context
 
(defun len-str-setup (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 *len-str-contexts*)
                             name ,word) result)))
      ((= count n) result)))


;;; display-len-str takes two parameters
;;; the results data to display and a flag to specify if the
;;; data is for a simulation
;;; and outputs a display of the d'
;;; values for the data, in either text, a graph (on the web),
;;; or both, depending on the settings of *text* and *graphic*

(defun display-len-str (data simulation)
  (when simulation 
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S ~S ~S ~S ~S)~%" 
            *noise* *thresh* *factor* (/ *penalty* 10.0) *respond* *encode* *rehearse* *runs*))
  
  (when *text*
    (format *standard-output* "~%~%~a d' values:~%" (if simulation "Simulation" "Experimental"))
    (format t "10PS    16PS    16MS    16MW    16PW    40PW~%")  
    (dolist (x data)
      (format *standard-output* "~4,2F    " x))
    (format *standard-output* "~%")
    
    (when (and simulation *overlay*)
      (format *standard-output* "~%Experimental d' values:~%")
      (format t "10PS    16PS    16MS    16MW    16PW    40PW~%")  
      (dolist (x *len-str-d-data*)
        (format *standard-output* "~4,2F    " 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 = 500 
        height = 400> 
        <PARAM name=\"title\" value=\"Data for Length Strength Experiment\">
        <PARAM name=\"xmin\" value=\"1\">
        <PARAM name=\"xmax\" value=\"6\">
        <PARAM name=\"ymax\" value=\"4\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"ydiv\" value=\"0.5\">
        <PARAM name=\"yspacing\" value=\"1\">
        <PARAM name=\"xval0\" value=\"1;2;3;4;5;6;\">
        <PARAM name=\"xname\" value=\"Condition\">
        <PARAM name=\"yname\" value=\"D prime\">
        <PARAM name=\"numxlabels\" value=\"6\">
        <PARAM name=\"numlines\" value=\"~s\">
        <PARAM name=\"longestline\" value=\"6\">
        <PARAM name=\"xlabels\" value=\"10PS;16PS;16MS;16MW;16PW;40PW;\">
        <PARAM name=\"widestxlabel\" value=\"WWWW\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a\">" 
            (if (and *overlay* simulation) 2 1)
            (if simulation 2 6553)
            (if simulation "Simulation Data" "Experiment Data"))
    
    (format *standard-output* "<PARAM name=\"yval0\" value=\"")
    
    (dolist (x data)
      (format *standard-output* "~s;" x))
    
    (format *standard-output* "\">")
    
    (when (and *overlay* simulation)
      (format *standard-output* "<PARAM name=\"yval1\" value=\"")
      (dolist (x *len-str-d-data*)
        (format *standard-output* "~S;" x))
      
      (format *standard-output* "\"> 
        <PARAM name=\"lcolor1\" value=\"0\">
        <PARAM name=\"lstyle1\" value=\"6553\">
        <PARAM name=\"xval1\" value=\"1;2;3;4;5;6;\">
        <PARAM name=\"name1\" value=\"Experiment Data\">"))
    (format *standard-output* "
             <HR> Your browser does not support JAVA, so you cannot view the graphs.~%
             </HR></applet>")))




;;; do-len-str takes one parameter n, 
;;; the number of runs through the experiment
;;; to simulate, and then performs that many simulations 
;;; setting the global variable *d-sim* to the
;;; d' results and displays the d' results

(defun do-len-str (n)
    (setf *data* (make-array '(6 2 2) :initial-element 0))
    (do ((count 0 (1+ count)))
        ((= count n) 
         (do ((i 0 (1+ i))
              (result nil (cons (len-str-d-prime *data* i) result)))
             ((= i 6) (setf *d-sim* (reverse result))
              (display-len-str *d-sim* t))))
      (reset) (set-len-str-params)(run-len-str-exp-10-4)
      (reset) (set-len-str-params)(run-len-str-exp-16-4) 
      (reset) (set-len-str-params)(run-len-str-exp-16-mixed)
      (reset) (set-len-str-params)(run-len-str-exp-16-mixed)
      (reset) (set-len-str-params)(run-len-str-exp-16-mixed)
      (reset) (set-len-str-params)(run-len-str-exp-16-1)
      (reset) (set-len-str-params)(run-len-str-exp-40-1)))


;;; len-str-d-prime takes two parameters,
;;; an array of data and the first index into the
;;; array, and returns the d-prime value for the 
;;; condition at the index in the array

(defun len-str-d-prime (array index)
  (let* ((pt (/ (aref array index 0 0) (+ (aref array index 0 0) 
                                          (aref array index 0 1))))
         (pf (/ (aref array index 1 0) (+ (aref array index 1 0)
                                          (aref array index 1 1)))))
    (- (len-str-innorm pt) (len-str-innorm pf))))


;;; len-str-setup-materials takes one
;;; parameter, the number of words to add
;;; to the memory.  The words are generated
;;; and added to memory with the appropriate
;;; memory tokens.

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

;;; run-len-str-exp-16-1
;;; sets up the memory items and
;;; runs the 16PW condition of the experiment

(defun run-len-str-exp-16-1 ()  
  (setf *index* 4)
   (let* ((materials (len-str-setup-materials 32))
          (study (nthcdr 16 materials))
          (test (nthcdr 16 (reverse materials))))
     (setsimilarities (l0 l1 .9)(l0 l2 .9)(l0 l3 .9)
                 (l1 l2 .9)(l1 l3 .9))
    (setf *stop-it* 0) 
    (setf *t* (no-output (wm-fct study)))
    (setf *f* (no-output (wm-fct test)))
    (addwm (goal isa study-words context L0))
    (setf *items* *t*)
    (wmfocus goal) (sgp :pm nil)
    (run)
    (setf *items* (len-str-permut (append *t* *f*))) (actr-time 30)
    (addwm (newgoal isa recognize-words context L0))
    (do ((temp *t* (cdr temp)))
        ((null temp) nil)
      (no-output (setia-fct (list (list 'l0 (car (sdm-fct (list 'isa 'memory-token 
                                                            'name (car temp) 'context 'l0)))
                             (- 4.5 (log 16)))))))
    (wmfocus newgoal) (sgp :pm t)
    (run)))

;;; run-len-str-exp-16-mixed
;;; sets up the memory items and
;;; runs the 16MS and 16MW conditions of the experiment

(defun run-len-str-exp-16-mixed ()  
  (setf *index* 2)
   (let* ((materials (len-str-setup-materials 32))
          (study (nthcdr 16 materials))
          (ones (nthcdr 8 study))
          (fours (nthcdr 8 (reverse study)))
          (test (nthcdr 16 (reverse materials))))
     (setsimilarities (l0 l1 .9)(l0 l2 .9)(l0 l3 .9)
                 (l1 l2 .9)(l1 l3 .9))
    (setf *stop-it* 0) 
    (setf *t1* (no-output (wm-fct ones)))
    (setf *t4* (no-output (wm-fct fours)))
    (setf *t* (append *t1* *t4*))
    (setf *f* (no-output (wm-fct test)))
    (addwm (goal isa study-words context L0))
    (setf *items* (len-str-permut (append *t1* *t4* *t4* *t4* *t4*)))
    (wmfocus goal) (sgp :pm nil)
    (run) 
    (setf *items* (len-str-permut (append *t1* *t4* *f*))) (actr-time 30)
    (addwm (newgoal isa recognize-words context L0))
    (do ((temp *t* (cdr temp)))
        ((null temp) nil)
      (no-output (setia-fct (list (list 'l0 (car (sdm-fct (list 'isa 'memory-token 
                                                            'name (car temp) 'context 'l0)))
                             (- 4.5 (log 16)))))))
    (wmfocus newgoal) (sgp :pm t)
    (run)))

;;; run-len-str-exp-40-1
;;; sets up the memory items and
;;; runs the 40PW condition of the experiment

(defun run-len-str-exp-40-1 ()  
  (setf *index* 5)
   (let* ((materials (len-str-setup-materials 60))
          (study (nthcdr 20 materials))
          (test (nthcdr 20 (reverse materials))))
     (setsimilarities (l0 l1 .9)(l0 l2 .9)(l0 l3 .9)
                 (l1 l2 .9)(l1 l3 .9))
    (setf *stop-it* 0) 
    (setf *f* (no-output (wm-fct (nthcdr 20 test))))
    (setf *t* (no-output (wm-fct (nthcdr 20 (reverse test)))))
    (addwm (goal isa study-words context L0))
    (setf *items* (len-str-permut (no-output (wm-fct study))))
    (wmfocus goal) (sgp :pm nil)
    (run)
    (setf *items* (len-str-permut (append *t* *f*))) (actr-time 30)
    (addwm (newgoal isa recognize-words context L0))
    (do ((temp *t* (cdr temp)))
        ((null temp) nil)
      (no-output (setia-fct (list (list 'l0 (car (sdm-fct (list 'isa 'memory-token 
                                                            'name (car temp) 'context 'l0)))
                             (- 4.5 (log 40)))))))
    (wmfocus newgoal)(sgp :pm t)
    (run)))

;;; run-len-str-exp-16-4
;;; sets up the memory items and
;;; runs the 16PS condition of the experiment

(defun run-len-str-exp-16-4 ()  
  (setf *index* 1)
   (let* ((materials (len-str-setup-materials 32))
          (study (nthcdr 16 materials))
          (test (nthcdr 16 (reverse materials))))
     (setsimilarities (l0 l1 .9)(l0 l2 .9)(l0 l3 .9)
                 (l1 l2 .9)(l1 l3 .9))
    (setf *stop-it* 0) 
    (setf *t* (no-output (wm-fct study)))
    (setf *f* (no-output (wm-fct test)))
    (addwm (goal isa study-words context L0))
    (setf *items* (append (len-str-permut *t*) (len-str-permut *t*) (len-str-permut *t*) (len-str-permut *t*)))
    (wmfocus goal) (sgp :pm nil)
    (run)
    (setf *items* (len-str-permut (append *t* *f*))) (actr-time 30)
    (addwm (newgoal isa recognize-words context L0))
    (do ((temp *t* (cdr temp)))
        ((null temp) nil)
      (no-output (setia-fct (list (list 'l0 (car (sdm-fct (list 'isa 'memory-token 
                                                            'name (car temp) 'context 'l0)))
                             (- 4.5 (log 16)))))))
    (wmfocus newgoal) (sgp :pm t)
    (run)))

;;; run-len-str-exp-10-4
;;; sets up the memory items and
;;; runs the 10PS condition of the experiment

(defun run-len-str-exp-10-4 ()  
  (setf *index* 0)
   (let* ((materials (len-str-setup-materials 20))
          (study (nthcdr 10 materials))
          (test (nthcdr 10 (reverse materials))))
     (setsimilarities (l0 l1 .9)(l0 l2 .9)(l0 l3 .9)
                 (l1 l2 .9)(l1 l3 .9))
    (setf *stop-it* 0) 
    (setf *t* (no-output (wm-fct study)))
    (setf *f* (no-output (wm-fct test)))
    (addwm (goal isa study-words context L0))
    (setf *items* (append (len-str-permut *t*) (len-str-permut *t*) (len-str-permut *t*) (len-str-permut *t*)))
    (wmfocus goal) (sgp :pm nil)
    (run ) 
    (setf *items* (len-str-permut (append *t* *f*))) (actr-time 30)
    (addwm (newgoal isa recognize-words context L0))
    (do ((temp *t* (cdr temp)))
        ((null temp) nil)
      (no-output (setia-fct (list (list 'l0 (car (sdm-fct (list 'isa 'memory-token 
                                                            'name (car temp) 'context 'l0)))
                             (- 4.5 (log 10)))))))
    (wmfocus newgoal)(sgp :pm t) 
    (run)))

(defun prob-len-str (word s tau)
  (let ((xx (no-output (eval `(swm isa memory-token name ,word)))))
    (do ((temp xx (cdr temp))
         (result 0 (+ result (exp (/ (c-activation-len-str (car temp) (/ *penalty* 10))
                                     s)))))
        ((null temp) (/ result (+ result (exp (/ tau s))))))))

(defun c-activation-len-str (token d) 
  (let ((act (apply '+ (car (no-output (eval `(sdp ,token :base-level :source-spread)))))))
     (cond ((equal (no-output (car (dm l0))) (eval `(chunk-slot-value ,token context)))
            act)
           (t (- act d)))))

;;; len-str-analyze takes two parameters,
;;; a test word, and a response, and
;;; updates the results for the experiment
;;; based on the models response to the word
        
(defun len-str-analyze (word response)
  (let* ((i) 
         (prob (prob-len-str word *noise* *thresh*)) 
         (q (- 1.0 prob)))
    (cond ((= *index* 2) 
           (cond ((member word *t4*)    
                  (setf (aref *data* 2 0 0)
                        (+ prob (aref *data* 2 0 0)))
                  (setf (aref *data* 2 0 1)
                        (+ q (aref *data* 2 0 1))))
                 ((member word *t1*) 
                  (setf (aref *data* 3 0 0)
                        (+ prob (aref *data* 3 0 0)))
                  (setf (aref *data* 3 0 1)
                        (+ q (aref *data* 3 0 1))))
                 ((member word *f*)    
                  (setf (aref *data* 2 1 0)
                        (+ prob (aref *data* 2 1 0)))
                  (setf (aref *data* 2 1 1)
                        (+ q (aref *data* 2 1 1)))
                  (setf (aref *data* 3 1 0)
                        (+ prob (aref *data* 3 1 0)))
                  (setf (aref *data* 3 1 1)
                        (+ q (aref *data* 3 1 1))))))
          (t (cond 
          ((member word *t*)(setf i 0))
          ((member word *f*)(setf i 1)))
             (setf (aref *data* *index* i 0)
                 (+ prob (aref *data* *index* i 0)))
             (setf (aref *data* *index* i 1) 
                   (+ q (aref *data* *index* i 1)))))))


;;; len-str-get-word 
;;; increments the time until the next word is to
;;; be presented, and returns the current word to study

(defun len-str-get-word ()
  (setf *stop-it* (+ 1.25 *stop-it*))
   (pop *items*))
    
    
;;; len-str-permut takes one parameter, 
;;; a list, and returns the list in random order

(defun len-str-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 :count 1))
    (cond ((null lis) (return result)))))
       
;;; update-rehearsals-len-str takes one parameter
;;; and increments the count of how many times that
;;; word has been rehearsed

(defun update-rehearsals-len-str (x)
  (let ((result (assoc x *rehearsals* :test 'equal)))
    (cond ((null result) (setf *rehearsals* (cons (cons x 1) *rehearsals*)))
          (t (rplacd result (1+ (cdr result)))))))

;;; rehearsal-count-len-str takes one parameter,
;;; a word from the study, and returns how many times
;;; that word has been rehearsed

(defun rehearsal-count-len-str (x)
  (let ((result (assoc x *rehearsals* :test 'equal)))
    (cond ((null result) 0)
          (t  (cdr result)))))


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

(clearall)


(sgp-fct (list  :bll .5 :ans *noise* :mp *penalty* :ol t
            :pm t :rt *thresh* :lf 2 :v *v*))

(setf *rehearsals* nil)

;;; memory types for the model

(wmetype study-words count context)
(wmetype recognize-words context target)
(wmetype memory-token name context)
(wmetype context)
(wmetype word)


;;; add the contexts to memory

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

;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; productions

(p attend
"
  IF the goal is to study words
     and there are items to study
     and it is not past time for this word
  THEN create a new memory-token with the 
     current context and push it as a goal
"
   =goal>
      isa study-words
      context =context

   !eval! (>= (actr-time) *stop-it*)
   !eval! *items*
==>
   =newgoal>
      isa memory-token
      context =context
   =goal>
      count =newgoal

   !push! =newgoal
)

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


(p create-token
"
  IF the goal is to create a memory token
  THEN get the current word 
     and store it in the memory token
     and pop the goal
"
   =goal>
      isa memory-token
      context =context
==>
   =goal>
      name (!eval! (len-str-get-word))

   !pop!
)


(p rehearse-token-1
"
  IF the goal is to study words
     and there is still time to study this word
     and there is a memory token with the
     current context that has not been
     rehearsed yet 
  THEN update the number of rehearsals for that word
"
   =goal>
      isa study-words
      count =n
      context =context

   !eval! (< (actr-time) *stop-it*)

   =memory>
      isa memory-token
      name   =name
      name (!eval! (if (< (rehearsal-count-len-str =name) 1) =name))
      context  =context
==>
   !eval! (update-rehearsals-len-str =name)
)

(parameters-fct 'rehearse-token-1 (list :effort *rehearse*))


(p rehearse-token-2
"
  IF the goal is to study words
     and there is still time to study this word
     and there is a memory token with the
     current context that has been
     rehearsed at most 1 time 
  THEN update the number of rehearsals for that word
"
   =goal>
      isa study-words
      count =n
      context =context

   !eval! (< (actr-time) *stop-it*)

   =memory>
      isa memory-token
      name   =name
      name (!eval! (if (< (rehearsal-count-len-str =name) 2) =name))
      context  =context
==>
   !eval! (update-rehearsals-len-str =name)
)

(parameters-fct 'rehearse-token-2 (list :effort *rehearse* :r .9))


(p rehearse-token-3
"
  IF the goal is to study words
     and there is still time to study this word
     and there is a memory token with the
     current context that has been
     rehearsed at most 2 times
  THEN update the number of rehearsals for that word
"
   =goal>
      isa study-words
      count =n
      context =context

   !eval! (< (actr-time) *stop-it*)

   =memory>
      isa memory-token
      name   =name
      name (!eval! (if (< (rehearsal-count-len-str =name) 2) =name))
      context  =context
==>
   !eval! (update-rehearsals-len-str =name)
)

(parameters-fct 'rehearse-token-3 (list :effort *rehearse* :r .8))


(p rehearse-skip
"
  IF the goal is to study words
     and there is time left to study
  THEN do nothing
"
   =goal>
      isa study-words
      count =n
      context =context

   !eval! (< (actr-time) *stop-it*)
==>
)

(parameters-fct 'rehearse-skip (list :r .5 :effort *rehearse*))


(p attend-test
"
  IF the goal is to recognize words
     and there are words left
  THEN mark the goal to probe the target item
"
    =goal>
       isa recognize-words
       target nil

   !eval! *items*
==>
    =goal>
       target t
)

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


(p probe-token
"
   IF the goal is to probe a target item
   THEN place the item in the goal
"
   =goal>
      isa recognize-words
      target t
==>
   =goal>
      target (!eval! (len-str-get-word))
)


(p accept-word
"
  IF the goal is to recognize a word in
     the current context
     and there is a memory token of that 
     word in this context
  THEN respond yes
     and mark the goal as responded
"
   =goal>
      isa recognize-words
      target =word
   -  target t
      context =context

   =token>
      isa memory-token
      name =word
      context =context
==>
   !eval! (len-str-analyze =word 'yes)

   =goal>
      target nil
)

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


(p reject-a-word-2
"
  IF the goal is to recognize a word in 
     the current context
  THEN respond no 
     and mark the goal as responed
"
   =goal>
      isa recognize-words
      target =word
      context =context
==>
   !eval! (len-str-analyze =word 'no)

   =goal>
      target nil
)

(parameters-fct 'reject-a-word-2 (list :r .5 :effort *respond*))