; This model runs in ACT-R 6.0 ; To run the model call (run-experiment exp study delay) where ; exp is 1 or 2 depending on the experiment ; study is 'paired or 'generated depending on the study condition ; delay is 'no, 'short, or 'long depending on the delay ; An ACT-R trace will be printed followed by ; the predicted BOLD signal for the parietal and prefrontal (defvar *response*) (defvar *text1*) (defvar *text2*) (defvar *text3*) (defvar *text4*) (defparameter *scale* 1.5) (defparameter *exp* 3) (defun factorial (n) (do* ((i n (1- i)) (v i (* v i))) ((= i 1) v))) (defparameter *mag* (/ 1 (* (factorial *exp*) *scale*))) (defun response-member (a) (member a '("1" "2" "3" "4") :test 'equal)) (defun run-experiment (exp study delay) (let (start) (cond ((eq study 'paired) (setf *text1* "band") (setf *text2* "sold")(setf *text3* "2")(setf *text4* "2")) ((eq study 'generated) (setf *text1* "bxnd")(setf *text2* "sxld")(setf *text3* "xid")(setf *text4* "xut"))) (case exp (1 (case delay (no (present-immediate 2) (setf start 0)) (short (present-past 2 56)(setf start 56)) (long (present-past 2 168)(setf start 168)))) (2 (case delay (no (present-immediate 6)(setf start 0)) (short (present-past 6 56)(setf start 56)) (long (present-past 6 168)(setf start 168))))) (predict (+ start 1)))) (defun predict (start) (let (parietal prefrontal (times '(1 3 5 7 9 11 13 15 17 19 21 23 25 27))) (setf *exp* 3) (setf *scale* 1.70) (setf *mag* (* 9.89 (/ 1 (* (factorial *exp*) *scale*)))) (setf parietal (busy-predict 'imaginal start (+ start 26) 2)) (setf *exp* 2) (setf *scale* 2.95) (setf *mag* (* 1.61 (/ 1 (* (factorial *exp*) *scale*)))) (setf prefrontal (busy-predict 'retrieval start (+ start 26) 2)) (princ " Time Parietal Prefrontal") (terpri) (mapcar #'(lambda (x y z) (princ (format nil "~3d sec.~9,3F~11,3F" x y z)) (terpri)) times parietal prefrontal)) nil) (defun present-past (delay past) (let ((window (open-exp-window "Paired Experiment" :visible t))) (reset) (add-dm (goal isa goal step start)) (goal-focus goal) (install-device window) (proc-display :clear t) (schedule-event 0 'present-warning) (schedule-event 2 'present-pair-immediate) (schedule-event (if (<= delay 2) 8 10) 'present-wait) (schedule-event (1- past) 'reset-the-goal) (schedule-event past 'present-warning) (schedule-event (+ 2 past) 'present-pair-delay) (schedule-event (+ 8 past) 'present-wait) (schedule-event (+ 8 delay past) 'present-probe) (schedule-event (+ 14 delay past) 'present-answer) (run 1000))) (defun present-immediate (delay) (let ((window (open-exp-window "Paired Experiment" :visible t))) (reset) (add-dm (goal isa goal step start)) (goal-focus goal) (add-text-to-exp-window :text "*" :x 150 :y 150 :width 25) (install-device window) (proc-display :clear t) (schedule-event 2 'present-pair-immediate) (schedule-event (if (<= delay 2) 8 10) 'present-wait) (schedule-event (+ 8 delay) 'present-probe) (schedule-event (+ 14 delay) 'present-answer) (run 1000))) (defun busy-history (buffer) (let (record (xx (get-current-buffer-trace))) (do* ((temp (get-records xx buffer) (cdr temp)) (buffer1 (cdar temp) buffer2) (buffer2 (cdadr temp) (if temp (cdadr temp))) (time (caadr temp) (if temp (caadr temp)))) ((null (cdr temp)) (reverse (mapcar 'reverse record))) (cond ((BUFFER-SUMMARY-request buffer2) (push (list time time) record)) ((and (BUFFER-SUMMARY-BUSY buffer1) (or (BUFFER-SUMMARY-BUSY buffer2) (if (eq buffer 'retrieval) (BUFFER-SUMMARY-FULL buffer2)))) (setf record (cons (cons time (cdar record)) (cdr record)))))))) (defun busy-predict (buffer start end inc) (let ((times (busy-history buffer)) results (time start)) (loop (cond ((> time end) (return (reverse results)))) (setf results (cons (cumulative-bold times time) results)) (setf time (+ time inc))))) (defun cumulative (time time1 time2) (let ((average (/ (+ time1 time2) 2))) (* (+ (point (- time time1)) (* 2 (point (- time average))) (point (- time time2))) (- time2 time1) .25))) (defun cumulative* (time time1 time2) (setf time2 (min time time2)) (do ((x (- time2 1.5) (- x 1.5)) (y time2 x) (sum 0 (+ sum (cumulative time x y)))) ((< x time1) (+ sum (cumulative time time1 y))))) (defun cumulative-bold (times time) (do ((temp times (cdr temp)) (sum 0 (+ sum (cumulative* time (first (car temp)) (second (car temp)))))) ((or (null temp) (> (caar temp) time)) sum))) (defun point (time) (let ((scale (/ time *scale*))) (if (> time 0) (* *mag* (expt scale *exp*) (exp (- scale))) 0))) (defun get-records (xx buffer) (do ((temp xx (cdr temp)) (result nil (cons (do ((temp1 (buffer-record-buffers (car temp)) (cdr temp1))) ((eq (BUFFER-SUMMARY-NAME (car temp1)) buffer) (cons (buffer-record-time-stamp (car temp)) (car temp1)))) result))) ((null temp) (reverse result)))) (defun present-pair-immediate () (clear-exp-window) (add-text-to-exp-window :text *text1* :x 150 :y 125) (add-text-to-exp-window :text *text3* :x 175 :y 175) (proc-display :clear t)) (defun reset-the-goal () (mod-focus step start)) (defun present-warning () (clear-exp-window) (add-text-to-exp-window :text "*" :x 150 :y 150 :width 25) (proc-display :clear t)) (defun present-pair-delay () (clear-exp-window) (add-text-to-exp-window :text *text2* :x 150 :y 125) (add-text-to-exp-window :text *text4* :x 175 :y 175) (proc-display :clear t)) (defun present-probe () (clear-exp-window) (add-text-to-exp-window :text "band" :x 150 :y 150) (proc-display :clear t)) (defun present-answer () (clear-exp-window) (add-text-to-exp-window :text "2" :x 175 :y 150) (proc-display :clear t)) (defun present-wait () (clear-exp-window) (add-text-to-exp-window :text "+" :x 150 :y 150) (proc-display :clear t)) (defmethod rpm-window-key-event-handler ((win rpm-window) key) (setf *response* key)) (defun word-match (a b) (if (or (and (equal a "bxnd")(equal b "band"))(and (equal a "xid")(equal b "aid")) (and (equal a "sxld")(equal b "sold"))(and (equal a "xut")(equal b "out"))) 0)) (clear-all) (define-model dana (chunk-type goal step) (chunk-type pair first second type) (sgp :esc t :v t :model-warnings nil :do-not-harvest imaginal :bll .5 :rt -3 :lf .27 :ol nil :mp 10 :VISUAL-ATTENTION-LATENCY .1 :SIM-HOOK word-match :save-buffer-trace t :traced-buffers t) (add-dm (pair isa pair first "band" second "2" type object) (pair1 isa pair first "sold" second "2" type object) (pair2 isa pair first "band" second "aid" type phrase) (pair3 isa pair first "sold" second "out" type phrase)) (sdp :creation-time -1000000 :references 55) (p attend-warning =goal> isa goal step start =visual-location> isa visual-location ==> =goal> step wait-for-pair) (p attend-stimulus =goal> isa goal step wait-for-pair =visual-location> isa visual-location ==> +visual> isa move-attention screen-pos =visual-location =goal> step attend-stimulus) (p look-for-response =goal> isa goal step attend-stimulus =visual> isa text value =val ==> +imaginal> isa pair first =val type "Experiment" +visual-location> isa visual-location :attended nil =goal> step find-response) (p attend-response =goal> isa goal step find-response =visual-location> isa visual-location ==> +visual> isa move-attention screen-pos =visual-location =goal> step attend-response) (p process-response =goal> isa goal step attend-response =visual> isa text value =val =imaginal> isa pair first =first ==> +visual> isa clear =imaginal> second =val +retrieval> isa pair first =first second =val =goal> step elaborate) (p retrieve-elaboration =goal> isa goal step elaborate =retrieval> isa pair type object ==> =goal> step wait-for-interval) (p retrieve-elaboration3 =goal> isa goal step elaborate =retrieval> isa pair first =first type phrase ==> +imaginal> isa pair first =first second "2" =goal> step wait-for-interval) (p attend-interval =goal> isa goal step wait-for-interval =visual-location> isa visual-location ==> -imaginal> =goal> step wait-for-probe) (p attend-probe =goal> isa goal step wait-for-probe =visual-location> isa visual-location ==> +visual> isa move-attention screen-pos =visual-location =goal> step attend-probe) (p encode-probe =goal> isa goal step attend-probe =visual> isa text value =val ==> +visual> isa clear +retrieval> isa pair first =val =goal> step recall-response) (p recall-response =goal> isa goal step recall-response =retrieval> isa pair first =first second =second - type phrase ==> +imaginal> isa pair first =first second =second =goal> step response) (p recall-response1 =goal> isa goal step recall-response =retrieval> isa pair first =first second =second type phrase ==> +imaginal> isa pair first =first second =second =goal> step extract-response) (p extract-response =goal> isa goal step extract-response =imaginal> isa pair first =first second =val !eval! (not (response-member =val)) ==> +imaginal> isa pair first =first second "2" =goal> step response) (p type-response =goal> isa goal step response =imaginal> isa pair second =val ==> +manual> isa press-key key =val =goal> step wait-for-feedback) )