examples/published-results/ecvp-2023-posner/posner-initialise.lisp

;; This file specifies the operators for the DMTS tasks
;; - defines: timings; 'detect-main'; 'decay'; 'interpret'; 'operator-set'; 'dotted-replace'; 'clean-and-save'; 'check-fitness'; structures: input,  model

(defparameter $inputT 100)    ;; perception + attend
(defparameter $outputT 140)   ;; intend + movement
(defparameter $cogT 70)       ;; basic cognitive process
(defparameter $stmT 50)       ;; basic STM process
(defparameter $syntaxT 0)     ;; prog2, if      ;; these are different from cognitive operators
(defparameter $learningT 0)   ;; might just make this cog...

(defun check-fitness (overall-fitness program)
  (when (< overall-fitness .10) ;; changed from .10
    (let ((ms  (format nil
                       "~%Good-fit!~%Fitness =====> ~4,3F
~A~%----------------------------------"
                       overall-fitness program) )) ; overall-fitness  *rand* program) ))
      (format t "~A" ms)
      (break ms)
      )))

;;(defvar *ResWagrate* .05)  ;; rate of learning for Rescola-Wagner operator; [what is a good value based on the literature?]



#|
### Setting up structures ###
|#

(defstruct input
  ;;(name 0)
  (location :centre)
  (type :stimulus)
  (direction nil)
  (modality nil)
  (store-time nil))

(defstruct model 
  "Defines the state of a model and its interactions with the environment"
  (clock 0)        
  (current input-nil)
  (stm (list input-nil input-nil input-nil))
  (attFocus :centre)  ;; focus of attention; default is centre
  (salient input-nil)        ;; salient is what is salient in the visual field.
  response  
  inputs              ;; buffers for inputs
  strength-assoc
  prev-trial
  _screenLeft
  _screenCentre
  _screenRight
  ( _inputName  "_")
  ( _type :stimulus))

(defstruct result
  inputs
  (response "-")
  validity
  prob-valid
  (accuracy 0)
  (timing 0))


#|
### detect-main ###
|#

(defun detect-main (md)
  (let ((current-stimuli (timeline (model-clock md)))  ;; (stim1 centre) (stim2 nil) 
        (att (model-attFocus md))
        (stim nil))
    
    ;; for this experiment theres only ever 1 stimulus at a time - need to change this if not the case anymore
    (when (equal (first (first current-stimuli)) 'stim2)
      (setf (second (first current-stimuli)) (input-location (second (model-inputs md)))))
    
    (setf stim (first (find-if #'(lambda (y)
                                   (equal (symbol-name (second y)) (symbol-name att)))
                               current-stimuli)))   
    
    (if stim 
      (setf (model-salient md)
            (nth (- (parse-integer (subseq (symbol-name stim) 4)) 1) (model-inputs md)))
      (setf (model-salient md) input-nil)
      )))

;; for different implementations of decay see DMTS initialise

#|
### decay ###
|#

;;ACT-R DECAY BUFFER VERSION OF DECAY:
(defun decay (md) 
  (when (equal decay-toggle 1) ;; if we want decay
    (dotimes (y (length (model-stm md))) ;; for each item in stm
      (when (not (equal (input-store-time (nth y (model-stm md))) nil)) ;; check that the item is a thing, i.e. store-time isn't nil
        (let* ((temp-stim (nth y (model-stm md))) ;; save the stm-item as temp-stim
               (*time (/ (- (model-clock md) (input-store-time temp-stim)) 1000)) ;; time stored (s)
               (activation (- 1 (* 0.4 (log (+ 1 *time))))))
          (when (< activation *decay-threshold*) (setf (nth y (model-stm md)) input-nil))))))) ;; get rid if less than decay threshold

#|
### Learning functions ###
|#

(defvar *ResWagrate* .1)  ;; rate of learning for Rescola-Wagner operator; [what is a good value based on the literature?]
;; seems its mostly estimated from the data - i have increased it as it was  doing very little before - but unsure what value to use.

(defun Rescola-Wagner (alpha lambda V)
  "output delta-V (change in strength of association); alpha = rate of change; lambda = max value of current strenght of association;
   V = current strength of association"
  (* alpha (- lambda V)))

(defun update-from-trial (rate strength el)
  "Updates strength of association after one trial. Outputs delta-V. Used in GEMS"
  ;;(print (list rate strength el))
  (cond ((equal el "V")
         (Rescola-Wagner rate 1.0 strength))  ;; max = 1.0
        ((equal el "I")
         (Rescola-Wagner rate 0.0 strength))  ;; min = 0.0
        (t (error "wrong element"))))

(defun RW-predict-stim (strength-association cue)
  "Used in GEMS operator. 
(a) Input is strength-association. Outputs stimulus given cue. Pure anticipation: uses only cue, not stimulus itself.
(b) Input is (priming strength-association). Combines info about cue and stimulus"
  (let ((p (random 1.0)))
    (cond ((equal cue :left)
           (if (< p strength-association) :left :right))
          
          ((equal cue :right)
           (if (< p strength-association) :right :left))
          ;; (t (error "wrong cue"))
          ))) ;; if it isn't 1 or 2, then its the default and nothings been put into stm - so just do nothing.
;;

(setf pre-val "")

#|
### convenience functions ###
|#
;; These convenience functions allow interpret/display-pseudocode to 
;; work with both s-expressions and syntax-tree:node structures.

(defun operator-label (operator)
  "Returns label of given operator"
  (typecase operator
    (list 
     (intern (symbol-name (first operator)) "KEYWORD"))
    (syntax-tree:node
     (intern (symbol-name (syntax-tree:node-label operator)) "KEYWORD"))
    (otherwise
      (error "Invalid operator type"))))

(defun operator-children (operator)
  "Returns children of given operator"
  (typecase operator
    (list 
      (rest operator))
    (syntax-tree:node
      (syntax-tree:node-children operator))
    (otherwise
      (error "Invalid operator type"))))

#|
### Fitness functions ###
|#

(defun fitness-accuracy (accuracy d-a)
  "Computes the f_a objective function: 100% is target mean accuracy."
  ;;(abs (- 1.0 accuracy)))
  (/ (abs (- accuracy d-a)) d-a))

(defun fitness-acc-sd (accuracy-sd d-a)
  "Computes the f_a objective function: 100% is target mean accuracy."
  ;;(abs (- 1.0 accuracy)))
  (/ (abs (- accuracy-sd d-a)) d-a))

(defun fitness-time (response-time d-rt)
  "Computes the f_t objective function."
  ;;(gems:half-sigmoid (/ (abs (- response-time 200)) *time-rt*)))
  ;;(/ (abs (- response-time *data-rt*)) *data-rt*))
  (gems:half-sigmoid (/ (abs (- response-time d-rt)) d-rt)))

(defun fitness-size (program-size)
  "Computes the f_s objective function"
  (gems:half-sigmoid (/ program-size *size-ps*)))

#|
(defun fitness-no-phase (f-a f-t f-s)
  "Computes the overall fitness"
  (+ (* *fitness-accuracy* f-a)
     (* *fitness-time* f-t)
     (* *fitness-size* f-s)))

(defun fitness-for-phase (f-a f-t f-s)
  "Computes the fitness for current phase"
  (case *phase*
    (1 ; single objective
     f-a)
    (2 ; two objectives
     (/ (+ (* *fitness-accuracy* f-a)
           (* *fitness-time* f-t))
        (+ *fitness-accuracy* *fitness-time*)))
    (otherwise ; all three objectives
(fitness-no-phase f-a f-t f-s))))

(defun overall-phased-fitness (f-a f-t f-s)
  "Computes fitness, using the phases"
  (when (and (<= *phase* 3) ;; this is wrong no? will never do anything with phase 3? changed from <
             (< (fitness-for-phase f-a f-t f-s) 0.1)) ;; changed from 0.1
    (incf *phase*))
(fitness-for-phase f-a f-t f-s))

|#

(defun fitness-no-phase (f-a f-t f-s)
  "Computes the overall fitness - LB edit for Posner"
  (let* ((acc-weight (/ *fitness-accuracy* (length f-a))) ;; weight for each indiv data point
         (rt-weight (/ *fitness-time* (length f-t))))
    (+ (reduce #'+ (mapcar #'(lambda (x) (* x acc-weight)) f-a))
       (reduce #'+ (mapcar #'(lambda (x) (* x rt-weight)) f-t))
       (* *fitness-size* f-s))))

(defun fitness-for-phase (f-a f-t f-s)
  "Computes the fitness for current phase - LB edit for Posner"
  (case *phase*
    (1 ; single objective
     (reduce #'+ (mapcar #'(lambda (x) (* x (/ 1 (length f-a)))) f-a))) ;; just split the weight between each
    (2 ; two objectives
     (let* ((acc-weight (/ *fitness-accuracy* (length f-a))) ;; weight for each indiv data point
            (rt-weight (/ *fitness-time* (length f-t))))
       (/ (+ (reduce #'+ (mapcar #'(lambda (x) (* x acc-weight)) f-a))
             (reduce #'+ (mapcar #'(lambda (x) (* x rt-weight)) f-t)))
          (+ *fitness-accuracy* *fitness-time*))))
    (otherwise ; all three objectives
     (fitness-no-phase f-a f-t f-s))))

(defun overall-phased-fitness (f-a f-t f-s)
  "Computes fitness, using the phases"
  (when (and (< *phase* 3) 
             (< (fitness-for-phase f-a f-t f-s) 0.1)) 
    (incf *phase*))
  (fitness-for-phase f-a f-t f-s))

;; order of results - .5, .68, .86 (100 trials of each, each in its own list - so all-results is 3 lists of 100 items
(defun evaluate-fitness (individual) 
  (let* ((program (gems:individual-tree individual))
         (all-results (run-experiment program))
         
         ;; details for the progam-size (will be the same for all the conditions)
         (program-size (gems:program-size program))
         (temp-size (fitness-size program-size))

         ;; set up to save fit vals
         (temp-rt nil)
         (temp-acc nil)

         (mean-rt nil)
         (mean-acc nil)
         )

    (dotimes (prob-count (length all-results)) ;; each block validity    
      (let* ((prob-val (nth prob-count all-results))

             ;; separate the valid and invalid trials                 
             (valid-trials (remove-if-not #'(lambda (x) (equal (result-validity x) "V")) prob-val))
             (invalid-trials (remove-if #'(lambda (x) (equal (result-validity x) "V")) prob-val))
                 
             ;; get the mean and the fitness value for each condition
             (rt-V-mean (alexandria:mean (mapcar #'result-timing valid-trials))) ;; this is just 1 value
             (rt-v-fit (fitness-time rt-V-mean (fitness-values-rt-v (nth prob-count *fit-vals*)))) 

             (rt-I-mean (alexandria:mean (mapcar #'result-timing invalid-trials))) 
             (rt-i-fit (fitness-time rt-I-mean (fitness-values-rt-i (nth prob-count *fit-vals*))))

             (acc-V-mean (alexandria:mean (mapcar #'result-accuracy valid-trials))) 
             (acc-v-fit (fitness-accuracy acc-V-mean (fitness-values-acc-v (nth prob-count *fit-vals*))))
                   
             (acc-I-mean (alexandria:mean (mapcar #'result-accuracy invalid-trials))) 
             (acc-i-fit (fitness-accuracy acc-I-mean (fitness-values-acc-i (nth prob-count *fit-vals*))))
             (overall-fitness 1.0)
             )
        
        ;; save the fit values to a list
        (setf temp-rt (append temp-rt (list rt-v-fit rt-i-fit)))
        (setf temp-acc (append temp-acc (list acc-v-fit acc-i-fit)))

        (setf mean-rt (append mean-rt (list rt-V-mean rt-I-mean)))
        (setf mean-acc (append mean-acc (list acc-V-mean acc-I-mean)))
        ))

    (setf overall-fitness
          (if *phased*
              (overall-phased-fitness temp-acc temp-rt temp-size)
              (fitness-no-phase temp-acc temp-rt temp-size)))

    (values overall-fitness
            ;;(list accuracy f-a response-time f-t program-size f-s *phased* *phase* run-details))))
            (list mean-rt mean-acc temp-rt temp-acc program-size temp-size *phased* *phase*))))

#|
### interpret ###
|#

;; interpret function evaluates the given operator (program), in the context of 
;; md, which is a model+environment definition

(defun interpret (operator md)
  ;;(when (equalp nil (model-response md))
  (when (syntax-tree:node-p operator) (incf (syntax-tree:node-entries operator))) 
  (unless (> (model-clock md) 10000) ; time-out - adjust this if required
    (case (operator-label operator)

      (:nil
       (incf (model-clock md) $cogT)
       (setf (model-current md) input-nil))
     
      #|
      ;;prog-functions
      |#

      (:prog2
          (incf (model-clock md) $syntaxT)
          (interpret (first (operator-children operator)) md)
        (interpret (second (operator-children operator)) md))
      
      (:prog3
       (incf (model-clock md) $syntaxT)
       (interpret (first (operator-children operator)) md)
       (interpret (second (operator-children operator)) md)
       (interpret (third (operator-children operator)) md))
      
      (:prog4
       (incf (model-clock md) $syntaxT)
       (interpret (first (operator-children operator)) md)
       (interpret (second (operator-children operator)) md)
       (interpret (third (operator-children operator)) md)
       (interpret (fourth (operator-children operator)) md))

      #|
      ;;while, wait, dotime functions
      |#
      
      (:while-100 
       (incf (model-clock md) $syntaxT)
       (let ((start-time (model-clock md)))
         (do ((x 1 (incf x)))  ;; as a safeguard...
             ((or (>= (model-clock md) (+ start-time 100))
                  (> x 4))) ;; as a safeguard...
           (interpret (first (operator-children operator)) md))))
      
      (:while-200 
       (incf (model-clock md) $syntaxT)
       (let ((start-time (model-clock md)))
         (do ((x 1 (incf x)))  ;; as a safeguard...
             ((or (>= (model-clock md) (+ start-time 200))
                  (> x 5))) ;; as a safeguard...
           (interpret (first (operator-children operator)) md))))

      (:wait-.5trial
       (incf (model-clock md) (/ (second *response-window*) 2)))

      (:wait-.25trial
       (incf (model-clock md) (/ (second *response-window*) 4)))

      (:wait-.1trial
       (incf (model-clock md) (/ (second *response-window*) 10)))

      (:wait-25
       (incf (model-clock md) 25))
      
      (:wait-50
       (incf (model-clock md) 50))
      
      (:wait-100
       (incf (model-clock md) 100))
      
      (:wait-200
       (incf (model-clock md) 200))
      
      (:wait-1000
       (incf (model-clock md) 1000))
      
      (:wait-1500
       (incf (model-clock md) 1500))
      
      (:dotimes-2 
       (incf (model-clock md) $syntaxT)
       (dotimes (i 2)
         (interpret (first (operator-children operator)) md)))
      
      (:dotimes-3 
       (incf (model-clock md) $syntaxT)
       (dotimes (i 3)
         (interpret (first (operator-children operator)) md)))
      
      (:dotimes-4 
       (incf (model-clock md) $syntaxT)
       (dotimes (i 4)
         (interpret (first (operator-children operator)) md)))

      #|
      ;; learning functions
      |#

      (:match-probability
       ;; match the probability for the block, need to relate to cue given
       (incf (model-clock md) $cogT)
       (let* ((a-s (append (model-stm md) (list (model-current md)))) ;; put all stim together
              (cue-stim (find-if #'(lambda (y) (equal :cue (input-type y))) a-s)) ;; look for the cue item
              (pr (< (random 100) (* 100 current-prob)))) ;; get a random number and see if its below the prob
         ;;(when (> (model-clock md) (first *response-window*))

              ;;86% of the time it is valid - so if the value is T (i.e. under 86) it should match the cue                 
         (if cue-stim ;; have the cue
         ;;(when cue-stim ;; have the cue
           (case (input-direction cue-stim)
             (:left (if pr (interpret '(respond-left) md)
                        (interpret '(respond-right) md)))
             (:right (if pr (interpret '(respond-right) md)
                         (interpret '(respond-left) md))))
           ;;(setf (model-response md) nil)
           )))

      (:RW-cue-strength
       ;; uses cue and strength of association to predict stimulus
       (incf (model-clock md) (- $cogT (* 85 (model-strength-assoc md))))
       (let* ((a-s (append (model-stm md) (list (model-current md)))) ;; put everything together
              (cue-stim (find-if #'(lambda (y) (equal :cue (input-type y))) a-s))) ;; find item that is cue
#|
         (when cue-stim ;; if find the cue use RW to set response
	   (let* ((prediction (RW-predict-stim (model-strength-assoc md) (input-direction cue-stim))))
	     (case prediction
	       (:left (interpret '(respond-left) md))
	       (:right (interpret '(respond-right) md)))))))
|#
         (if cue-stim ;; if find the cue use RW to set response
	   (let* ((prediction (RW-predict-stim (model-strength-assoc md) (input-direction cue-stim))))
	     (case prediction
	       (:left (interpret '(respond-left) md))
	       (:right (interpret '(respond-right) md))))
           ;;(setf (model-response md) nil)
           )))
      

          ;; (setf (model-response md) (RW-predict-stim (model-strength-assoc md) (input-direction cue-stim)))
          ;; )))
 
      (:RW-cue-percept
       ;; uses both cue and perception of stimulus to select stimulus
       ;; made some changes so interpret response rather than setf response
       (let* ((str-prime (model-strength-assoc md))
             (a-s (append (model-stm md) (list (model-current md)))) ;; put everything together
             (cue-stim (find-if #'(lambda (y) (equal :cue (input-type y))) a-s))
             (target-stim (find-if #'(lambda (y) (equal :target (input-type y))) a-s)))
	 (incf (model-clock md) (- $cogT (* 85 str-prime)))
         ;;(when (AND cue-stim target-stim)
         (if (AND cue-stim target-stim)
         ;; need to have both cue-stim and target-stim available
       
           ;;(incf (model-clock md) (- $cogT (* 85 str-prime)))
         ;; 85 ms is from Meyer & Schvaneveldt (1971); reduction in time proportionate to strength of priming
           (case
               (RW-predict-stim
                (if (equal (input-direction cue-stim) (input-location target-stim)) ;; if the cue and target are in the same place
                      (+ (* 0.95 1) (* 0.05 str-prime))   ;; we assume perfect perception of stimulus -> p = 1
                      (- (* 0.95 1) (* 0.05 str-prime)))    ;; simple linear combination of probabilities; weights are arbitrary but reasonable (to check!)
                (input-direction cue-stim))
             (:left (interpret '(respond-left) md))
             (:right (interpret '(respond-right) md)))
           ;;(setf (model-response md) nil)
           )))        


      (:if-strength-assoc
       ;; just a basic threshold type operator - if the strength-assoc is over a
       ;; certain value then just respond with the cue
       (incf (model-clock md) (- $cogT (* 85 (model-strength-assoc md))))
       (if (> (model-strength-assoc md) 0.7) ;; s-t as strength threshold
	   (interpret '(respond-cue) md)
           ;;(setf (model-response md) nil)
           ))
    
      (:prev-val
       ;; look at validity of previous trial
       ;; previous valid trial would produce the displacement of the preparatory bias to the location suggested by the cue
       ;; So fast responses in VV, slow for VI, intermediate speeds for II and IV.
       (if (equalp (model-prev-trial md) "V")
           (interpret '(respond-cue) md)))
      #|
      
      
            
       ;;attention functions
       |#
       
       (:attend 
        (incf (model-clock md) $cogT)
        (setf (model-current md) (model-salient md)))
       
       (:move-att-centre
	(when (not (equal (model-attFocus md) :centre)) ;; only do it if it isn't already there
          (incf (model-clock md) $cogT)
          (setf (model-attFocus md) :centre)))
       
       (:move-att-left
	(when (not (equal (model-attFocus md) :left)) ;; only do it if it isn't already there
	  (incf (model-clock md) $cogT)
	  (setf (model-attFocus md) :left)))
       
       (:move-att-right
	(when (not (equal (model-attFocus md) :right)) ;; only do it if it isn't already there
	  (incf (model-clock md) $cogT)
	  (setf (model-attFocus md) :right)))
       
       (:move-att-cue
        ;;move attention in line with cue direction - processing the cue means ive added cog time
        ;; can change so time is in line with strength-assoc?
	(incf (model-clock md) $cogT)
        ;;(incf (model-clock md) (- $cogT (* 85 (model-strength-assoc md))))

	(let* ((a-s (append (model-stm md) (list (model-current md)))) ;; put everything together
               (cue-stim (find-if #'(lambda (y) (equal :cue (input-type y))) a-s))) ;; find item that is cue
	  (when cue-stim
	    (case (input-direction cue-stim)
	    (:left (interpret '(move-att-left) md))
	    (:right (interpret '(move-att-right) md)) 
	    (:centre (interpret '(move-att-centre) md))
	    ))))

       

       (:attn-capture-location
        ;;changed for Arjona because only ever have 1 stimulus find where the stimulus is and put attention there.

        (let* ((time-details (first (timeline (model-clock md))))) ;; remove outer bracket - only ever 1 stim
          ;;(incf (model-clock md) $cogT)
          (if time-details
              (case (first time-details)
		('stim1 (interpret '(move-att-centre) md)) ;; stim 1 is always in the centre
		('stim2 (case (input-location (second (model-inputs md)))
			  (:left (interpret '(move-att-left) md))
			  (:right (interpret '(move-att-right) md))))

                ;;('stim1 (setf (model-attfocus md) (input-location (first (model-inputs md)))))  
                ;;('stim2 (setf (model-attfocus md) (input-location (second (model-inputs md))))))
	      ))))

       
       (:shift-attn-cw
	;; move attention to a differnt stimulus, L to R
	(incf (model-clock md) $cogT)
	(case (model-attfocus md)
	  (:left (interpret '(move-att-centre) md))
	  (:centre (interpret '(move-att-right) md))
	  (:right (interpret '(move-att-left) md))))

       (:shift-attn-ccw
	;; move attention to a different stimulus, R to L
	(incf (model-clock md) $cogT)
	(case (model-attfocus md)
	  (:left (interpret '(move-att-right) md))
	  (:centre (interpret '(move-att-left) md))
	  (:right (interpret '(move-att-centre) md))))

       (:detect
        (detect-main md) 
        (incf (model-clock md) $inputT))

       (:detect-attend
        (interpret '(detect) md)
        (interpret '(attend) md))       
       
       
       #|
       ;;comparison-functions
       |#
#|
       ;; compare stm1 and current, if true respond current location
       (:compare-current1-Rc
        (decay md)
        (incf (model-clock md) $cogT)
        (when (not (equal (input-type (model-current md)) (input-type (first (model-stm md))))) ;; check that they aren't the same stimulus type (target/stimulus)
          (when (equal (input-name (model-current md)) (input-name (first (model-stm md))))
            (interpret '(respond-current) md))))             
       #| (setf (model-response md)
       (input-location (model-current md))))))|#

       (:compare-current1-R1
        (decay md)
        (incf (model-clock md) $cogT)
        (when (not (equal (input-type (model-current md)) (input-type (first (model-stm md))))) ;; check that they aren't the same stimulus type (target/stimulus)
          (when (equal (input-name (model-current md)) (input-name (first (model-stm md))))
            (setf (model-response md)
                  (input-location (first (model-stm md)))))))
|#
       (:if-current-stm-Rstm
	(decay md)
	(incf (model-clock md) $cogT)
	(let* ((match (find-if #'(lambda (n) (equal (input-name (model-current md)) (input-name n)))
                               (model-stm md))))
	  (when match
	    (case (input-location match)
	      (:centre (interpret '(respond-centre) md))
	      (:left (interpret '(respond-left) md))
	      (:right (interpret '(respond-right) md))
	      ))))

       (:if-current-stm-Rc
	(decay md)
	(incf (model-clock md) $cogT)
	(let* ((match (find-if #'(lambda (n) (equal (input-name (model-current md)) (input-name n)))
                               (model-stm md))))
	  (when match
	    (interpret '(respond-current) md))))		 

       (:if-stm1-R
	(decay md)
	(incf (model-clock md) $cogT)
	(let* ((match (find-if #'(lambda (n) (equal (input-name (first (model-stm md))) (input-name n)))
                               (rest (model-stm md)))))
	  (when match
	    (case (input-location match)
	      (:centre (interpret '(respond-centre) md))
	      (:left (interpret '(respond-left) md))
	      (:right (interpret '(respond-right) md))
	      ))))

       (:if-stm2-R
	(decay md)
	(incf (model-clock md) $cogT)
	(let* ((new-stm-order (list (second (model-stm md)) (first (model-stm md)) (third (model-stm md))))
               (match (find-if #'(lambda (n) (equal (input-name (first new-stm-order)) (input-name n)))
                               (rest new-stm-order))))
	  (when match
	    (case (input-location match)
	      (:centre (interpret '(respond-centre) md))
	      (:left (interpret '(respond-left) md))
	      (:right (interpret '(respond-right) md))
	      ))))

       (:if-stm3-R
	(decay md)
	(incf (model-clock md) $cogT)
	(let* ((new-stm-order (list (third (model-stm md)) (first (model-stm md)) (second (model-stm md))))
               (match (find-if #'(lambda (n) (equal (input-name (first new-stm-order)) (input-name n)))
                               (rest new-stm-order))))
	  (when match
	    (case (input-location match)
	      (:centre (interpret '(respond-centre) md))
	      (:left (interpret '(respond-left) md))
	      (:right (interpret '(respond-right) md))
	      ))))
       
       #|
       (:compare-1-2-p
        (decay md)
        (incf (model-clock md) $cogT)
        (when (not (equal (input-type (first (model-stm md))) (input-type (second (model-stm md))))) ;; check that they aren't the same stimulus type (target/stimulus)
          (equal (input-name (first (model-stm md))) (input-name (second (model-stm md))))))
       |#

       (:compare-1-2-p
        (decay md)
        (incf (model-clock md) $cogT)
        (equal (input-name (first (model-stm md))) (input-name (second (model-stm md)))))

       (:compare-2-3-p
        (decay md)
        (incf (model-clock md) $cogT)
        (equal (input-name (second (model-stm md))) (input-name (third (model-stm md)))))

       (:compare-1-3-p
        (decay md)
        (incf (model-clock md) $cogT)
        (equal (input-name (first (model-stm md))) (input-name (third (model-stm md)))))

      
       (:compare-current-1-p
        (decay md)
        (incf (model-clock md) $cogT)
        ;;(when (not (equal (input-type (first (model-stm md))) (input-type (second (model-stm md))))) ;; check that they aren't the same stimulus type (target/stimulus)
        (equal (input-name (first (model-stm md))) (input-name (model-current md))))

       (:compare-current-2-p
        (decay md)
        (incf (model-clock md) $cogT)
        (equal (input-name (second (model-stm md))) (input-name (model-current md))))

       (:compare-current-3-p
        (decay md)
        (incf (model-clock md) $cogT)
        (equal (input-name (third (model-stm md))) (input-name (model-current md))))

       (:magic-operator
        (decay md)
        (incf (model-clock md) $cogT)
        ;;find the target
        (let* ((target (find-if #'(lambda (n) (equal :target (input-type n)))
                                (model-stm md)))
               ;; find the correct stimulus
               (correct-stim (when target (find-if #'(lambda (n) (and (equal (input-name target) (input-name n)) (equal :stimulus (input-type n))))
                                                   (model-stm md)))))
          ;; respond with correct location
          (when correct-stim (setf (model-response md) (input-location correct-stim)))
          ))

       (:retrieve-target
        (decay md)
        (incf (model-clock md) $cogT)
        (let* ((target (find-if #'(lambda (n) (equal :target (input-type n)))
                                (model-stm md))))
          (when target
            (setf (model-current md) target)
            (setf (input-store-time (model-current md)) nil))))

       (:retrieve-cue
        (decay md)
        (incf (model-clock md) $cogT)
        (let* ((target (find-if #'(lambda (n) (equal :cue (input-type n)))
                                (model-stm md))))
          (when target
            (setf (model-current md) target)
            (setf (input-store-time (model-current md)) nil))))

       #|
       (:compare-stm-items
       (incf (model-clock md) $cogT)
       (let* (stm-target (find-if #'(lambda (x) (equal (input-type x) :target)) (model-stm md)))
       
       )
       (find-if #'(lambda (x) (equal (input-name (first (model-stm md))) (input-name x))
       (list (second (model-stm md)) (third (model-stm md)))))
       
       (when (not (equal (first (model-stm md)) (second (model-stm md))))
       |#
       #|
       (:find-stm-match
       (incf (model-clock md) $cogT)
       (when (not (equal (model-current md) (first (model-stm md)))) ;; check that they aren't exactly the same thing!
       (find-if #'(lambda (x) (equal (input-name (model-current md)) (input-name x))
       (model-stm md)))

       (:compare-current-stm-1 
       (incf (model-clock md) $cogT)
       (let* (stm1 (first (model-stm md)))
       (when (equal (input-name (model-current md)) (input-name stm1))
       (setf (model-response md)
       (input-location stm1)))))
       |#      
       #|
       (when (= (model-current md) (first (model-stm md)))
       (setf (model-response md)
       (string (aref (symbol-name (model-attFocus md)) 0)))))
       |#

       ;; some kind of shift attention to opposite side function?

       
       #|
       ;;predicates and if
       |#
       
       (:if
        (incf (model-clock md) $syntaxT)
        (if (interpret (first (operator-children operator)) md)
            (interpret (second (operator-children operator)) md)
            (interpret (third (operator-children operator)) md)))

       (:current-cue-p
        ;; looking at whether the model-current input is the target or a comparison stimulus
        (incf (model-clock md) $cogT)
        (equal (input-type (model-current md)) :cue))

       (:current-target-p
        ;; looking at whether the model-current input is the target or a comparison stimulus
        (incf (model-clock md) $cogT)
        (equal (input-type (model-current md)) :target))

       
       #| 
       ;;stm functions
       |#
       
       (:put-stm
        (decay md)
        (incf (model-clock md) $cogT)
        (setf (model-stm md) 
              ;;(if (= 3 (length (model-stm md))) ;; starts with 3 places
              (list (copy-structure (model-current md))
                    (first (model-stm md))
                    (second (model-stm md)))
              )
        (setf (input-store-time (first (model-stm md))) (model-clock md)) 
        )
       
       (:detect-attend-putstm
        (interpret '(prog2 (detect-attend) (put-stm)) md))

       (:rehearsal-1
        (decay md)
        (incf (model-clock md) $stmT)
        ;; reinforce what is already in a stm store - i.e. change the store-time
        (when (not (equal input-nil (first (model-stm md)))) ;; make sure its not just changing input-nil
          (setf (input-store-time (first (model-stm md))) (model-clock md)))) 

       (:rehearsal-2
        (decay md)
        (incf (model-clock md) $stmT)
        ;; reinforce what is already in a stm store - i.e. change the store-time
        (when (not (equal input-nil (second (model-stm md)))) ;; make sure its not just changing input-nil
          (setf (input-store-time (second (model-stm md))) (model-clock md)))) 
       
       (:rehearsal-3
        (decay md)
        (incf (model-clock md) $stmT)
        ;; reinforce what is already in a stm store - i.e. change the store-time
        (when (not (equal input-nil (third (model-stm md)))) ;; make sure its not just changing input-nil
          (setf (input-store-time (third (model-stm md))) (model-clock md)))) 

       (:retrieve-1
        (decay md)
        (incf (model-clock md) $stmT)
        (setf
         (model-current md) (copy-structure (first (model-stm md)))
         (input-store-time (model-current md)) nil))

       (:retrieve-2
        (decay md)
        (incf (model-clock md) $stmT)
        (setf
         (model-current md) (copy-structure (second (model-stm md)))
         (input-store-time (model-current md)) nil))

       (:retrieve-3
        (decay md)
        (incf (model-clock md) $stmT)
        (setf
         (model-current md) (copy-structure (third (model-stm md)))
         (input-store-time (model-current md)) nil))
       
       #|     
       ;;response functions
       |# 

       (:respond-left
        (incf (model-clock md) $outputT)
        ;;(when (> (model-clock md) (first *response-window*)) 
          (setf (model-response md) :left))
       
       (:respond-right
        (incf (model-clock md) $outputT)
        ;;(when (> (model-clock md) (first *response-window*))
          (setf (model-response md) :right))

       (:respond-centre
        (incf (model-clock md) $outputT)
        ;;(when (> (model-clock md) (first *response-window*))
          (setf (model-response md) :centre))
       
       (:respond-current
        (incf (model-clock md) $outputT)
        (when (not (equal input-nil (model-current md)))
          (setf (model-response md) (input-location (model-current md)))))

       (:respond-cue
	(incf (model-clock md) $outputT)
	(let* ((a-s (append (model-stm md) (list (model-current md))))
	       (cue-stim (find-if #'(lambda (y) (equal :cue (input-type y))) a-s))) ;; look for the cue item
	  (when cue-stim
            (case (input-direction cue-stim)
              (:left (setf (model-response md) :left))
              (:right (setf (model-response md) :right))
              ))))

       (:respond-cue-OPP
        (incf (model-clock md) $outputT)
	(let* ((a-s (append (model-stm md) (list (model-current md))))
	       (cue-stim (find-if #'(lambda (y) (equal :cue (input-type y))) a-s))) ;; look for the cue item
	  (when cue-stim
            (case (input-direction cue-stim)
              (:left (setf (model-response md) :right))
              (:right (setf (model-response md) :left))
              ))))

               
              
        
       
       (:respond-attfocus
	(incf (model-clock md) $outputT)
	(setf (model-response md) (model-attfocus md)))

       
       
       #|
       ;; wait operators, used for simplifying code
       |#
       
      (:wait-input 
       (incf (model-clock md) $inputT))
      (:wait-output 
       (incf (model-clock md) $outputT))
      (:wait-cognitive 
       (incf (model-clock md) $cogT))
      (:wait-stm 
       (incf (model-clock md) $stmT))

      (:wait-input-cog
       (incf (model-clock md) (+ $inputT $cogT)))
      (:wait-input-cog-cog
       (incf (model-clock md) (+ $inputT $cogT $cogT)))
      
      #|    
      (:wait-input-stm
       (incf (model-clock md) (+ $inputT $stmT)))
      (:wait-input-output
       (incf (model-clock md) (+ $inputT $outputT)))
      (:wait-output-cognitive
       (incf (model-clock md) (+ $outputT $cogT)))
      (:wait-output-stm
       (incf (model-clock md) (+ $outputT $stmT)))
      (:wait-cognitive-stm
       (incf (model-clock md) (+ $cogT $stmT)))
      |#      

      (otherwise ; error if comes across an unknown operator
        (error "interpret: unknown operator ~a" (operator-label operator))))))

#|
### operator-set ###
|#

;; operator set (name . number-of-children)
;; TIP: comment out individual lines to ignore specific operators

(setf op-set
      '((WAIT-1500 . 0) 
        (WAIT-1000 . 0) 
        (WAIT-200 . 0) 
        (WAIT-100 . 0) 
        (WAIT-50 . 0) 
        (WAIT-25 . 0)

        (wait-.5trial . 0)
        (wait-.25trial . 0)
        (wait-.1trial . 0)
        
        (PROG4 . 4) 
        (PROG3 . 3)
        (PROG2 . 2)
        
        (DOTIMES-4 . 1) 
        (DOTIMES-3 . 1) 
        (DOTIMES-2 . 1)
        
        (WHILE-200 . 1) 
        (WHILE-100 . 1) 
        
        (NIL . 0)
        (IF . 3)

        (MOVE-ATT-RIGHT . 0) 
        (MOVE-ATT-LEFT . 0) 
        (MOVE-ATT-CENTRE . 0)
	(move-att-cue . 0)

	(shift-attn-cw . 0)
	(shift-attn-ccw . 0)

        
        (detect . 0)
        (ATTEND . 0)
        (PUT-STM . 0)
        (rehearsal-1 . 0)
        (rehearsal-2 . 0)
        (rehearsal-3 . 0)
        
        (retrieve-1 . 0)
        (retrieve-2 . 0)
        (retrieve-3 . 0)
        (retrieve-target . 0)
        (retrieve-cue . 0)
        
        (detect-attend . 0)
        (detect-attend-putstm . 0)
        (attn-capture-location . 0)
	
                                        ;(if-current-stm-Rstm . 0)
                                        ;(if-current-stm-Rc . 0)
                                        ;(if-stm1-R . 0)
                                        ;(if-stm2-R . 0)
                                        ;(if-stm3-R . 0)
        
        (current-target-p . 0)
        (current-cue-p . 0)        
        
        (respond-left . 0)
        (respond-right . 0)
	(respond-centre . 0)
        (respond-current . 0)
	(respond-cue . 0)
        (respond-cue-OPP . 0)
        ;;(response-attfocus . 0)

        (match-probability . 0)
        (RW-cue-strength . 0)
        (RW-cue-percept . 0)
	(if-strength-assoc . 0)
        (prev-val . 0)
        )
      )



;;(defun operator-set ()
;;  op-set)
 
(setf wait-op-set
      '((wait-input . 0)
       (wait-output . 0)
       (wait-cognitive . 0)
        (wait-stm . 0)
        ;;(wait-cog-output . 0)
    
       (wait-input-cog . 0)
       (wait-input-cog-cog . 0)))




(setf dotted-replace
      '((attend . wait-cognitive)
        (MOVE-ATT-RIGHT . wait-cognitive) 
        (MOVE-ATT-LEFT . wait-cognitive) 
        (MOVE-ATT-CENTRE . wait-cognitive)
        (move-att-cue . wait-cognitive)
        (shift-attn-cw . wait-cognitive)
        (shift-attn-ccw . wait-cognitive)

        
        (detect . wait-input)

        (rehearsal-1 . wait-cognitive)
        (rehearsal-2 . wait-cognitive)
        (rehearsal-3 . wait-cognitive)
        (retrieve-1 . wait-stm)
        (retrieve-2 . wait-stm)
        (retrieve-3 . wait-stm)
        (retrieve-target . wait-stm)
        (retrieve-cue . wait-stm)
        (attn-capture-location . wait-cognitive)
	
        (PUT-STM . wait-cognitive) 
        (detect-attend . wait-input-cog)
        (detect-attend-putstm . wait-input-cog-cog)
        ;;(COMPARE-CURRENT1-Rc . wait-cognitive) 
        ;;(COMPARE-CURRENT1-R1 . wait-cognitive)       
        ;;(compare-1-2-p . wait-cognitive)
        ;;(compare-1-3-p . wait-cognitive)
        ;;(compare-2-3-p . wait-cognitive)

        ;;(if-current-stm-Rstm . wait-cognitive)
        ;;(if-current-stm-Rc . wait-cognitive)
        ;;(if-stm1-R . wait-cognitive)
        ;;(if-stm2-R . wait-cognitive)
        ;;(if-stm3-R . )
               
        ;;(compare-current-1-p . wait-cognitive)        
        ;;(compare-current-2-p . wait-cognitive)        
        ;;(compare-current-3-p . wait-cognitive)

        (current-target-p . wait-cognitive)
        (current-cue-p . wait-cognitive)

        ;;(magic-operator . wait-cognitive)
        
        (respond-left . wait-output)
        (respond-right . wait-output)
        (respond-centre . wait-output)
        (respond-current . wait-output)
        (respond-cue . wait-output)
        (respond-cue-opp . wait-output)

        (match-probability . wait-cognitive)
        (RW-cue-strength . wait-cognitive)
        (RW-cue-percept . wait-cognitive)
        (if-strength-assoc . wait-cognitive)
        )
      )


(defun operator-set () op-set)

#|
### interpretation
|#

(defun best-models (experiment-name)
  (let* ((temp-results (gpstats:read-trace (format nil "~a" experiment-name)))
         (last-generation (rest (first (last temp-results)))) ;; puts it into necessary format
         (best-models (gpstats:best-individuals-in-generation last-generation)))
    (setf yay-model best-models)
    (setf clean-models (gpstats:clean-individuals best-models #'run-experiment))

    ;;(print (format nil "~a final models" (length clean-models)))
    ))