;;; Model developed by Ion Juvina 2007 
;;;
;;; reference: 
;;; Juvina, I., & Taatgen, N. A. (2007). Modeling control 
;;; strategies in the N-Back task. Proceedings of the eight International 
;;; Conference on Cognitive Modeling (pp. 73-78). New York: Psychology 
;;; Press. 
;;;
;;; N-Back Low Control25
;;; low control
;;; it uses the temporal module
;;; it models low-control subjects: the ones that do not drop their performance with serial position  
;;; it learns to estimate n-back durations from feedback to reactions to repetition
;;; Targets = Foils; ISI: 2.5 sec

(defvar *letters*)
(defvar *target*)
(defvar *foil*)
(defvar *t*)
(defvar *f*)
(defvar *c-t*)
(defvar *c-f*)
(defvar *e-t*)
(defvar *e-f*)
(defvar *react*)
(defvar *skip*)
(defvar *forget*)
(defvar *flip* 1)

;;; data low-control subjects (drop<0)
(defconstant *data-score* '(0.46 0.34))
(defconstant *data-targets* '(0.62 0.52))
(defconstant *data-foils* '(0.3 0.16))

(defun display-letter ()
  (clear-exp-window)
  (add-text-to-exp-window :text (pop *letters*) :x 25 :y 50 :color 'black)
  (proc-display)
)

(defun display-pre-target ()
  (clear-exp-window)
  (setf *target* (pop *letters*))
  (add-text-to-exp-window :text *target* :x 25 :y 50 :color 'black)
  (proc-display)
  *target*)

(defun display-target ()
  (clear-exp-window)
  (add-text-to-exp-window :text *target* :x 25 :y 50 :color 'black)
  (setf *t* t)
  (proc-display)
  *target*)

(defun display-pre-foil ()
  (clear-exp-window)
  (setf *foil* (pop *letters*))
  (add-text-to-exp-window :text *foil* :x 25 :y 50 :color 'black)
  (proc-display)
  *foil*)

(defun display-foil ()
  (clear-exp-window)
  (add-text-to-exp-window :text *foil* :x 25 :y 50 :color 'red)
  (setf *f* t)
  (proc-display)
  *foil*)

(defun do-exp (m n) ; m is the no of subjects
  (reset)
  (format t "~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F ~%" "c_t_2" "c_t_3" "c_f_2" "c_f_3" "rep_2" "rep_3" "skp_2" "skp_3" "fgt_2" "fgt_3")
  (let ((ct2 0)(ct3 0)(cf2 0)(cf3 0)(rep2 0)(rep3 0)(skp2 0)(skp3 0)(fgt2 0)(fgt3 0))
    (dotimes (k m) 
      (reset)
      (let ((res (do-subject n))) ; n is the no of targets and foils per subject per bloc: it should be 20 (10+10) as in the data
        (setf ct2 (+ ct2 (first res)) ct3 (+ ct3 (second res)) cf2 (+ cf2 (third res)) cf3 (+ cf3 (fourth res)))
        (setf rep2 (+ rep2 (nth 4 res)) rep3 (+ rep3 (nth 5 res)) skp2 (+ skp2 (nth 6 res)) skp3 (+ skp3 (nth 7 res)) fgt2 (+ fgt2 (nth 8 res)) fgt3 (+ fgt3 (nth 9 res)))
        (dolist (i res) (format t "~6,3F" i))) (format t "~%")
     )
    (format t "~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F ~%" (/ ct2 m)(/ ct3 m)(/ cf2 m)(/ cf3 m)(/ rep2 m)(/ rep3 m)(/ skp2 m)(/ skp3 m)(/ fgt2 m)(/ fgt3 m))
    (correlation (list (/ (+ ct2 cf2) (* 2 m))(/ (+ ct3 cf3) (* 2 m))) *data-score*)
    (correlation (list (/ ct2 m) (/ ct3 m)) *data-targets*)
    (correlation (list (/ cf2 m) (/ cf3 m)) *data-foils*)
    (mean-deviation (list (/ (+ ct2 cf2) (* 2 m))(/ (+ ct3 cf3) (* 2 m))) *data-score*)
    (mean-deviation (list (/ ct2 m) (/ ct3 m)) *data-targets*)
    (mean-deviation (list (/ cf2 m) (/ cf3 m)) *data-foils*)
  )
)

(defun do-subject (n) ; n is the no of targets and foils per subject per bloc (foils are as many as targets)
  (reset)
  (let ((c-target nil)(c-foil nil)(e-target nil)(e-foil nil)(reaction nil)(omission nil)(forgetting nil))
  (dotimes (i 2) 
    (let ((corr-ts 0)(corr-fs 0)(err-ts 0)(err-fs 0)(*react* 0)(*skip* 0)(*forget* 0)(*flip* 1))
      (dotimes (j n) 
        (let ((res (do-condition (+ i 2)))) ; n-back = 2,3
          (when (first res)(incf corr-ts))
          (when (second res)(incf corr-fs))
          (when (third res)(incf err-ts))
          (when (fourth res)(incf err-fs))
        ))
;      (format t "~D ~6,3F ~6,3F ~6,3F ~6,3F ~6,3F ~6,3F ~6,3F~%" (+ i 2) (/ corr-ts n)(/ corr-fs n)(/ err-ts n)(/ err-fs n)(/ *react* (* 2 n))(/ *skip* (* 2 n))(/ *forget* (* 2 n)))
      (push (/ corr-ts (/ n 2)) c-target)
      (push (/ corr-fs (/ n 2)) c-foil)
      (push (/ err-ts (/ n 2)) e-target)
      (push (/ err-fs (/ n 2)) e-foil)
      (push (/ *react* n) reaction)
      (push (/ *skip* n) omission)
      (push (/ *forget* n) forgetting)
))
;  (dolist (i (reverse c-target)) (format t "~%~6,3F" i))  (format t "~%")
;  (dolist (i (reverse c-foil)) (format t "~%~6,3F" i))  (format t "~%")
;  (dolist (i (reverse e-target)) (format t "~%~6,3F" i))  (format t "~%")
;  (dolist (i (reverse e-foil)) (format t "~%~6,3F" i))  (format t "~%")
;  (dolist (i (reverse reaction)) (format t "~%~6,3F" i))  (format t "~%")
;  (dolist (i (reverse omission)) (format t "~%~6,3F" i))  (format t "~%")
;  (dolist (i (reverse forgetting)) (format t "~%~6,3F" i))  (format t "~%")
(when (= (length c-target) (length *data-targets*)) (correlation (reverse c-target) *data-targets*))
(when (= (length c-target) (length *data-targets*)) (mean-deviation (reverse c-target) *data-targets*))
(list (second c-target)(first c-target)(second c-foil)(first c-foil)(second reaction)(first reaction)(second omission)(first omission)(second forgetting)(first forgetting))
))

(defun do-condition (n) ; n is 2,3
  (setf *target* nil *foil* nil *t* nil *f* nil)
  (setf *c-t* nil *c-f* nil *e-t* nil *e-f* nil)
  (setf *letters* (permute-list '("B" "C" "D" "F" "G" "H" "J" "K" "L" "M" "N" "P" "R" "S" "T" "V" "W" "X" "Z")))
  (progn
  (when (equal n 2) (let ((goal-2 (new-name "GOAL")))
    (eval `(add-dm (,goal-2 isa spot-targets time nil lag two state attend)))
    (eval `(goal-focus ,goal-2))
    ))
  (when (equal n 3) (let ((goal-3 (new-name "GOAL")))
    (eval `(add-dm (,goal-3 isa spot-targets time nil lag three state attend)))
    (eval `(goal-focus ,goal-3))
    )))

  (let* ((window (open-exp-window "N-Back" :visible nil)))
   (if *actr-enabled-p*
        (progn
          (install-device window)
          (proc-display)))
   (let ((p (+ 1 (random 5))))
     (if (= *flip* 1) 
       (progn
       (dotimes (i p) (schedule-event-relative (+ 2.5 (* i 2.5)) 'display-letter))
       (schedule-event-relative (+ 2.5 (* 2.5 p)) 'display-pre-target)
       (dotimes (i (- n 1)) (schedule-event-relative (+ (+ 5.0 (* 2.5 p)) (* i 2.5)) 'display-letter))
       (schedule-event-relative (+ (+ 2.5 (* 2.5 p)) (* n 2.5)) 'display-target)
       (dotimes (i (- 6 n)) (schedule-event-relative (+ (+ 5.0 (* 2.5 p)) (* (+ n i) 2.5)) 'display-letter))
       (setf *flip* 0))
     (progn 
       (dotimes (i p) (schedule-event-relative (+ 2.5 (* i 2.5)) 'display-letter))
       (schedule-event-relative (+ 2.5 (* 2.5 p)) 'display-pre-foil)
       (let ((r (random 2))) (if (equal r 0) (progn 
                                           (dotimes (i (- n 2)) (schedule-event-relative (+ (+ 5.0 (* 2.5 p)) (* i 2.5)) 'display-letter))
                                           (schedule-event-relative (+ (+ 0.0 (* 2.5 p)) (* n 2.5)) 'display-foil)
                                           (dotimes (i 2) (schedule-event-relative (+ (+ 2.5 (* 2.5 p)) (* (+ n i) 2.5)) 'display-letter)))

                             (progn
                               (dotimes (i n) (schedule-event-relative (+ (+ 5.0 (* 2.5 p)) (* i 2.5)) 'display-letter))
                               (schedule-event-relative (+ (+ 5.0 (* 2.5 p)) (* n 2.5)) 'display-foil)
                               (dotimes (i 2) (schedule-event-relative (+ (+ 7.5 (* 2.5 p)) (* (+ n i) 2.5)) 'display-letter)))))
       (setf *flip* 1)))
   (run 50 :real-time nil)
   (format t "~6,3F~6,3F~6,3F~6,3F~6,3F~6,3F ~%" n p *c-t* *c-f* *e-t* *e-f*)
   ))

   (list *c-t* *c-f* *e-t* *e-f*)
)

(clear-all)

(define-model N-Back-LC25

(sgp :esc t :trace-detail low :v nil	 
:ACT nil
:lf .1
:bll .5 
:egs 1.5
:ans .05
:rt                      -0.35 ;   was -0.35
:TIME-NOISE              0.015 ;   default: 0.015      : Temporal noise
:MAS                         3 ;   default: NIL        : Maximum Associative Strength
:DECLARATIVE-FINST-SPAN   10.0 ;   default: 3.0        : Duration of declarative finst markers in seconds
:GA                        1.5 ;   default: 1          : source spread for the GOAL buffer
:UL                          t ;   default: NIL
:ALPHA                     0.2 ;   default: 0.2        : Production learning rate
)

(chunk-type spot-targets time lag state)
(chunk-type estimation time value judgment)
(chunk-type number string value)

(add-dm (detect isa chunk))
(add-dm (attend isa chunk))
(add-dm (estimate isa chunk))
(add-dm (feedback isa chunk))
(add-dm (read isa chunk))
(add-dm (update isa chunk))
(add-dm (decide isa chunk))
(add-dm (react isa chunk))
(add-dm (compute-time isa chunk))
(add-dm (one isa chunk))
(add-dm (two isa chunk))
(add-dm (three isa chunk))
(add-dm (four isa chunk))
(add-dm (five isa chunk))

(add-dm (n1 isa number string n1 value 1))
(add-dm (n2 isa number string n2 value 2))
(add-dm (n3 isa number string n3 value 3))
(add-dm (n4 isa number string n4 value 4))
(add-dm (n5 isa number string n5 value 5))
(add-dm (n6 isa number string n6 value 6))
(add-dm (n7 isa number string n7 value 7))
(add-dm (n8 isa number string n8 value 8))
(add-dm (n9 isa number string n9 value 9))
(add-dm (n10 isa number string n10 value 10))
(add-dm (n11 isa number string n11 value 11))
(add-dm (n12 isa number string n12 value 12))
(add-dm (n13 isa number string n13 value 13))
(add-dm (n14 isa number string n14 value 14))

;;; time estimations 

(add-dm (e21 isa estimation time n4 value two judgment "correct"))

(set-all-base-levels 10000000 -1000)

(P attend-letter
   =goal>
      ISA         spot-targets
      state       attend
   =visual-location>
      ISA         visual-location
   ?visual>
      state       free
   ?temporal>
      state       free
==>
   +visual>
      ISA         move-attention
      screen-pos  =visual-location
   +temporal>
      isa         time
   =goal>
      state       detect
)

(P retrieve-repeated-letter
   =goal>
      ISA         spot-targets
      state       detect
   =visual>
      isa         text
      value       =letter
      status      nil
   =temporal>
      isa         time
      ticks       =ticks
   ?retrieval>
      state       free
   ?vocal>
      state       free
==>
   =temporal>
   =visual>
      status      =ticks
   +retrieval>
      isa         text  
      value       =letter
      < status    =ticks
      :recently-retrieved nil
   +vocal>
      isa         subvocalize 
      string      =letter
   =goal>
      state       compute-time
;   !eval!         (if *t* (format t "target")(if *f* (format t "foil")))
)

(P listen-letter
   =goal>
      ISA         spot-targets
   =aural-location>
      ISA         audio-event
   ?aural>
      state       free
==>
   +aural>
      ISA         sound
      event       =aural-location
)

(P score-failure-to-detect-repetition
   =goal>       
      isa         spot-targets
      state       compute-time
   ?retrieval>
      state       error
;   !eval! (or *f* *t*)
==>
   =goal>       
      state       detect
   !eval! (if *f* (progn (setf *e-f* t)(setf *f* nil)(incf *forget*))(if *t* (progn (setf *e-t* t)(setf *t* nil)(incf *forget*))))
)

(P compute-interval
   =goal>       
      isa         spot-targets
      state       compute-time
   =retrieval>
      isa         text
      status      =old
   =visual>
      isa         text
      status      =new
   ?retrieval>
      state       free
==>
   !bind! =time (- =new =old) 
   +retrieval>
      isa         number  
      value       =time
   =goal>       
      state       estimate
   !output!       =old
   !output!       =new
)

(P fail-to-compute-interval
   =goal>       
      isa         spot-targets
      state       estimate
   ?retrieval>
      state       error
==>
   =goal>       
      time        nil
      state       react
)

(P retrieve-estimation
   =goal>       
      isa         spot-targets
      state       estimate
   =retrieval>
      isa         number
      string      =time
   ?retrieval>
      state       free
==>
   +retrieval>
      isa         estimation  
      time        =retrieval
      judgment    "correct"
   =goal>       
      time        =time 
      state       decide
)

(P retrieve-new-estimation
   =goal>       
      isa         spot-targets
      time        =time 
      state       decide
   ?retrieval>
      state       error
==>
   +retrieval>
      isa         estimation  
      time        =time
      judgment    "correct"
   =goal>       
      state       react
)

(P react-to-repetition-as-it-were-target
   =goal>       
      isa         spot-targets
      time        =time
      lag         =lag
      state       react
   ?retrieval>
      state       error
   ?manual>
      state       free
   ?imaginal>
      state       free
==>
   +imaginal>
      isa         estimation
      time        =time 
      value       =lag
      judgment    "correct"
   +manual>
      isa         press-key
      key         "M"
   !eval! (if *f* (progn (setf *e-f* t)(setf *f* nil)(clear-exp-window)(add-text-to-exp-window :text "error" :x 25 :y 50)(proc-display))(if *t* (progn (setf *c-t* t)(setf *t* nil)(clear-exp-window)(add-text-to-exp-window :text "correct" :x 25 :y 50)(proc-display))))
   =goal>       
     state        feedback
     !eval! (incf *react*)
)

(P react-to-repetition-as-it-were-foil
   =goal>       
      isa         spot-targets
      time        =time
      lag         =lag
      state       react
   ?retrieval>
      state       error
   ?manual>
      state       free
   ?imaginal>
      state       free
==>
   +imaginal>
      isa         estimation
      time        =time 
      value       =lag
      judgment    "incorrect"
   +manual>
      isa         press-key
      key         "Z"
   =goal>       
     state        feedback
   !eval! (if *f* (progn (setf *c-f* t)(setf *f* nil))(if *t* (progn (setf *e-t* t)(setf *t* nil))))
   !eval! (incf *skip*)
)

(P find-target
   =goal>       
     isa          spot-targets
     lag          =lag
     state        decide
   =retrieval>
     isa          estimation
     value        =lag
     judgment     "correct"
   ?manual>
     state        free
==>
   =retrieval>
   +manual>
     isa          press-key
     key          "M"
   !eval! (if *f* (progn (setf *e-f* t)(setf *f* nil)(clear-exp-window)(add-text-to-exp-window :text "error" :x 25 :y 50)(proc-display))(if *t* (progn (setf *c-t* t)(setf *t* nil)(clear-exp-window)(add-text-to-exp-window :text "correct" :x 25 :y 50)(proc-display))))
   =goal>       
     state        feedback
)

(P find-foil
   =goal>       
     isa          spot-targets
     lag          =lag
     state        decide
   =retrieval>
     isa          estimation
     - value      =lag
     judgment     "correct"
   ?manual>
     state        free
==>
   =retrieval>
   +manual>
     isa          press-key
     key          "Z"
   !eval! (if *f* (progn (setf *c-f* t)(setf *f* nil)(clear-exp-window)(add-text-to-exp-window :text "correct" :x 25 :y 50)(proc-display))(if *t* (progn (setf *e-t* t)(setf *t* nil)(clear-exp-window)(add-text-to-exp-window :text "error" :x 25 :y 50)(proc-display))))
   =goal>       
     state        feedback
)

(P find-foil-in-aural 
   =goal>
      ISA         spot-targets
      lag         two
      state       detect
   =visual>
      isa         text
      value       =letter
      status      nil
   =aural>
      isa         sound
      content     =letter
   ?manual>
     state        free
   !eval! *f*
==>
   +manual>
     isa          press-key
     key          "Z"
   !eval! (progn (setf *c-f* t)(setf *f* nil))
;   !eval!        (format t "foil")
)

(P attend-feedback
   =goal>
      isa         spot-targets
      state       feedback
   ?visual-location>
      buffer      unrequested 
==>
   +visual-location>
      ISA         visual-location
   =goal>
      state       read
)

(P read-feedback
   =goal>
     isa          spot-targets
     state        read
   =visual-location>
      ISA         visual-location
   ?visual>
      state        free
==>
   +visual>
      ISA         move-attention
      screen-pos  =visual-location
   =goal>
      state       update
)

(P update-estimation-in-retrieval
   =goal>       
     isa          spot-targets
     state        update
   =visual>
     isa          text
     value        =feedback
   =retrieval>
     isa          estimation
==>
   =retrieval>
     judgment     =feedback
   =goal>       
     state        attend
)

(P update-estimation-in-imaginal
   =goal>       
     isa          spot-targets
     state        update
   =visual>
     isa          text
     value        =feedback
   =imaginal>
     isa          estimation
==>
   =imaginal>
     judgment     =feedback
   =goal>       
     state        attend
)

(spp :u 100)
(spp (find-foil-in-aural :u 100))

(spp (react-to-repetition-as-it-were-foil :u 80))

(spp (update-estimation-in-retrieval :reward 75))
(spp (update-estimation-in-imaginal :reward 75))

(setf *actr-enabled-p* t)
)