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

#| set up inputs |#

(setf input-1 (make-input :type :cue :location :centre :direction nil :store-time 0 :modality :visual))
(setf input-2 (make-input :type :target :location nil :direction nil :store-time 0 :modality :auditory))

(setf input-nil (make-input :location nil :direction nil :type nil :store-time 0 :modality nil))

(setf test-input-1 (make-input :type :cue :location :centre :direction :left :store-time 0 :modality :visual))
(setf test-input-2 (make-input :type :target :location :left :direction nil :store-time 0 :modality :auditory))
(setf test-input-3 (make-input :type :target :location :right :direction nil :store-time 0 :modality :auditory))


(defun get-cue-validity (input-pair)
  (if (equal (first input-pair)
             (second input-pair))
      "V" "I")) 


#| arjona specifics |#

(setf *response-window* '(970 2070))
(setf ntrials 100)
(setf *strength-assoc* .5)
(setf *cue-probs* '(.86 .68 .5))

(defun create-stimuli (ntrials cue-validity-prob)    ;;; creates a list of n cue-stimulus pairs
  (let* ((temp-list nil)
         (valid-n (round (* cue-validity-prob ntrials)))
         (invalid-n (- ntrials valid-n)))
    (append temp-list (make-list (/ valid-n 2) :initial-element '(:left :left))
            (make-list (/ valid-n 2) :initial-element '(:right :right))
            (make-list (/ invalid-n 2) :initial-element '(:left :right))
            (make-list (/ invalid-n 2) :initial-element '(:right :left)))))

;;(setf *cue-stimuli-list* (create-stimuli ntrials cue-validity))

;; target-response

;; timeline
(defun timeline (time)
  (cond
    ((and (>= time 0) (< time 300)) 'NIL)
    ((and (>= time 300) (< time 600)) '((stim1 centre)))
    ((and (>= time 600) (< time 970)) 'NIL)
    ((and (>= time 970) (< time 1070)) '((stim2 nil)))
    ((and (>= time 1070) (< time 2070)) 'NIL)
    (t nil)))



#| fitness values |#

;; the RT data is only for correct responses.
(defvar *fitness-accuracy* 0.8)   ; multiplier for f_a
(defvar *fitness-time* 0.2)       ; multiplier for f_t
(defvar *fitness-size* 0.0)       ; multiplier for f_s

(defvar *data-rt-V-50* 376)           ; parameter used in computing f_t
(defvar *data-rt-I-50* 399)       
(defvar *data-acc-V-50* 0.9697)          ; parameter used in computing f_a
(defvar *data-acc-I-50* 0.949)             

(defvar *data-rt-V-68* 355)
(defvar *data-rt-I-68* 394)  
(defvar *data-acc-V-68* 0.9708)              
(defvar *data-acc-I-68* 0.9568)          

(defvar *data-rt-V-86* 349)
(defvar *data-rt-I-86* 404) 
(defvar *data-acc-V-86* 0.9623)          
(defvar *data-acc-I-86* 0.9155)         

(defstruct fitness-values
  prob-val
  rt-v
  rt-i
  acc-v
  acc-i)

(setf *fit-vals*
      (list
       (make-fitness-values :prob-val 50 :rt-v *data-rt-V-50* :rt-i *data-rt-I-50* :acc-v *data-acc-V-50* :acc-i *data-acc-I-50*)
       (make-fitness-values :prob-val 68 :rt-v *data-rt-V-68* :rt-i *data-rt-I-68* :acc-v *data-acc-V-68* :acc-i *data-acc-I-68*)
       (make-fitness-values :prob-val 86 :rt-v *data-rt-V-86* :rt-i *data-rt-I-86* :acc-v *data-acc-V-86* :acc-i *data-acc-I-86*)
       ))

#|
### Run experiment ###
|#

(defun run-experiment (program) 
  "Run a single experiment against the given program, returning information on performance"
  (let* ((experiment-results '()))
    (dolist (cue-prob *cue-probs*)
      (let* ((cond-results '())
             (current-stimuli (alexandria:shuffle (create-stimuli ntrials cue-prob))))
        (setf s-a *strength-assoc*) ;; reset this between blocks
        (setf current-prob cue-prob) ;; this is *current-cue-validity* in old code

        (dolist (input-list current-stimuli)
          (setf (input-direction input-1) (first input-list))
          (setf (input-location input-2) (second input-list))
          
          (let* ((md (make-model :inputs (list input-1 input-2) :strength-assoc s-a :prev-trial pre-val)))

            ;; update the timeline info so know where the second stim is
            (setf (second (first (timeline (first *response-window*))))
                  (input-location input-2))

            (interpret program md)

            (let* ((result (make-result :inputs input-list :validity (get-cue-validity input-list) :prob-valid cue-prob)))
              
              (when (AND (< (first *response-window*) (model-clock md)) (> (second *response-window*) (model-clock md))) ; when clock is before end time for response
                (setf (result-response result) (model-response md)) ; record model's response
                (setf (result-accuracy result) ; record accuracy
                      (if (string= (result-response result) (second input-list)) 1 0))
                (setf (result-timing result) (- (model-clock md) (first *response-window*))) ; record the response time
                )
              (push result cond-results)
              (incf s-a (update-from-trial *ResWagrate* (model-strength-assoc md) (result-validity result)))
              (setf pre-val (result-validity result))

              )))
        (push cond-results experiment-results)))
    experiment-results))

(defun run-gp (&key (max-generations 100)
                    (population-size 1000)
                    
                    (f-a *fitness-accuracy*) ; proportion of accuracy objective to include in fitness
                    (f-t *fitness-time*) ; proportion of response time objective
                    (f-s *fitness-size*) ; proportion of program size objective
                    
                    ;;(rt *data-rt*) ; parameter for calculating response time objective
                    ;;(acc *data-acc*) ; parameter for calculating accuracy objective
                    (size 100) ; program size
                    
                    (logger nil) ; logger function
                    (phased nil) ; set to t to use phased introduction
                    ;;(fit-struct 1) ; default to fit all at the same time
                    
                    (mutation-rate 0.05)
                    (i-depth 2) ;initial depth
                    )
  "Sets all relevant parameters for the GP system and model evaluation"
  (setf
   *max-generations* max-generations
   *fitness-accuracy* f-a
   *fitness-time* f-t
   *fitness-size* f-s
   ;;*data-rt* rt ;; these are set in *fit-vals*
   ;;*data-acc* acc
   *size-ps* size
   *phased* phased
   *phase* 1 ; no need for this to change
   ;;*fit-struct* fit-struct
   )

  (gems:launch (operator-set) #'evaluate-fitness
               :total-generations max-generations
               :population-size population-size
               :initial-depth i-depth
               :maximum-depth 10
               :elitism t
               :type :steady-state
               :mutation-rate mutation-rate ; mutation-rate. default is 0.05. is a probability.
               :logger logger))