;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;;; This file contains the ACT-R model of the
;;; serial recall 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
;;; (output-batch-recall-data (run-batch-recall-experiment 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 *length* nil)
(defvar *precord* nil)
(defvar *tflag* nil)
(defvar *answer* nil)
(defvar *plan* nil)
(defvar *target* nil)
(defvar *data* nil)
(defvar *stop-it* nil)
(defvar *acc*)
(defvar *runs*)
(defvar *sf*)
(defvar *s*)
(defvar *threshold*)
(defvar *key*)
(defvar *say-it*)
(defvar *penalty*)   
(defvar *factor*)
(defvar *exponent* )
(defvar *v*)
(defvar *encode*)

(setf *sf* .50)
(setf *s* .30)
(setf *threshold* -.35)
(setf *key* .50)
(setf *say-it* .50)
(setf *penalty* 25)   
(setf *factor* .22)
(setf *exponent* 1)
(setf *v* nil)
(setf *encode* .2)

(defparameter *exp-results-batch* (make-array '(2 2 10 12) :initial-contents
'((((2.71	0.56	0.31	1.25	0.52	0.46	1.59	0.56	0.45	1.47	0.49	0.35)
(2.37	0.51	0.33	1.26	0.49	0.46	1.54	0.53	0.51	1.03	0.37	0)
(2.21	0.48	0.33	1.13	0.46	0.43	1.37	0.49	0.58	0.35	0 0)	
(2.01	0.53	0.33	1.02	0.49	0.47	1.13	0.42	0.37	0 0 0	)	
(1.77	0.51	0.33	0.87	0.46	0.44	0.81	0.34	 0 0 0 0)			
(1.55	0.48	0.29	0.78	0.41	0.44	0.33	0 0 0 0 0)				
(1.43	0.45	0.30	0.63	0.39	0.31	0 0 0 0 0 0)					
(1.43	0.46	0.27	0.51	0.30	0 0 0 0 0 0 0)						
(1.38	0.43	0.30	0.31	0 0 0 0 0 0 0 0)							
(1.38	0.43	0.30	0 0 0 0 0 0 0 0 0))
((2.65	0.59	0.43	2.72	0.64	0.66	3.05	0.64	0.65	2.43	0.60	0.39)
(2.24	0.46	2.44	0.59	0.64	2.75	0.62	0.62	2.40	0.58	0.41	0)
(2.73	0.70	1.16	0.56	2.66	0.60	0.56	2.11	0.59	0.42  0 0)		
(2.38	0.64	0.57	2.56	0.69	0.51	2.27	0.70	0.43	0 0 0)		
(2.10	0.47	2.34	0.65	0.58	2.04	0.57	0.40	0 0 0 0)			
(2.41	0.71	1.31	0.55	1.77	0.53	0.39	0 0 0 0 0)				
(2.15	0.61	0.49	1.69	0.48	0.34	0 0 0 0 0 0)					
(1.90	0.48	1.53	0.53	0.33	0 0 0 0 0 0 0)						
(2.10	0.66	0.78	0.43	0 0 0 0 0 0 0 0)							
(1.75	0.49	0.37	0 0 0 0 0 0 0 0 0)))
 (((0.84 0.77	0.78	0.72	0.70	0.68	0.57	0.56	0.57	0.47	0.47	0.54)
(0.87	0.81	0.82	0.76	0.71	0.73	0.64	0.58	0.57	0.56	0.60	0)
(0.88	0.82	0.84	0.79	0.77	0.80	0.71	0.69	0.69	0.78	0 0)	
(0.91	0.90	0.90	0.85	0.80	0.84	0.72	0.68	0.77	0 0 0)		
(0.95	0.92	0.94	0.91	0.90	0.90	0.82	0.84	0 0 0 0)			
(0.97	0.95	0.96	0.95	0.92	0.92	0.96	0 0 0 0 0)				
(0.99	0.98	0.98	0.98	0.96	0.98	0 0 0 0 0 0)					
(0.99	0.99	0.99	0.98	0.99	0 0 0 0 0 0 0)						
(0.99	0.99	1.00	0.99	0 0 0 0 0 0 0 0)							
(0.99	0.99	1.00	0 0 0 0 0 0 0 0 0))
((0.87	0.81	0.74	0.57	0.58	0.58	0.60	0.58	0.60	0.64	0.66	0.69)
(0.88	0.84	0.66	0.66	0.69	0.62	0.62	0.66	0.67	0.66	0.72	0)
(0.92	0.85	0.81	0.81	0.75	0.71	0.72	0.70	0.70	0.74	0 0)	
(0.95	0.88	0.87	0.83	0.81	0.81	0.80	0.81	0.83	0 0 0)		
(0.96	0.92	0.88	0.86	0.87	0.85	0.84	0.87	0 0 0 0)			
(0.99	0.96	0.95	0.94	0.92	0.89	0.91	0 0 0 0 0)				
(0.96	0.95	0.94	0.92	0.89	0.91	0 0 0 0 0 0)					
(0.99	0.98	0.97	0.97	0.96	0 0 0 0 0 0 0)						
(0.99	0.98	0.97	0.97	0 0 0 0 0 0 0 0)							
(0.98	0.98	0.98	0 0 0 0 0 0 0 0 0))))))								



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Serial Recall Experiment model" 2)
        
        (:new-para)

        (:table)
        
        (:table)
        "Activation noise (s): "   (:string :sy *s* .3)             (:new-row)
        "Threshold: "              (:string :sy *threshold* -.35)  (:new-row)
        "Scale factor (F): "       (:string :sy *factor* .22)       (:new-row)       
        "Mismatch penalty: "       (:string :sy *penalty* 2.5)      (:new-row)
        "Typing time (sec.): "     (:string :sy *key* .50)          (:new-row)
        "Encoding time (sec.): "   (:string :sy *encode* .2)        (:new-row)
        "Rehersal time (sec.): "   (:string :sy *say-it* .50)       (:new-row)
        "Intercept (sec.): "       (:string :sy *sf*  .5)           (:new-row)
        (:new-row)
        "List length (3 - 12) :"   (:string :sy *list-len* 12)      (:new-row)
        
        "Number of runs (1 - 20): "         (:string :sy *runs* 1)
        (:hidden :sy *sf* .50)
        (:hidden :sy *sb* 1.00)
        (:hidden :sy *exponent* 1)

        (:table-end)
        
        (:table)
        (:checkbox "Trace" :sy *v*  nil) (:new-row)
        (:checkbox "ALL" :sy *solve-all* nil) (:new-row)
        (:checkbox "Forward" :sy *forward-list* t) (:new-row)
        (:checkbox "Backward" :sy *backward-list* nil)
        (:table-end)
        
        (:table-end)
        
        (:new-para)
        (:button "Show Experiment Results" "(progn
                                              (format *standard-output* \"~%~%Experimental data:~%\")
                                              (output-batch-recall-data *exp-results-batch*))")
        (:new-para)
        (:button "Run model" "(progn  
                                (when (numberp *penalty*) 
                                  (setf *penalty* (* 10 *penalty*)))
                               (if (and (numberp *runs*) 
                                        (numberp *list-len*) 
                                        (numberp *threshold*) 
                                        (numberp *s*)
                                        (numberp *factor*) 
                                        (numberp *exponent*) 
                                        (numberp *penalty*) 
                                        (numberp *say-it*) 
                                        (numberp *key*))
                                 (progn
                                    (format *standard-output* \"~%~%Parameters for run: (~S ~S ~S ~S ~S ~S ~S ~S ~S ~S )~%~%Simulation data:~%\"
                                            *s* *threshold* *factor* *penalty* *key* *encode* *say-it* *sf* *list-len* *runs*) 
                                    (if *solve-all* 
                                        (output-batch-recall-data (run-batch-recall-experiment (if *v* 1 (min 20 (max 1 *runs*)))))
                                        (progn
                                           (when *forward-list*
                                              (run-specific-batch-recall 'forward (min 12 (max 3 *list-len*)) (min 20 (max 1 *runs*))))
                                           (when *backward-list*
                                              (run-specific-batch-recall 'backward (min 12 (max 3 *list-len*)) (min 20 (max 1 *runs*)))))))
                                 (format *standard-output* \"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 1 run of the whole model"
        (:new-line)
        "- The trace of 1 whole run is approximatly 50k (35 pages) in size"
        (:new-para)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; LISP functions 

;;; output-batch-recall-data takes one parameter, an array
;;; of the experiment data to display, and outputs 4 tables,
;;; two for accuracy, one forward and one backward
;;; and two for response time, one forward and one backward

(defun output-batch-recall-data (data)
  (do ((m 0 (1+ m)))
      ((equal m 2) nil)
    (case m
      (0 (format *standard-output* "                                     RT (sec)~%"))
      (1 (format *standard-output* "                                   ACCURACY~%")))
    (do ((i 0 (1+ i)))
        ((equal i 2) (format *standard-output* "~%"))
      (case i
        (0 (format *standard-output* "Forward~%"))
        (1 (format *standard-output* "Backward~%")))
      (format *standard-output* "                                Input  Position~%")
      (format *standard-output* "length       1     2     3     4     5     6     7     8     9    10    11    12~%")        
      (do ((j 0 (1+ j)))
          ((equal j 10) (format *standard-output* "~%"))
        (format *standard-output* "~2D       " (- 12 j)) 
        (do ((k 0 (1+ k)))
            ((or (equal k 12) ) (format *standard-output* "~%"))
          (format *standard-output* "~6,2F" (case i
                                              (0 (aref data m i j k))
                                              (1 (if (< k (- 12 j))
                                                     (aref data m i j (- (- 11 j) k))
                                                     (aref data m i j k))))))))))
  
;;; run-batch-recall-experiment takes one parameter n, the 
;;; number of runs of the experiment to simulate, and 
;;; then runs n ACT-R simulations of the full experiment,
;;; and returns the array containg the results of the 
;;; simulation
 
(defun run-batch-recall-experiment (n)
  ;; reset the results
  (setf *data* (make-array '(2 2 10 12) :initial-element 0))
  (setf *acc* (make-array '(2) :initial-contents '(1 1)))
  
  ;; run the simulations
  (do ((count 0 (1+ count)))
      ((equal count n) nil)
    (run-forward-batch-recall *data*) 
    (run-backward-batch-recall *data*))
  
  ;; rationalize the results
  (do ((m 0 (1+ m)))
      ((equal m 2) *data*)
    (do ((i 0 (1+ i)))
        ((equal i 2) nil)
      (do ((j 0 (1+ j)))
          ((equal j 10) nil)
        (do ((k 0 (1+ k)))
            ((equal k 12) nil)
          (setf (aref *data* m i j k) (/ (aref *data* m i j k) n)))))))


;;; run-specific-batch-recall takes 3 parameters
;;; task - either FORWARD or BACKWARD
;;; length - an integer between 3 and 12
;;; and runs - an integer
;;; and then preforms runs ACT-R simulations
;;; of the experiment for the specified direction
;;; and list length, and displays the results

(defun run-specific-batch-recall (task length runs)
  (let ((index 0)
        (data (make-array '(2 2 10 12) :initial-element 0)))
    (case task
      (forward (setf index 0)
               (dotimes (i runs) 
                 (run-forward-batch-recall-list length data)))
      (backward (setf index 1)
                (dotimes (i runs) 
                  (run-backward-batch-recall-list length data)))
      (t (format t "must specify either forward or backward~%")))
    (dotimes (m 2)
      (dotimes (i 2)
        (dotimes (j 10)
          (dotimes (k 12)
            (setf (aref data m i j k) (/ (aref data m i j k) runs))))))
    (case index
      (0 (format *standard-output* "~%~%Forward~%length = ~d~%~%" length))
      (1 (format *standard-output* "~%~%Backward~%length = ~d~%~%" length)))
    (format t "RT:~%")
    (format *standard-output* "                                  Position~%     " length)
    (dotimes (i length)
      (format *standard-output* "~6D" (+ 1 i)))
    (format *standard-output* "~%     ")       
    
    (dotimes (i length)
      (format t "~6,2F" (aref data 0 index (- 12 length) i)))
    (format t "~%~%Accuracy:~%     ")
    (dotimes (i length)
      (format t "~6,2F" (aref data 1 index (- 12 length) i)))))

;;; run-forward-batch-recall takes one parameter
;;; the data array for the simulation, and
;;; calls the function that runs a forward trial once
;;; for each list length from 3 to 12

(defun run-forward-batch-recall (data)
  (do ((count 12 (1- count)))
      ((equal count 2) data)
    (run-forward-batch-recall-list count data)))

;;; run-backward-batch-recall takes one parameter
;;; the data array for the simulation, and
;;; calls the function that runs a backward trial once
;;; for each list length from 3 to 12

(defun run-backward-batch-recall (data)
  (do ((count 12 (1- count)))
      ((equal count 2) data)
    (run-backward-batch-recall-list count data)))

;;; batch-recall-get-digit generates a random digit
;;; for presentation, if this is the first time it is called
;;; after *tflag* has been set to t
;;; the digit is stored in the *target* list
;;; and the digit is returned

(defun batch-recall-get-digit () 
  (when *tflag* 
    (setf *tflag* nil) 
    (let ((digit (random 10)))
      (setf *target* (cons digit *target*))
      digit)))

;;; batch-recall-next-count returns the number of 
;;; items in the current group, and updates the
;;; global variable holding the count of the
;;; groups to be studied

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

;;; batch-recall-reset-assoc takes one parameter,
;;; the number of items in the study list, and sets
;;; the ia values between the items and the list to 
;;; reflect the number of items on the list,
;;; and no association between the items and their
;;; position and parent

(defun batch-recall-reset-assoc (n)
  (let ((val (* 3 (log (/ 20 (* 1.333 n))))))
    (do ((temp (no-output (swm isa create-token)) (cdr temp)))
        ((null temp) )
      (setia-fct (list (list 'list (car temp) val)
                       (list (chunk-slot-value-fct (car temp) 'position) (car temp) 0)
                       (list (chunk-slot-value-fct (car temp) 'parent) (car temp) 0))))))

;;; run-forward-batch-recall-list takes 2 parameters
;;; the size of the study list, and the array in which
;;; to store the results of the run 
;;; the model is presented with the items to study
;;; and then is given the goal of retrieving the items
;;; in the forward direction 
;;; the response times and the accuracy are then
;;; recorded in the array 

(defun run-forward-batch-recall-list (c data)
  (let ( (last c))
    (setf *plan* (batch-recall-plan c)) 
    (setf *precord* *plan*)
    (setf *answer* nil) 
    (setf *target* nil)
    (setf *length* c) 
    (reset)
    (set-batch-recall-parameters)
    (eval `(addwm (goal isa study-words index list group start 
                        count 0 position first)))
    (do ((count 0 (1+ count)))
        ((equal count c) (actrtime-fct (- count (actrtime))))
      (setf *stop-it* (1+ count)) 
      (setf *tflag* t)
      (wmfocus goal) 
      (run))
    (eval `(addwm (newgoal isa retrieve-forward piece list position  first size ,(length (batch-recall-plan c)))))
    (batch-recall-reset-assoc c)
    (wmfocus newgoal) 
    (run) 
    (do ((temp  (reverse *answer*) (cdr temp))
         (temp1 (reverse *target*) (cdr temp1))
         (count 0 (1+ count)))
        ((null temp) nil)
      (setf (aref data 0 0 (- 12 c) count) (+ (aref data 0 0 (- 12 c) count)
                                              (- (caar temp) last)))
      (when (equal (car temp1) (cadar temp)) 
        (setf (aref data 1 0 (- 12 c) count) (1+ (aref data 1 0 (- 12 c) count) )))
      (setq last (caar temp)))))


;;; run-backward-batch-recall-list takes 2 parameters
;;; the size of the study list, and the array in which
;;; to store the results of the run 
;;; the model is presented with the items to study
;;; and then is given the goal of retrieving the items
;;; in the backward direction 
;;; the response times and the accuracy are then
;;; recorded in the array 

(defun run-backward-batch-recall-list (c data)
  (let ((last c))
    (setf *plan* (batch-recall-plan c))
    (setf *precord* *plan*)
    (setf *answer* nil)
    (setf *target* nil)
    (setf *length* c)
    (reset)
    (set-batch-recall-parameters)
    (eval `(addwm (goal isa study-words index list group start 
                        count 0 position first)))
    (do ((count 0 (1+ count)))
        ((equal count c) (actrtime-fct (- count (actrtime))))
      (setf *stop-it* (1+ count)) 
      (setf *tflag* t)
      (wmfocus goal) 
      (run))
    (eval `(addwm (newgoal isa retrieve-backward piece list position first size ,(length (batch-recall-plan c)))))
    (batch-recall-reset-assoc c)
    (wmfocus newgoal) 
    (run)
    (do ((temp  (reverse *answer*) (cdr temp))
         (temp1  *target* (cdr temp1))
         (count 0 (1+ count)))
        ((null temp) nil)
      (setf (aref data 0 1 (- 12 c) count) (+ (aref data 0 1 (- 12 c) count)
                                              (- (caar temp) last)))
      (when (equal (car temp1) (cadar temp)) 
        (setf (aref data 1 1 (- 12 c) count) (1+ (aref data 1 1 (- 12 c) count) )))
      (setq last (caar temp)))))


;;; batch-recall-plan 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 batch-recall-plan (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))))


;;; batch-recall-next-position takes one parameter 
;;; which is the chunk for the current position in
;;; the group, and returns the chunk representing the
;;; next position in the group

(defun batch-recall-next-position (x)
  
  (case x
    (start 'first)
    (first 'second)
    (second 'third)
    (third 'fourth)
    (fourth 'fifth)))

;;; batch-recall-pos takes one parameter
;;; a position chunk, and returns the integer
;;; index representing that position

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


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

(defun set-batch-recall-parameters ()
  (sgp-fct (list :v *v* :lf *factor*  :bll .5 :le *exponent* :pas *s* :rt *threshold* 
                 :pm t :mp *penalty* :g 100 :ol nil :act nil :lt nil :er t))
  (parameters-fct 'attend-start (list :effort *encode* :a 2))
  (parameters-fct 'attend (list :effort *encode* :a 2))
  (parameters-fct 'attend-null (list :effort *encode* :r .5 :a 2))
  (parameters-fct 'rehearse-item (list :effort *say-it* :a *say-it*))
  (parameters-fct 'rehearse-current (list :effort *say-it* :a *say-it*))
  (parameters-fct 'start-group (list :effort *sf* :a *sf*))
  (parameters-fct 'start-group-skip (list :effort *sf* :r .5 :a *sf*))
  (parameters-fct 'dispatch-one-group-backward (list :effort *sf* :a *sf*))
  (parameters-fct 'dispatch-two-group-backward (list :effort *sf* :a *sf*))
  (parameters-fct 'dispatch-three-group-backward (list :effort *sf* :a *sf*))
  (parameters-fct 'dispatch-four-group-backward (list :effort *sf* :a *sf*))
  (parameters-fct 'type-item (list :effort *key* :a *key*))
  (parameters-fct 'skip-item (list :effort *key* :a *key*)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ACT-R Model of the task
;;;
;;;

(clearall)

;;; chunks for goals

(chunk-type study-words position group count index rc rp rehearse rs)
(chunk-type create-token parent position name list recalled (eval t))
(chunk-type retrieve piece group size position subgoals)
(chunk-type (retrieve-forward (:include retrieve)))
(chunk-type (retrieve-backward (:include retrieve)))

;;; chunks for items

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

(sgp-fct (list :v nil :lf *factor*  :bll .5 :le *exponent* :pas *s* :rt *threshold* 
            :pm t :mp *penalty* :g 100 :ol nil :act nil :lt nil :er t))

(add-dm  (start isa position)
         (first isa position)
         (second isa position)
         (third isa position)
         (fourth isa position)
         (fifth isa position)
         (plan1 isa plan  next plan2)
         (plan2 isa plan  next plan3)
         (plan3 isa plan  next plan4)
         (plan4 isa plan  next plan5)
         (list isa list))

(setsimilarities (first second .9)
                 (second third .9)
                 (third fourth .9)
                 (first third .8)
                 (second fourth .8)
                 (first fourth .7))

(setallbaselevels 50 -100)



(p attend-start
"
  IF the goal is to study words
     and this is the first number in a group
  THEN create a chunk to encode the group,
     create a chunk to encode the number,
     update the position in the goal,
     and mark the goal to rehearse
"
   =goal>
      isa study-words
      rehearse nil
      index =index
      group =group
      count 0

   !bind! =count (batch-recall-next-count)

   !bind! =name (batch-recall-get-digit)
==>
   !bind! =newgroup  (batch-recall-next-position =group)

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

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

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

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


(p attend
"
  IF the goal is to study words
     and this is not the first number in a group
  THEN create a chunk to encode the number,
     update the position in the goal,
     and mark the goal to rehearse
"
   =goal>
      isa study-words
      rehearse nil
      index =index
      group =group
      position =pos
      count =count

   !eval! (> =count 0)

   !bind! =name (batch-recall-get-digit)
==>
   =newgoal>
      isa create-token
      list =index
      parent =group
      position =pos
      name =name

   =goal>
      rehearse go
      position (!eval! (batch-recall-next-position =pos))
      count (!eval! (1- =count))
)

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


(p attend-null
"
  IF the goal is to study words
     and it is time to rehearse words
  THEN do nothing (used in the event that
     there are no words to rehearse, or no
     words can be recalled)
"
   =goal>
      isa study-words
      rehearse go
==>
)

(parameters-fct 'attend-null (list :effort *encode* :r .5 :a 2))


(p rehearse-start
"
  IF the goal is to study words
     and it is time to rehearse
     and no group is chosen for rehersal
     and the first group can be recalled
  THEN mark the goal to rehearse the first
     word in the first group
" 
   =goal>
      isa study-words
      rehearse go
      index =index
      rp nil
      rc nil

   =group1>
      isa group
      position first
      list =index
      size =s
==>
   =goal>
      rp first
      rc first
      rs =s
)


(p rehearse-item
"
  IF the goal is to study words
     and it is time to rehearse
     and you have not reached the end of the
     group being rehearsed
     and you can recall an item 
  THEN mark the goal to rehearse the next 
     member of the group
"
   =goal>
      isa study-words
      rehearse go
      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! (batch-recall-next-position =pos))
)

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


(p rehearse-current
"
  IF the goal is to study words
     and it is time to rehearse
     and an item can be recalled that
     matches the current group position
  THEN the current item has been rehearsed
"
   =goal>
      isa study-words
      rehearse go
      index =index
      position =pos
      group =group

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

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


(p rehearse-next-group
"
  IF the goal is to study words
     and it is time to rehearse
     and you have reached the end of a group
     and you can recall the next group
  THEN mark the goal to rehearse the
     first item in the next group
"
   =goal>
      isa study-words
      rehearse go
      index =index
      group =group
      rc =rgroup
      rp =pos
      rs =size

   !eval! (< (batch-recall-pos =rgroup) (batch-recall-pos =group))

   !eval! (> (batch-recall-pos =pos) =size)

   =group1>
      isa group
      position (!eval! (batch-recall-next-position =rgroup))
      list =index
      size =s
==>
   =goal>
      rc (!eval! (batch-recall-next-position =rgroup))
      rp first
)


(p rehearse-reset
"
  IF the goal is to study words
     and it is time to rehearse
     and you have reached the end of the
     list of items
  THEN mark the goal to start
     rehearsing from the first item in 
     the first group
"
   =goal>
      isa study-words
      rehearse go
      index =index
      group =group
      rc =group
      rp =pos
      position =pos
==>
   =goal>
      rc first
      rp first
)


(p rehearse-abort
"
  IF the goal is to study words
     and it is time to rehearse
     and it is time for the next word
  THEN mark the goal to stop rehearsing
     and pop the goal
"
   =goal>
      isa study-words
      rehearse go

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

   !pop!
)

(parameters rehearse-abort :a 0)


(p rehearse-abort-last
"
  IF the goal is to study words
     and it is time to rehearse
     and it is at the end of the study time for the
     last item in the list
  THEN mark the goal to stop rehearsing
     and pop the goal
"
   =goal>
      isa study-words
      rehearse go
      position =pos
      group =group

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

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

   !pop!
)

(parameters rehearse-abort-last :a 0)


(p start-group
"
  IF the goal is to retrieve the first group 
     and the group can be recalled
  THEN mark the goal with the list of group
     lengths 
     and advance the group to be recalled
"
   =goal>
      isa retrieve
      piece =index
      position first
      group nil
      size =size
      subgoals nil
    
   !eval! (>= =size 1)
   
   =group>
      isa group
      position first
      list =index
      size =size1
==>
   =goal>
      subgoals (!eval! *precord*)
      position second
)

(parameters-fct 'start-group (list :effort *sf* :a *sf*))


(p start-group-skip
"
  IF the goal is to retrieve the first group 
  THEN mark the goal with the list of group
     lengths 
     and advance the group to be recalled
"
   =goal>
      isa retrieve
      piece =index
      position first
      group nil
      size =size
      subgoals nil

   !eval! (>= =size 1)
==>
   =goal>
      subgoals (!eval! *precord*)
      position second
)

(parameters-fct 'start-group-skip (list :effort *sf* :r .5 :a *sf*))


(p retrieve-group
"
  IF the goal is to retrieve a group
     and the group can be recalled 
  THEN advance the group to be recalled
"
   =goal>
      isa retrieve
      piece =index
      position =pos
      group nil
      size =size
      subgoals =lis

   !eval! (>= =size  (batch-recall-pos =pos))

   =group>
      isa group
      position =pos
      list =index
      size =size1
==>
   =goal>
      position (!eval! (batch-recall-next-position =pos))
)


(p retrieve-group-skip
"
  IF the goal is to retrieve a group
  THEN advance the group to be recalled
"
   =goal>
      isa retrieve
      piece =index
      position =pos
      group nil
      size =size
      subgoals =lis

   !eval! (>= =size (batch-recall-pos =pos))
==>
   =goal>
      position (!eval! (batch-recall-next-position =pos))
)

(parameters retrieve-group-skip  :r .5)


(p get-next-start
"
  IF the goal is to retrieve the first item
     in a group
     and a matching item can be retrieved
  THEN mark the subgoals slot with the item
     and increment the position
" 
   =goal>
      isa retrieve
      piece =index
      position first
      group =group
      size =size
      subgoals nil

   !eval! (>= =size 1)

   =thing1>
      isa create-token
      position first
      list =list
      parent =group
      recalled nil
==>
   =thing1>
      recalled 1

   =goal>
      subgoals (!eval! (list =thing1))
      position second
)


(p get-next-start-skip
"
  IF the goal is to retrieve the first item
     in a group
     
  THEN mark the subgoals slot with nil
     and increment the position
"
   =goal>
      isa retrieve
      piece =index
      position first
      group =group
      size =size
      subgoals nil

   !eval! (>= =size 1)
==>
   =goal>
      subgoals (!eval! (list nil))
      position second
)

(parameters get-next-start-skip :r .5)


(p get-next-start-null-group
"
  IF the goal is to retrieve the first item
     in a group
     and the group has no members
  THEN mark the subgoals slot with nil
     and increment the position
"
   =goal>
      isa retrieve
      piece =index
      position first
      group =group
      size =size
      subgoals nil

   !eval! (< =size 0)
==>
   =goal>
      subgoals (!eval! (list nil))
      position second
)


(p get-next
"
  IF the goal is to retrieve an item
     in a group
     and a matching item can be retrieved
  THEN mark the item as having been recalled
     mark the subgoals slot with the item
     and increment the position
" 
   =goal>
      isa retrieve
      piece =index
      position =pos
      group =group
      size =size
      subgoals =lis

   !eval! (>= =size (batch-recall-pos =pos))

   =thing1>
      isa create-token
      position =pos
      list =list
      parent =group
      recalled nil
==>
   =thing1>
      recalled 1

   =goal>
      subgoals  (!eval! (append  =lis (list =thing1)))
      position (!eval! (batch-recall-next-position =pos))
)


(p get-next-skip
"
  IF the goal is to retrieve an item
     in a group
  THEN mark the subgoals slot with nil
     and increment the position
" 
   =goal>
      isa retrieve
      piece =index
      position =pos
      group =group
      size =size
      subgoals =lis

   !eval! (>= =size (batch-recall-pos =pos))
==>
   =goal>
      subgoals  (!eval! (append  =lis (list nil)))
      position (!eval! (batch-recall-next-position =pos))
)

(parameters get-next-skip  :r .5)


(p get-next-group-skip
"
  IF the goal is to retrieve an item
     in a group
     and the group has no members
  THEN mark the subgoals slot with nil
     and increment the position
"
   =goal>
      isa retrieve
      piece =index
      position =pos
      group =group
      size =size
      subgoals =lis

   !eval! (< =size 0)

   !eval! (>= (abs =size) (batch-recall-pos =pos))
==>
   =goal>
      subgoals  (!eval! (append  =lis (list nil)))
      position (!eval! (batch-recall-next-position =pos))
)


(p dispatch-one-group
"
  IF the goal is to retrieve a list in the
     forward direction
     and there is only one group to retrieve
  THEN set a new goal to retrieve the first
     item in the group
"
   =goal>
      isa retrieve-forward
      piece =index
      position second
      group nil
      size 1
      subgoals =lis
==>
   =newgoal1>
      isa retrieve-forward
      piece =index
      group first
      size (!eval! (first =lis))
      position first
   
   !focus-on!  =newgoal1
)


(p dispatch-two-groups
"
  IF the goal is to retrieve a list in the
     forward direction
     and there are two groups to retrieve
  THEN push a new goal to retrieve the first
     item in the second group 
     and push a new goal to retrieve the first item
     in the first group
"
   =goal>
      isa retrieve-forward
      piece =index
      position third
      group nil
      size 2
      subgoals =lis
==>
   =newgoal1>
      isa retrieve-forward
      piece =index
      group first
      size (!eval! (first =lis))
      position first

   =newgoal2>
      isa retrieve-forward
      piece =index
      group second
      size  (!eval! (second =lis))
      position first

   !focus-on!  =newgoal2

   !push! =newgoal1
)


(p dispatch-three-groups
"
  IF the goal is to retrieve a list in the
     forward direction
     and there are three groups to retrieve
  THEN push a new goal to retrieve the first
     item in the third group 
     and push a new goal to retrieve the first item 
     in the second group
     and set a new goal to retrieve the first item
     in the first group
"
   =goal>
      isa retrieve-forward
      piece =index
      position fourth
      group nil
      size 3
      subgoals =lis
==>
   =newgoal1>
      isa retrieve-forward
      piece =index
      group first
      size (!eval! (first =lis))
      position first

   =newgoal2>
      isa retrieve-forward
      piece =index
      group second
      size  (!eval! (second =lis))
      position first

   =newgoal3>
      isa retrieve-forward
      piece =index
      group third
      size  (!eval! (third =lis))
      position first

   !focus-on! =newgoal3

   !push! =newgoal2

   !push! =newgoal1
)


(p dispatch-four-groups
"
  IF the goal is to retrieve a list in the
     forward direction
     and there are four groups to retrieve
  THEN push a new goal to retrieve the first
     item in the fourth group 
     and push a new goal to retrieve the first
     item in the third group 
     and push a new goal to retrieve the first item 
     in the second group
     and set a new goal to retrieve the first item
     in the first group
"
   =goal>
      isa retrieve-forward
      piece =index
      position fifth
      group nil
      size 4
      subgoals =lis
==>
   =newgoal1>
      isa retrieve-forward
      piece =index
      group first
      size (!eval! (first =lis))
      position first

   =newgoal2>
      isa retrieve-forward
      piece =index
      group second
      size  (!eval! (second =lis))
      position first

   =newgoal3>
      isa retrieve-forward
      piece =index
      group third
      size  (!eval! (third =lis))
      position first

   =newgoal4>
      isa retrieve-forward
      piece =index
      group fourth
      size  (!eval! (fourth =lis))
      position first

   !focus-on! =newgoal4

   !push! =newgoal3

   !push! =newgoal2

   !push! =newgoal1
)


(p dispatch-two-items
"
  IF the goal is to retrieve items in the 
     forward direction 
     and there are only two items
     in the current group
  THEN push a new goal to report the
     second item
     and push a new goal to report the 
     first item
"
    =goal>
      isa retrieve-forward
      piece =index
      position third
      group =group
      size =size
      subgoals =lis

   !eval! (equal (abs =size) 2)
==>
   =newgoal1>
      isa process
      item (!eval! (first =lis))

   =newgoal2>
      isa process
      item (!eval! (second =lis))

   !focus-on! =newgoal2

   !push! =newgoal1
)


(p dispatch-three-items
"
  IF the goal is to retrieve items in the 
     forward direction 
     and there are only three items
     in the current group
  THEN push a new goal to report the
     third item
     and push a new goal to report the
     second item
     and push a new goal to report the 
     first item
"
   =goal>
      isa retrieve-forward
      piece =index
      position fourth
      group =group
      size =size
      subgoals =lis

   !eval! (equal (abs =size) 3)
==>
   =newgoal1>
      isa process
      item (!eval! (first =lis))

   =newgoal2>
      isa process
      item (!eval! (second =lis))

   =newgoal3>
      isa process
      item (!eval! (third =lis))

   !focus-on! =newgoal3

   !push! =newgoal2

   !push! =newgoal1
)


(p dispatch-four-items
"
  IF the goal is to retrieve items in the 
     forward direction 
     and there are only four items
     in the current group
  THEN push a new goal to report the
     fourth item
     and push a new goal to report the
     third item
     and push a new goal to report the
     second item
     and push a new goal to report the 
     first item
"
   =goal>
      isa retrieve-forward
      piece =index
      position fifth
      group =group
      size =size
      subgoals =lis

   !eval! (equal (abs =size) 4)
==>
   =newgoal1>
      isa process
      item (!eval! (first =lis))

   =newgoal2>
      isa process
      item (!eval! (second =lis))

   =newgoal3>
      isa process
      item (!eval! (third =lis))

   =newgoal4>
      isa process
      item (!eval! (fourth =lis))

   !focus-on! =newgoal4

   !push! =newgoal3

   !push! =newgoal2
 
   !push! =newgoal1
)


(p dispatch-one-group-backward
"
  IF the goal is to retrieve a list in the
     backward direction
     and there is only one group to retrieve
  THEN set a new goal to retrieve the first
     item in the group
"
   =goal>
      isa retrieve-backward
      piece =index
      position second
      group nil
      size 1
      subgoals =lis
==>
   =newgoal1>
      isa retrieve-backward
      piece =index
      group first
      size (!eval! (first =lis))
      position first
  
  !focus-on!  =newgoal1
)

(parameters-fct 'dispatch-one-group-backward (list :effort *sf* :a *sf*))


(p dispatch-two-group-backward
"
  IF the goal is to retrieve a list in the
     backward direction
     and there are two groups to retrieve
  THEN modify the goal to retrieve one group 
     and push a new goal to retrieve the first item
     in the second group
"
   =goal>
      isa retrieve-backward
      piece =index
      position third
      group nil
      size 2
      subgoals =lis
==>
   =goal>
      position first
      size 1
      subgoals nil

   =newgoal2>
      isa retrieve-backward
      piece =index
      group second
      size  (!eval! (second =lis))
      position first

   !push! =newgoal2
)

(parameters-fct 'dispatch-two-group-backward (list :effort *sf* :a *sf*))


(p dispatch-three-group-backward
"
  IF the goal is to retrieve a list in the
     backward direction
     and there are three groups to retrieve
  THEN modify the goal to retrieve two groups 
     and push a new goal to retrieve the first item
     in the third group
"
   =goal>
      isa retrieve-backward
      piece =index
      position fourth
      group nil
      size 3
      subgoals =lis
==>
   =goal>
      position first
      size 2
      subgoals nil

   =newgoal3>
      isa retrieve-backward
      piece =index
      group third
      size  (!eval! (third =lis))
      position first

   !push! =newgoal3
)

(parameters-fct 'dispatch-three-group-backward (list :effort *sf* :a *sf*))


(p dispatch-four-group-backward
"
  IF the goal is to retrieve a list in the
     backward direction
     and there are four groups to retrieve
  THEN modify the goal to retrieve three groups 
     and push a new goal to retrieve the first item
     in the fourth group
"
   =goal>
      isa retrieve-backward
      piece =index
      position fifth
      group nil
      size 4
      subgoals =lis
==>
   =goal>
      position first
      size 3
      subgoals nil

   =newgoal4>
      isa retrieve-backward
      piece =index
      group fourth
      size  (!eval! (fourth =lis))
      position first

   !push! =newgoal4
)

(parameters-fct 'dispatch-four-group-backward (list :effort *sf* :a *sf*))


(p dispatch-two-items-backward
"
  IF the goal is to retrieve items in the 
     backward direction 
     and there are only two items
     in the current group
  THEN push a new goal to report the
     first item
     and push a new goal to report the 
     second item
"
   =goal>
      isa retrieve-backward
      piece =index
      position third
      group =group
      size =size
      subgoals =lis

   !eval! (equal (abs =size) 2)
==>
   =newgoal1>
      isa process
      item (!eval! (first =lis))

   =newgoal2>
      isa process
      item (!eval! (second =lis))

   !focus-on! =newgoal1

   !push! =newgoal2
)


(p dispatch-three-items-backward
"
  IF the goal is to retrieve items in the 
     backward direction 
     and there are only three items
     in the current group
  THEN push a new goal to report the
     first item
     and push a new goal to report the
     second item
     and push a new goal to report the 
     third item
"
   =goal>
      isa retrieve-backward
      piece =index
      position fourth
      group =group
      size =size
      subgoals =lis

   !eval! (equal (abs =size) 3)
==>
   =newgoal1>
      isa process
      item (!eval! (first =lis))

   =newgoal2>
      isa process
      item (!eval! (second =lis))

   =newgoal3>
      isa process
      item (!eval! (third =lis))

   !focus-on! =newgoal1

   !push! =newgoal2

   !push! =newgoal3
)


(p dispatch-four-items-backward
"
  IF the goal is to retrieve items in the 
     backward direction 
     and there are only four items
     in the current group
  THEN push a new goal to report the
     first item
     and push a new goal to report the
     second item
     and push a new goal to report the
     third item
     and push a new goal to report the 
     fourth item
"
   =goal>
      isa retrieve-backward
      piece =index
      position fifth
      group =group
      size =size
      subgoals =lis

   !eval! (equal (abs =size) 4)
==>
   =newgoal1>
      isa process
      item (!eval! (first =lis))

   =newgoal2>
      isa process
      item (!eval! (second =lis))

   =newgoal3>
      isa process
      item (!eval! (third =lis))

   =newgoal4>
      isa process
      item (!eval! (fourth =lis))

   !focus-on! =newgoal1

   !push! =newgoal2

   !push! =newgoal3

   !push! =newgoal4
)


(p type-item
"
  IF the goal is to process an item
     and the item is recalled
  THEN add the name of the item and the
     response time to the *answer* log
     and pop the goal
"
   =goal>
      isa process
      item =item

   =item>
      isa create-token
      name =key
==>
   !eval! (setf *answer* (cons (list (+ *key* (actrtime)) =key) *answer*))

   !pop!
)

(parameters-fct 'type-item (list :effort *key* :a *key*))


(p skip-item
"
  IF the goal is to process a nil item
  THEN add the nil and the
     response time to the *answer* log
     and pop the goal
"
   =goal>
      isa process
      item nil
==>
   !eval! (setf *answer* (cons (list (+ *key* (actrtime)) nil) *answer*))

   !pop!
)

(parameters-fct 'skip-item (list :effort *key* :a *key*))