;;;
;;; ;;; 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)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; 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)