;;;<pre><xmp>
;;;
;;; ACT-R 4.0 model

;This model simulates only TASK 2 latency.

(defparameter *intercept* .5)
(defparameter *decay* 1.25)
(defparameter *base* .2)
(defparameter *prob* .88)
(defparameter *f* 0.18)
(defparameter *response* .235)
(defparameter *val* 12)

(defun exp1 ()
  (cycle  (variabilize '((do-it-task-switch intercept prob base decay f delay))
                      '(intercept prob base decay f delay))
         (list (list 0.361904928 0.886079757 0.38626384  *decay* *f* 0.2)
           (list 0.33984893  0.886079757 0.38626384  *decay* *f* 0.6)
           (list 0.33977803  0.886079757 0.38626384  *decay* *f* 1.5)
           (list 0.361904928 0.872501774 0.597329163 *decay* *f* 0.2)
           (list 0.33984893  0.872501774 0.597329163 *decay* *f* 0.6)
           (list 0.33977803  0.872501774 0.597329163 *decay* *f* 1.5)
           (list 0.361904928 0.851327577 0.705261201 *decay* *f* 0.2)
           (list 0.33984893  0.851327577 0.705261201 *decay* *f* 0.6)
           (list 0.33977803  0.851327577 0.705261201 *decay* *f* 1.5))
         :label '(session-rsi fkn-rep fkn-sw no-fkn-rep no-fkn-sw)
         :indices '(ses1-0.2 ses1-0.6 ses1-1.5 ses2-0.2 ses2-0.6 ses2-1.5 ses3-0.2 ses3-0.6 ses3-1.5)))

(defun run-exp1 ()
  (let (result)
    (setf result (repeat '(exp1) 32))
    (setf result (average result))
    (tabulate result)))

(defun exp2 ()
  (cycle  (variabilize '((do-it-task-switch intercept prob base decay f delay))
                      '(intercept prob base decay f delay))
          (list (list 0.4181849   0.919632584 0.331155317 *decay* *f* 1.0)
            (list 0.428541263 0.919632584 0.331155317 *decay* *f* 3.0)
            (list 0.43142919  0.919632584 0.331155317 *decay* *f* 5.0)
            (list 0.4181849   0.877246843 0.533816664 *decay* *f* 1.0)
            (list 0.428541263 0.877246843 0.533816664 *decay* *f* 3.0)
            (list 0.43142919  0.877246843 0.533816664 *decay* *f* 5.0))
          :label '(exp-half-rsi fkn-rep fkn-sw no-fkn-rep no-fkn-sw)
         :indices '(first-half-1.0 first-half-3.0 first-half-5.0 second-half-1.0 second-half-3.0 second-half-5.0)))

(defun run-exp2 ()
  (let (result)
    (setf result (repeat '(exp2) 24))
    (setf result (average result))
    (tabulate result)))
      
(defun do-it (intercept prob base decay f delay)
  (setf *f* f)
  (setf *decay* decay)
  (setf *prob* prob)
  (setf *val* (+ 10 (/ (- (log .1)) (sqrt 2))))
  (setf *base* base)
  (setf *response* (- intercept .25))
  (setf *intercept* intercept)
  (data
     (fkn-rep delay) (fkn-sw delay (expt prob (/ delay .2))) (nofkn-rep delay) (nofkn-sw delay)))

(defun nofkn-sw (delay)
   (aref (data-array (run-two 'red 'g 7 'green 9 'm 'random 'switch delay)) 1))

(defun fkn-sw (delay prob)
  (+ (* (- 1 prob) (prog2 (setf *val* 0)
               (aref (data-array (run-two 'red 'g 7 'green 9 'm 'blocked 'switch delay)) 1)))
      (* prob  (prog2 (setf *val* 20)
               (aref (data-array (run-two 'red 'g 7 'green 9 'm 'blocked 'switch delay)) 1)))))

(defun fkn-rep (delay)
   (/ (+ (aref (data-array (run-two 'red 'g 7 'red 'm 9 'blocked 'repeated delay)) 1)
         (aref (data-array (run-two 'red 'g 7 'red 'e 9 'blocked 'repeated delay)) 1)) 2))

(defun nofkn-rep (delay)
   (/ (+ (aref (data-array (run-two 'red 'g 7 'red 'm 9 'random 'repeated delay)) 1)
         (aref (data-array (run-two 'red 'g 7 'red 'e 9 'random 'repeated delay)) 1)) 2))

(defun delay (base)
  (* 20 (expt (/  (do ((i 1 (1+ i))
                   (sum 0 (+ sum (expt i (- *decay*)))))
                  ((> i 20) sum))
            base) (/ 1 *decay*))))

(defparameter *tbase* (delay .5))
(defparameter *rbase* (delay .25))

(defun compute-base-level-activation (wme)
  (let ((base (cond ((member (wme-name wme) '(map1 map2 map3 map4) :test 'equal)
                     (log (+ *base* (expt (- *time* (second (wme-references wme)))
                                    (- *decay*)))))
                    ((member (wme-name wme) '(t1 t2) :test 'equal)
                     (log (+ *base* *base* (expt (- *time* (second (wme-references wme)))
                                    (- *decay*)))))
                    (t 3))))
    (setf (wme-base-level wme) base) base))


(defun run-two (c1 a b c2 e f prep tran time)
  (let ((lag 0)
        (hold 0))
    (reset)

    (eval `(mod-chunk stimulus state nil color ,c1 stim1 ,a stim2 ,b))
    (if (equal prep 'blocked)
        (eval `(mod-chunk goal trial ,tran))
        (eval `(mod-chunk goal trial ,prep)))
    (loop (run 1)
        (if (equal (chunk-slot-value goal step) 'end) (return)))
    (Setf Lag (+ Time *Time*)) (Setf Hold *Time*)
    (mod-chunk goal step think)
    (loop (run 1)
          (if (>= *time* lag) (return)))
    (mod-chunk goal step start)
    (setf *time* lag)
    (eval `(mod-chunk stimulus state nil color ,c2 stim1 ,e stim2 ,f))
    (loop (run 1)
        (if (equal (chunk-slot-value goal step) 'end) (return)))
    (data
     ; prep tran time
     hold (- *time* lag))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; The ACT-R model

(clear-all)

(sgp-fct (list :era t :ol nil :v t :lf *f* :egs 1 :bll *decay* :rt -10 :ut nil :v nil :ga 0))

(chunk-type do-pair task color stim1 stim2 category type step response trial)
(chunk-type stim color stim1 stim2 state)
(chunk-type symbol category type)
(chunk-type mapping response key)
(chunk-type inverse first second)
(chunk-type reset first second)
(chunk-type translation first second)

(add-dm
   (goal ISA do-pair step start trial repeated task none)
   (none isa chunk)
   (stimulus ISA stim color nil stim1 nil stim2 nil)
   (A isa symbol category letter type vowel)
   (E isa symbol category letter type vowel)
   (I isa symbol category letter type vowel)
   (U isa symbol category letter type vowel)
   (G isa symbol category letter type consonant)
   (K isa symbol category letter type consonant)
   (M isa symbol category letter type consonant)
   (R isa symbol category letter type consonant)
   (2 isa symbol category digit type even)
   (4 isa symbol category digit type even)
   (6 isa symbol category digit type even)
   (8 isa symbol category digit type even)
   (3 isa symbol category digit type odd)
   (5 isa symbol category digit type odd)
   (7 isa symbol category digit type odd)
   (9 isa symbol category digit type odd)
   (map1 ISA mapping response vowel key z)
   (map2 ISA mapping response consonant key v)
   (map3 ISA mapping response even key z)
   (map4 ISA mapping response odd key v)
   (i1 ISA inverse first letter second digit)
   (i2 ISA inverse first digit second letter)
   (r1 ISA reset first random second nil)
   (t1 ISA translation first red second letter)
   (t2 ISA translation first green second digit))

(P Start-Task
   =goal>
      ISA         do-pair
      step        start
   =stim>
      isa stim
      color =color
      stim1 =first
      stim2 =second
      state nil
==>
  =stim>
      state done
   =goal>
      color       =color
      stim1       =first
      stim2       =second
      step        decide
      category    nil
)


(P Encode-Task
   =goal>
      ISA         do-pair
      step        decide
      color       =color
      trial       =val
      task        =thing
!eval! (or (not (equal =val 'repeated)) (equal =thing 'none))
   =trans>
      ISA         translation
      first       =color
      second      =task
==>
   =goal>
      task        =task
      step        first
)

(P Task-Prepared
   =goal>
      ISA         do-pair
      step        decide
      color       =color
     - task        none
      trial repeated
==>
   =goal>
      step        first
)

(P Identify-Symbol
   =goal>
      ISA         do-pair
      task        =category
      step        first
      stim1       =symbol
      category    nil
   =symbol>
      ISA         symbol
      category    =category
==>
   =goal>
      step  judge-symbol
)

(P Judge-Symbol
   =goal>
      ISA         do-pair
      step        judge-symbol
      stim1       =symbol
   =symbol>
      ISA         symbol
      type        =type
==>
   =goal>
      step        respond
      type        =type
      stim1       nil
      stim2       nil
      color       nil
)

(P Map-Response
   =goal>
      ISA         do-pair
      step        respond
      type        =response
      response    nil
   =map>
      ISA         mapping
      response    =response
      key         =key
==>
   =goal>
      step        execute
      response    =key)

(p Respond
   =goal>
     isa do-pair
     step execute
     response =key
==>
  =goal>
     step end
     response nil)

(p Prepare-Switch
       =goal>
          isa do-pair
          task =task
          trial switch
          step think
   =inverse>
      ISA         inverse
      first       =task
      second      =other
==>
     =goal>
         trial repeated
         category nil
         task =other)

(p Think
   =goal>
       isa do-pair
       step think
==>)


(spp :b 5 :strength 10)
(spp-fct (list 'respond :effort *response*))

(spp (map-response encode-task) :strength 0)

(spp think :b 10 :effort .2)
(spp-fct (list 'prepare-switch :b *val*))


(sdp (t1 t2)  :references (-5))
(sdp (map1 map2 map3 map4)  :references (-11))


(goal-focus goal)

(setf *abort-instantiation* nil)