;;; 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-Back25 (High-Control) 
;;; uses phonological loop
;;; and topdown inhibition to account for the serial position effect 
;;; it predicts NBack scores of high control subjects  
;;; inter stimuli interval: 2.5s 

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

;;;data whole sample
;(defconstant *data-score* '(0.7795 0.5565 0.5295))
;(defconstant *data-targets* '(0.71 0.55 0.46))
;(defconstant *data-foils* '(0.839 0.563 0.599))

;;; data low control subjects 
;(defconstant *data-score* '(0.761966892 0.505784036 0.528516314))
;(defconstant *data-targets* '(0.63795495 0.420364361 0.368143739))
;(defconstant *data-foils* '(0.885978833 0.591203711 0.688888889))

;;; data high-control subjects (drop>0) 
(defconstant *data-score* '(0.64 0.48))
(defconstant *data-targets* '(0.71 0.57))
(defconstant *data-foils* '(0.58 0.4))

;;; data high performance subjects 
;(defconstant *data-score* '(0.856970497 0.676206517 0.618507494))
;(defconstant *data-targets* '(0.838147344 0.636672289 0.582914461))
;(defconstant *data-foils* '(0.87579365 0.715740744 0.654100528))

(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 ~%" "c_t_2" "c_t_3" "c_f_2" "c_f_3")
  (let ((ct2 0)(ct3 0)(ct4 0)(cf2 0)(cf3 0)(cf4 0)(rep2 0)(rep3 0)(rep4 0)(skp2 0)(skp3 0)(skp4 0)(fgt2 0)(fgt3 0)(fgt4 0))
    (dotimes (k m) 
      (reset)
      (let ((res (do-subject n))) ; n is the no of targets per subject per bloc: it should be arround 10 as in the data
        (setf ct2 (+ ct2 (first res)) ct3 (+ ct3 (second res)) cf2 (+ cf2 (third res)) cf3 (+ cf3 (fourth res)))
        (dolist (i res) (format t "~6,3F" i))) (format t "~%")
     )
    (format t "~6,3F~6,3F~6,3F~6,3F ~%" (/ ct2 m)(/ ct3 m)(/ cf2 m)(/ cf3 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 per subject per bloc (foils are as many as targets)
  (reset)
  (let ((c-target nil)(c-foil nil)(e-target nil)(e-foil nil))
  (dotimes (i 2) 
    (let ((corr-ts 0)(corr-fs 0)(err-ts 0)(err-fs 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))          
        ))
      (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)
))
(list (second c-target)(first c-target)(second c-foil)(first c-foil))
))

(defun do-condition (n) ; n is 2 or 3
  (reset)
  (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 lag 2 switch 0 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 lag 3 switch 0 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-HC-25

(sgp :esc t :trace-detail low :v nil	 
:ACT nil
:lf .1
:bll .4 
:egs .5
:ans .1   
:rt                      -0.35 ;   
:MAS                         3 ;   default: NIL        : Maximum Associative Strength
:GA                          1 ;   default: 1          : source spread for the GOAL buffer
:UL                          t ;   default: NIL
:ALPHA                     0.2 ;   default: 0.2        : Production learning rate
:HEAR-NEWEST-ONLY          nil ;   default: NIL        : Whether to stuff only the newest unattended audio-event from the audicon into the aural-location buffer.
:SOUND-DECAY-TIME          3.0 ;   default: 3.0        : The amount of time after a sound has finished it takes for the sound to be deleted from the audicon
:AURAL-ACTIVATION            0 ;   default: 0          : source spread for the AURAL buffer
:subvocalize-detect-delay  0.3 ;   default: 0.3 
:imaginal-delay            0.2 ;   default: 0.2
:imaginal-activation        -8 ;   default: 0
:DECLARATIVE-FINST-SPAN   20.0 ;   default: 3.0        : Duration of declarative finst markers in seconds
:DECLARATIVE-NUM-FINSTS    20  ;   default: 4          : Number of declarative finst markers
)

(chunk-type spot-targets letter disletter lag count switch state)
(chunk-type discarded-item value)
(chunk-type number string value)

(add-dm (detect isa chunk))
(add-dm (attend isa chunk))
(add-dm (old isa chunk))
(add-dm (start isa chunk))
(add-dm (decide isa chunk))
(add-dm (feedback isa chunk))
(add-dm (read isa chunk))
(add-dm (continue isa chunk))
(add-dm (rehearse isa chunk))
(add-dm (end-rehearse isa chunk))
(add-dm (count isa chunk))
(add-dm (compute-lag 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))

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

(P subvocalize-seen-item 
   =goal>
      ISA         spot-targets
      state       start
   =visual>
      isa         text
      value       =letter
      status      nil
   ?vocal>
      state       free
   ?imaginal>
      state       free 
==>
   =visual>
      status      old
   +vocal>
      isa         subvocalize 
      string      =letter
   +imaginal>
      isa         discarded-item
      value       "no-start"
   =goal>
      disletter   =letter 
      state       detect
)

(P subvocalize-seen-item-and-listen 
   =goal>
      ISA         spot-targets
      state       detect
   =visual>
      isa         text
      value       =letter
      status      nil
   ?vocal>
      state       free
   =aural-location>
      ISA         audio-event
==>
   +aural>
      ISA         sound
      event       =aural-location
   =visual>
      status      old
   +vocal>
      isa         subvocalize 
      string      =letter
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended    nil
   =goal>
      state       rehearse
   !eval! (setf *count* 0)
)

(P subvocalize-heard-item-and-listen 
   =goal>
      ISA         spot-targets
      disletter   =disletter   
      state       rehearse
   =visual>
      isa         text
      value       =current-letter
      status      old
   =aural>
      isa         sound
      content     =letter
   ?vocal>
      state       free
   =aural-location>
      ISA         audio-event
   ?retrieval>
      state       free  
   =retrieval>
      isa         text 
      value       =current-letter  
==>
   +aural>
      ISA         sound
      event       =aural-location
   =visual>
   +vocal>
      isa         subvocalize 
      string      =letter
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended    nil
   +retrieval>
      isa         sound
      content     =disletter   
      :recently-retrieved nil
   =goal>
      letter      =current-letter
   !eval! (incf *count*)
)

(P* subvocalize-heard-item-and-listen1 
   =goal>
      ISA         spot-targets
      disletter   =disletter   
      state       rehearse
   =visual>
      isa         text
      - value     =letter
      status      old
   =aural>
      isa         sound
      content     =letter
   ?vocal>
      state       free
   =aural-location>
      ISA         audio-event
   ?retrieval>
      state       free  
   =imaginal>
      isa         discarded-item
==>
   +aural>
      ISA         sound
      event       =aural-location
   =visual>
   +vocal>
      isa         subvocalize 
      string      =letter
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended   nil
   +retrieval>
      isa         sound
      content     =disletter   
      :recently-retrieved nil
   =imaginal>
      =aural     =aural
   !eval! (incf *count*)
)

(P* subvocalize-discarded-item-and-listen 
   =goal>
      ISA         spot-targets
      disletter   =disletter   
      state       rehearse
   =visual>
      isa         text
      - value     =letter
      status      old
   =aural>
      isa         sound
      content     =letter
   ?vocal>
      state       free
   =aural-location>
      ISA         audio-event
   ?retrieval>
      state       free  
   =retrieval>
      isa         sound 
      content     =disletter  
   =imaginal>
      isa         discarded-item
      value       start
==>
   =imaginal>
   +aural>
      ISA         sound
      event       =aural-location
   =visual>
   +vocal>
      isa         subvocalize 
      string      =disletter
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended    nil
   +retrieval>
      isa         sound
      content     =disletter   
   !eval! (incf *count*)
)

(P* subvocalize-heard-item-and-listen2 
   =goal>
      ISA         spot-targets
      state       rehearse
   =visual>
      isa         text
      value       =letter
      status      old
   =aural>
      isa         sound
      content     =letter
   ?vocal>
      state       free
   =aural-location>
      ISA         audio-event
   =imaginal>
      isa         discarded-item
==>
   +aural>
      ISA         sound
      event       =aural-location
   =visual>
   +vocal>
      isa         subvocalize 
      string      =letter
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended   nil
   =imaginal>
      =aural     =aural
   =goal>
      state       continue
)

(P subvocalize-seen-item-and-continue 
   =goal>
      ISA         spot-targets
      state       continue
      switch      0
   =visual>
      isa         text
      value       =letter
      status      nil
   ?retrieval>
      state       free   
   ?vocal>
      state       free
==>
   =visual>
      status      old
   +vocal>
      isa         subvocalize 
      string      =letter
   +retrieval>
      isa         text
      value       =letter   
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended    nil
   =goal>
      switch      1
      state       rehearse
   !eval! (setf *count* 0)
)

(P subvocalize-seen-item-and-continue-once-more 
   =goal>
      ISA         spot-targets
      state       continue
      switch      1
      lag         3
   =visual>
      isa         text
      value       =letter
      status      nil
   ?retrieval>
      state       free   
   ?vocal>
      state       free
==>
   =visual>
      status      old
   +vocal>
      isa         subvocalize 
      string      =letter
   +retrieval>
      isa         text
      value       =letter   
   =goal>
      switch      2
      state       rehearse
   !eval! (setf *count* 0)
)

(P* subvocalize-seen-item-and-continue1 
   =goal>
      ISA         spot-targets
      - switch    0
      state       continue
   =visual>
      isa         text
      value       =letter
      status      nil
   =aural>
      isa         sound
      content     =disletter
   ?retrieval>
      state       free   
   ?vocal>
      state       free
   =imaginal>
      isa         discarded-item
   =aural-location>
      ISA         audio-event
==>
   +aural>
      ISA         sound
      event       =aural-location
   =visual>
      status      old
   +vocal>
      isa         subvocalize 
      string      =letter
   +retrieval>
      isa         text
      value       =letter   
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended   nil
   =imaginal>
      value       start
      =aural     =aural
   =goal>
      state       rehearse
      disletter   =disletter
   !eval! (setf *count* 0)
)

(P subvocalize-seen-item-and-continue1-with-disturbed-loop 
   =goal>
      ISA         spot-targets
      - switch    0
      state       continue
   =visual>
      isa         text
      value       =letter
      status      nil
   ?retrieval>
      state       free   
   ?vocal>
      state       free
   =aural-location>
      ISA         audio-event
==>
   +aural>
      ISA         sound
      event       =aural-location
   =visual>
      status      old
   +vocal>
      isa         subvocalize 
      string      =letter
   +retrieval>
      isa         text
      value       =letter   
   +aural-location>
      ISA         audio-event
   =goal>
      state       rehearse
   !eval! (setf *count* 0)
)

(P subvocalize-seen-item-and-continue2 
   =goal>
      ISA         spot-targets
      state       rehearse
   =visual>
      isa         text
      value       =letter
      status      nil
   ?retrieval>
      state       free   
   ?vocal>
      state       free
   =aural-location>
      ISA         audio-event
==>
   +aural>
      ISA         sound
      event       =aural-location
   =visual>
      status      old
   +vocal>
      isa         subvocalize 
      string      =letter
   +retrieval>
      isa         text
      value       =letter   
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended    nil
   !eval! (setf *count* 0)
)

(P subvocalize-seen-item-and-continue3 
   =goal>
      ISA         spot-targets
      state       rehearse
   =visual>
      isa         text
      value       =letter
      status      nil
   ?retrieval>
      state       free   
   ?vocal>
      state       free
==>
   =visual>
      status      old
   +vocal>
      isa         subvocalize 
      string      =letter
   +retrieval>
      isa         text
      value       =letter   
   !eval! (setf *count* 0)
)

(P find-target
   =goal>
      isa         spot-targets
   =visual>
      isa         text
      value       =letter
      status      old
   =aural> 
      isa         sound 
      content     =letter   
   =retrieval>
      isa         text
      value       =letter
   =aural-location>
      isa         audio-event 
   ?vocal>
      state       free
   !eval! (equal *count* 0)
==>
   =visual>
   +aural>
      ISA         sound
      event       =aural-location
   +vocal>
      isa         subvocalize 
      string      =letter
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended   nil
   =goal>
      state       rehearse
   !eval! (if *t* (progn (setf *c-t* t)(setf *t* nil))(if *f* (progn (setf *e-f* t)(setf *f* nil))))
)

(P find-foil-before
   =goal>
      ISA         spot-targets
      disletter   =letter
      lag         =lag
   =visual>
      isa         text
      value       =letter
      status      old
   =retrieval>
      isa         text
      value       =letter
   =aural-location>
      ISA         audio-event
;   !eval! (= *count* =lag)
   !eval! (or *t* *f*)
==>
   +aural>
      ISA         sound
      event       =aural-location
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended   nil
   =goal>
      state       rehearse
   !eval! (if *f* (progn (setf *c-f* t)(setf *f* nil))(if *t* (progn (setf *e-t* t)(setf *t* nil))))
)

(P find-foil-after
   =goal>
      ISA         spot-targets
      letter      =letter
   =visual>
      isa         text
      value       =letter
      status      old
   =aural>
      ISA         sound
      content     =letter
   =aural-location>
      ISA         audio-event
   !eval! (= *count* 1)
   !eval! (or *t* *f*)
==>
   +aural>
      ISA         sound
      event       =aural-location
   +aural-location>
      ISA         audio-event
      onset       lowest
      :attended    nil
   =goal>
      state       rehearse
   !eval! (if *f* (progn (setf *c-f* t)(setf *f* nil))(if *t* (progn (setf *e-t* t)(setf *t* nil))))
)

(spp :u 100)
(spp (find-foil-before :u 5))
(spp (find-foil-after :u 5))
(spp (find-target :u 1500))
(spp (subvocalize-seen-item :u 25))
(spp (subvocalize-seen-item-and-listen :u 50))
(spp (subvocalize-seen-item-and-continue1 :reward 10))
(spp (subvocalize-seen-item-and-continue1-with-disturbed-loop :u 0 :reward 10)) ; :u was 54
(spp (subvocalize-seen-item-and-continue2 :u 50 :reward 10))
(spp (subvocalize-seen-item-and-continue3 :u 50 :reward 10))
(spp (subvocalize-seen-item-and-continue-once-more :u 125 :reward 10))

(spp (subvocalize-heard-item-and-listen1 :u 500))
(spp (subvocalize-discarded-item-and-listen :u 500))

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