README.md

@@ -0,0 +1,26 @@
+# Examples of Using GEMS
+
+This repository holds a collection of examples of using GEMS.
+
+## MIT Licence
+
+Copyright (c) the individual authors.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+

published-results/ecvp-2023-posner/README.md

@@ -0,0 +1,6 @@
+# ECVP 2023: Generating Candidate Cognitive Models
+
+This folder contains the code for the experimental results 
+reported in:
+
+* L.K. Bartlett, A. Pirrone, N. Javed, P.C.R. Lane and F. Gobet, Generating candidate cognitive models for the Posner cueing task [Conference poster]. _45^th^ European Conference on Visual Perception_, Paphos, Cyprus, 2023.

published-results/ecvp-2023-posner/Run-posner.lisp

@@ -0,0 +1,48 @@
+#|
+This code is to easily go through all the posner experiments
+|#
+
+;; 1. Set stuff up
+(setf *default-pathname-defaults*
+      ;;#P"/home/laurab/common-lisp/gems-1.2-alpha-3/posner/")
+      #P"/Users/bartletl/Documents/portacle/projects/gems-1.2-alpha-3/posner/")
+(require :asdf)
+(require :gems)
+
+;; 2. Enter the names of the experiments to be included
+(setf experiment-list (list 'arjona))
+
+;; 3. Go through each and run GP
+(load "posner-initialise.lisp")
+
+;; optional things:
+(setf decay-toggle 0) ;; stm decay on (1) or off (0)
+(setf *decay-threshold* 0.1) ;; just try different values
+
+(defparameter stored-state (make-random-state t)) ;; this is a new one every time. so need to actually store it somewhere.
+(setf *random-state* (make-random-state stored-state))
+;; this info will be printed in the output file and so can be used in future.
+
+
+(dolist (name-exp experiment-list)
+  (load (format nil "posner-~a.lisp" name-exp))
+  (defun operator-set () op-set)
+
+
+  (run-gp :f-a 0.7 ;; changed from 0.75
+          :f-t 0.25
+          :f-s 0.05 ;;changed from 0.05
+          :population-size 5000 ;; change from 3000 ; 8000 ; 2000
+          :max-generations 500 ;; change from 200 ; 700 ; 500
+          :phased t
+          :logger (gems:combine-loggers (gems:make-logger (format nil "summary-~a-prev.csv" name-exp) :if-exists :supersede) (gems:make-logger (format nil "models-~a-prev.yml" name-exp) :kind :trace :filter #'(lambda (generation-number) (= generation-number *max-generations*)))))
+)
+
+(defun operator-set () (append op-set wait-op-set))
+(load (format nil "posner-~a.lisp" 'arjona))
+
+(setf clean-models-arjona (best-models "models-arjona.yml"))          
+(print (format nil "~a final models - ~a" (length clean-models-arjona) 'Arjona))
+
+
+

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

@@ -0,0 +1,168 @@
+#| 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))

published-results/ecvp-2023-posner/posner-tests.lisp

@@ -0,0 +1,631 @@
+;; This file was created by Laura
+
+;; It will run a series of tests for the operators involved in the Posner experiment.
+;; THIS IS SPECIFICALLY FOR ARJONA
+
+;; code checking 
+(defun check (query error-message)
+  (if query
+      (format t ".")
+      (format t "~&Error: ~a~&" error-message)))
+
+;; need to load the relevant information in order to run the checks
+;; will just run the Chao experiment file for this - this includes all run-gp run-experiment and loads interpret file
+
+(require :asdf)
+(require :gems)
+(setf *default-pathname-defaults*
+      #P"/Users/bartletl/Documents/portacle/projects/gems-1.2-alpha-3/posner/")
+      ;;#P"/home/laurab/common-lisp/gems-1.2-alpha-3/posner/")
+
+(load "posner-initialise.lisp")
+(load "posner-ARJONA.lisp")
+
+;; TESTING JUST THE DECAY TOGGLE STUFF
+#|
+(setf decay-toggle 1) ;; just on for these tests
+(setf *decay-threshold* 0.6) ;; just try different values
+
+(defparameter stored-state (make-random-state t))
+(setf *random-state* (make-random-state stored-state)) ;; to load previous
+
+(defun test-decay ()
+  (setf *decay-threshold* 0.6) ;; just try different values
+  (let* ((md (make-model :current test-input-1 :salient test-input-2)))
+    (interpret '(prog3 (put-stm) (attend) (put-stm)) md)
+    (check (equal 2 (input-name (second (model-stm md)))) "test-input-1 is in stm2")
+    (check (equal 3 (input-name (first (model-stm md)))) "test-input-2 is in stm1")
+    (setf (model-clock md) 1500)
+    (interpret '(rehearsal-1) md)
+    (setf (model-clock md) 2000)
+    (interpret '(retrieve-1) md)
+    ;;(print md)
+    (check (equal nil (input-name (second (model-stm md)))) "test-input-1 has decayed")
+    (check (equal 3 (input-name (first (model-stm md)))) "test-input-2 is still good")
+    (setf *decay-threshold* 0.0)
+    (let* ((md (make-model :current test-input-1 :salient test-input-2)))
+      (interpret '(prog3 (put-stm) (attend) (put-stm)) md)
+      (check (equal 2 (input-name (second (model-stm md)))) "test-input-1 is in stm2")
+      (check (equal 3 (input-name (first (model-stm md)))) "test-input-2 is in stm1")
+      (setf (model-clock md) 1500)
+      (interpret '(rehearsal-1) md)
+      (setf (model-clock md) 2000)
+      (interpret '(retrieve-1) md)
+      ;;(print md)
+      (check (equal 2 (input-name (second (model-stm md)))) "test-input-1 has NOT decayed")
+      (check (equal 3 (input-name (first (model-stm md)))) "test-input-2 is still good")
+      (interpret '(prog2 (wait-1500) (retrieve-1)) md)
+      (check (equal 2 (input-name (second (model-stm md)))) "test-input-1 has NOT decayed - again")
+      (check (equal 3 (input-name (first (model-stm md)))) "test-input-2 is still good - again")
+      )))
+|#
+
+(setf decay-toggle 0) ;; just off for tests for now
+
+(defun test-nil-op ()
+  (let ((md (make-model :current test-input-1)))
+    (check (equal :centre (input-location (model-current md))) "initial current value")
+    (interpret '(nil) md)
+    (check (equal nil (input-location (model-current md))) "nil current location")
+    (check (equal nil (input-type (model-current md))) "nil current type")))
+;; WORKS: Aj
+
+(defun test-if-resp ()
+  (let ((md (make-model :salient test-input-2 :current test-input-1 :clock (first *response-window*))))
+    (interpret '(if (current-target-p) (respond-left) (respond-right)) md)
+    (check (equal (model-response md) :right)  "input-1 is cue, so false")
+    (interpret '(if (current-cue-p) (respond-left) (respond-right)) md)
+    (check (equal (model-response md) :left)  "input-1 is cue, so true")
+
+    (interpret '(attend) md)
+    (interpret '(if (current-cue-p) (respond-left) (respond-right)) md)
+    (check (equal (model-response md) :right)  "input-2 is target, so false")
+    (interpret '(if (current-target-p) (respond-left) (respond-right)) md)
+    (check (equal (model-response md) :left)  "input-2 is target, so true")))
+;; WORKS: Aj
+
+(defun test-prog ()
+  (let ((md (make-model)))
+    (check (equal 0 (model-clock md)) "initial clock 0")   
+    (interpret '(prog2 (wait-100) (wait-100)) md)
+    (check (equal 200 (model-clock md)) "updated clock 2x100")
+    (interpret '(prog3 (wait-100) (wait-100) (wait-100)) md)
+    (check (equal 500 (model-clock md)) "updated clock 3x100")
+    (interpret '(prog4 (wait-100) (wait-100) (wait-100) (wait-100)) md)
+    (check (equal 900 (model-clock md)) "updated clock 4x100")))
+;; WORKS: Aj
+
+(defun test-put-stm ()
+  (let ((md (make-model :current test-input-1 :salient test-input-2)))
+    (check (equal nil (input-location (first (model-stm md)))) "initial empty stm1")
+    (check (equal nil (input-location (second (model-stm md)))) "initial empty stm2")
+    (check (equal nil (input-location (third (model-stm md)))) "initial empty stm3")
+
+    (interpret '(put-stm) md)
+    (check (equal :centre (input-location (first (model-stm md)))) "fill stm1")
+    (check (equal nil (input-location (second (model-stm md)))) "second empty stm2")
+    (check (equal nil (input-location (third (model-stm md)))) "second empty stm3")
+
+    (interpret '(prog2 (attend) (put-stm)) md)
+    (check (equal :left (input-location (first (model-stm md)))) "update stm1")
+    (check (equal :centre (input-location (second (model-stm md)))) "move 1 to stm2")
+    (check (equal nil (input-location (third (model-stm md)))) "third empty stm3")
+    ;;(print md)
+
+    (interpret '(put-stm) md)
+    (check (equal :left (input-location (first (model-stm md)))) "update stm1 again")
+    (check (equal :left (input-location (second (model-stm md)))) "move 1 to stm2 again")
+    (check (equal :centre (input-location (third (model-stm md)))) "move 2 to stm3")
+
+    (interpret '(put-stm) md)
+    (check (equal :left (input-location (first (model-stm md)))) "update stm1 again again")
+    (check (equal :left (input-location (second (model-stm md)))) "move 1 to stm2 again again")
+    (check (equal :left (input-location (third (model-stm md)))) "remove the previous stm3")
+    ))
+;; WORKS: Aj
+
+(defun test-attend ()
+  (let ((md (make-model :salient test-input-1)))
+    (check (equal nil (input-location (model-current md))) "check current is empty")
+    (interpret '(attend) md)
+    (check (equal :centre (input-location (model-current md))) "current updated with salient")
+    ))
+;; WORKS: Aj
+
+(defun test-move-att ()
+  (let ((md (make-model :attfocus :left :current test-input-1)))
+    (check (equal :left (model-attfocus md)) "model start left")
+    (interpret '(move-att-left) md)
+    (check (equal 0 (model-clock md)) "nothing changed so no change to clock")
+    (interpret '(move-att-centre) md)
+    (check (equal :centre (model-attfocus md)) "model moved to centre")
+    (interpret '(move-att-centre) md)
+    (check (equal 70 (model-clock md)) "nothing changed so no change to clock")
+    (interpret '(move-att-left) md)
+    (check (equal :left (model-attfocus md)) "model moved to left")
+    (interpret '(move-att-right) md)
+    (check (equal :right (model-attfocus md)) "model moved to right")
+    (interpret '(move-att-right) md)
+    (check (equal 210 (model-clock md)) "nothing changed so no change to clock")
+    (interpret '(move-att-cue) md)
+    (check (equal :left (model-attfocus md)) "model moved to left, because cue direction")
+    (check (equal 350 (model-clock md)) "clock increased because operations")
+    (interpret '(move-att-cue) md)
+    (check (equal 420 (model-clock md)) "clock increased but only but cog for cue")
+    (let ((md (make-model :attfocus :right)))
+      (interpret '(move-att-cue) md)
+      (check (equal :right (model-attfocus md)) "no cue saved so no effect (except time)")
+      (check (equal 70 (model-clock md)) "time change")
+    )))
+;; WORKS: Aj
+
+(defun test-attn-capture-loc ()
+  (let ((md (make-model :attfocus :left :inputs (list test-input-1 test-input-2) :clock 310)))
+    (check (equal :left (model-attfocus md)) "model start left")
+    (interpret '(attn-capture-location) md)
+    ;;(print md)
+    (check (equal :centre (model-attfocus md)) "attn captured to centre")
+    (let ((md (make-model :clock (first *response-window*) :inputs (list test-input-1 test-input-2))))
+      (check (equal :centre (model-attfocus md)) "attnfocus is at default centre position")
+      ;;(setf test-mod md)
+      (interpret '(attn-capture-location) md)
+      (check (equal :left (model-attfocus md)) "attnfocus is left, in line with test-input-2")
+      (let ((md (make-model :inputs (list test-input-1 test-input-2) :attfocus :right))) ;; default clock, so no stim
+	(check (equal :right (model-attfocus md)) "attn right at start")
+	(check (equal 0 (model-clock md)) "clock default 0")
+	(interpret '(attn-capture-location) md)
+	(check (equal :right (model-attfocus md)) "attn still to right - no stim")))))
+;; WORKS: Arjona
+
+
+(defun test-detect ()
+  (let ((md (make-model :inputs (list test-input-1) :clock 300)))
+    (check (equal input-nil (model-salient md)) "salient is nil")
+    (interpret '(detect) md)
+    (check (equal test-input-1 (model-salient md)) "salient is now test-input 1"))
+  (let ((md (make-model :inputs (list test-input-1) :attfocus :left :clock 300)))
+    (check (equal input-nil (model-salient md)) "salient is nil")
+    (interpret '(detect) md)
+    (check (equal input-nil (model-salient md)) "salient is still nil because stim in centre")))
+;; WORKS: Aj
+
+(defun test-respond ()
+  (let ((md (make-model :current test-input-1)))
+    (check (equal nil (model-response md)) "response is nil")
+    (interpret '(respond-current) md)
+    (check (equal :centre (model-response md)) "responding with what is in current")
+    (interpret '(respond-left) md)
+    (check (equal :left (model-response md)) "responding left")
+    (interpret '(respond-right) md)
+    (check (equal :right (model-response md)) "responding right")
+    (interpret '(respond-cue) md)
+    (check (equal :left (model-response md)) "respond left, direction of cue")
+    (interpret '(respond-cue-opp) md)
+    (check (equal :right (model-response md)) "respond right, opposite direction of cue")
+    (interpret '(prog2 (nil) (respond-current)) md)
+    (check (equal :right (model-response md)) "still left because nothing in current")
+    ))
+;; WORKS: Aj
+
+(defun test-prev-cue ()
+  (let ((md (make-model :current test-input-1 :prev-trial "V")))
+    (interpret '(prev-val) md)
+    (check (equalp (model-response md) :left) "response in line with previous trial validity")
+    (let ((md (make-model :current test-input-1 :prev-trial "I")))
+      (interpret '(prev-val) md)
+      (check (equalp (model-response md) nil) "no change in response because no benefit from valid")
+      )))
+
+
+
+(defun test-rehearsal ()
+  (let ((md (make-model :current test-input-1 :salient test-input-2)))
+    (interpret '(prog2 (dotimes-2 (put-stm)) (prog2 (attend) (put-stm))) md)
+    (check (equal (input-location test-input-1) (input-location (second (model-stm md)))) "put item1 in stm2")
+    (check (equal (input-location test-input-1) (input-location (third (model-stm md)))) "put item1 in stm3")
+
+    (check (equal (input-location test-input-2) (input-location (first (model-stm md)))) "put item2 in stm1")
+
+    (check (not (equal (input-store-time (third (model-stm md))) (model-clock md))) "stm3 not same as clock")
+    (check (not (equal (input-store-time (second (model-stm md))) (model-clock md))) "stm2 not same as clock")
+    
+    (interpret '(rehearsal-2) md)
+    (check (equal (input-store-time (second (model-stm md))) (model-clock md)) "updated store time stm2")
+    
+    (interpret '(rehearsal-3) md)
+    (check (equal (input-store-time (third (model-stm md))) (model-clock md)) "updated store time stm3")
+
+    (check (not (equal (input-store-time (first (model-stm md))) (model-clock md))) "stm1 not same as clock")
+    (interpret '(rehearsal-1) md)
+    (check (equal (input-store-time (first (model-stm md))) (model-clock md)) "updated store time stm1")
+))
+;; WORKS: Aj
+
+(defun test-while ()
+  (let ((md (make-model :current test-input-1 :salient test-input-2)))
+    (interpret '(while-200 (put-stm)) md)
+    (check (equal (input-location input-1) (input-location (third (model-stm md)))) "repeated enough that input1 is in stm3")
+    (interpret '(prog2 (attend) (while-100 (put-stm))) md)
+    (check (equal (input-location test-input-1) (input-location (third (model-stm md)))) "input1 is still in stm3")
+    (check (equal (input-location test-input-2) (input-location (second (model-stm md)))) "input2 is in stm2")
+    (check (equal (input-location test-input-2) (input-location (first (model-stm md)))) "input2 is in stm1")
+    ))
+;; WORKS: Aj
+
+(defun test-wait ()
+  (let ((md (make-model)))
+    (check (equal 0 (model-clock md)) "model-clock at 0")
+    (interpret '(wait-25) md)
+    (check (equal 25 (model-clock md)) "model-clock at 25")
+    (interpret '(wait-50) md)
+    (check (equal 75 (model-clock md)) "model-clock at 75")
+    (interpret '(wait-100) md)
+    (check (equal 175 (model-clock md)) "model-clock at 175")
+    (interpret '(wait-200) md)
+    (check (equal 375 (model-clock md)) "model-clock at 375")
+    (interpret '(wait-1000) md)
+    (check (equal 1375 (model-clock md)) "model-clock at 1375")
+    (interpret '(wait-1500) md)
+    (check (equal 2875 (model-clock md)) "model-clock at 2875")
+    (interpret '(wait-.5trial) md)
+    (check (equal (+ 2875 (/ (second *response-window*) 2)) (model-clock md)) "model-clock added .5 of trial")
+    (setf (model-clock md) 0)
+    (interpret '(wait-.25trial) md)
+    (check (equal (/ (second *response-window*) 4) (model-clock md)) "model-clock added .25 of trial")
+    (setf (model-clock md) 0)
+    (interpret '(wait-.1trial) md)
+    (check (equal (/ (second *response-window*) 10) (model-clock md)) "model-clock added .25 of trial")
+    ;;(print md)
+    ))
+;; WORKS: Aj
+
+(defun test-dotimes ()
+  (let ((md (make-model)))
+    (check (equal 0 (model-clock md)) "model-clock at 0")
+    (interpret '(dotimes-2 (wait-100)) md)
+    (check (equal 200 (model-clock md)) "model-clock at 200")
+    (interpret '(dotimes-3 (wait-100)) md)
+    (check (equal 500 (model-clock md)) "model-clock at 500")
+    (interpret '(dotimes-4 (wait-100)) md)
+    (check (equal 900 (model-clock md)) "model-clock at 900")
+    ))
+;; WORKS: Aj
+
+(defun avg (faff) (/ (apply '+ faff) (length faff)))
+
+(defun test-match-prob ()
+  (setf tally-86 nil)
+  (setf tally-50 nil)
+  (setf tally-68 nil)
+  (dotimes (more 50)
+    (setf current-prob 0.86)
+    (setf tally 0)
+    (let* ((md (make-model :current test-input-1)))
+      (check (equal :left (input-direction (model-current md))) "check input direction is left")
+      (dotimes (rep 100)
+	(interpret '(match-probability) md)
+	(when (equalp :left (model-response md)) (setf tally (1+ tally))))   
+      ;;(check (< 66 tally) "is it in line with response?")
+      (push tally tally-86) 
+    
+    (let* ((md (make-model :current test-input-1)))
+      (setf current-prob 0.5)
+      (setf tally 0)
+      (dotimes (rep 100)
+	(interpret '(match-probability) md)
+	(when (equalp :left (model-response md)) (setf tally (1+ tally))))
+      ;;(check (AND (< 30 tally) (> 70 tally)) "is it in line with response?")
+      (push tally tally-50) 
+
+      (let* ((md (make-model :current test-input-1)))
+	(setf current-prob 0.68)
+	(setf tally 0)
+	(dotimes (rep 100)
+	  (interpret '(match-probability) md)
+	  (when (equalp :left (model-response md)) (setf tally (1+ tally))))
+	;;(check (AND (< tally 88) (> tally 48)) "is it in line with response?")
+	(push tally tally-68)
+	))))
+  (print tally-86)
+  (print (avg tally-86))
+  (check (< 66 (avg tally-86)) "tally-86 avg")
+  (print tally-50)
+  (print (avg tally-50))
+  (check (AND (< 30 (avg tally-50)) (> 70 (avg tally-50))) "tally-50 avg")
+  (print tally-68)
+  (print (avg tally-68))
+  (check (AND (< (avg tally-68) 88) (> (avg tally-68) 48)) "tally-68 avg")
+  )
+;; WORKS: Aj      
+
+(defun test-RW-cue-strength () ;; so it takes the *strength-assoc* and works out how likely the cue is. In run-experiment, the *strength-assoc* is updated based on the validity of the trial. so can just run with a variety of strength-assoc's and see whether it outputs in line with that.
+
+  (setf tally-50 nil)
+  (setf tally-75 nil)
+  (setf tally-25 nil)
+
+  (dotimes (more 10)
+
+    (setf tally 0)
+    (dotimes (we 100)
+      (let ((md (make-model :strength-assoc 0.5 :current test-input-1)))
+        (interpret '(RW-cue-strength) md)
+        (when (equalp :left (model-response md)) (setf tally (1+ tally)))))
+    (push tally tally-50)
+
+    (setf tally 0)
+    (dotimes (we 100)
+      (let ((md (make-model :strength-assoc 0.75 :current test-input-1)))
+        (interpret '(RW-cue-strength) md)
+        (when (equalp :left (model-response md)) (setf tally (1+ tally)))))
+    (push tally tally-75)
+
+    (setf tally 0)
+    (dotimes (we 100)
+      (let ((md (make-model :strength-assoc 0.25 :current test-input-1)))
+        (interpret '(RW-cue-strength) md)
+        (when (equalp :left (model-response md)) (setf tally (1+ tally)))))
+    (push tally tally-25))
+
+  (print tally-75)
+  (print (avg tally-75))
+  (check (AND (< 55 (avg tally-75)) (> 95 (avg tally-75))) "tally-75 avg")
+  (print tally-50)
+  (print (avg tally-50))
+  (check (AND (< 30 (avg tally-50)) (> 70 (avg tally-50))) "tally-50 avg")
+  (print tally-25)
+  (print (avg tally-25))
+  (check (AND (< (avg tally-25) 45) (> (avg tally-25) 5)) "tally-25 avg")
+  )
+;; WORKS: Aj (still need to test the updating of the strength-assoc)
+
+(defun test-RW-cue-percept ()
+  ;; uses the cue and perception of stimulus (not strength of learning?)
+  ;; still uses the strength-assoc, but it only slighty affects things.
+  ;; RW-predict-stim (strength-assoc, cue-direction)
+
+  (setf tally-50-match nil)
+  (setf tally-90-match nil)
+  (setf tally-10-match nil)
+  (setf tally-50-no nil)
+  (setf tally-90-no nil)
+  (setf tally-10-no nil)
+
+  (let* ((md (make-model :strength-assoc 0.5 :current test-input-1)))
+    (interpret '(RW-cue-percept) md)
+    (check (equal nil (model-response md)) "don't have the target so shouldnt do anything")
+
+
+      (dotimes (faff 100)
+
+        (setf tally 0)
+        (dotimes (we 100)
+          (let* ((md (make-model :strength-assoc 0.5 :current test-input-2 :stm (list test-input-1 input-nil input-nil))))
+
+          (interpret '(rw-cue-percept) md)
+          (when (equalp :left (model-response md)) (setf tally (1+ tally)))))
+        (push tally tally-50-match)
+
+        ;;(setf (model-strength-assoc md) 0.90)
+        (setf tally 0)
+        (dotimes (we 100)
+          (let* ((md (make-model :strength-assoc 0.9 :current test-input-2 :stm (list test-input-1 input-nil input-nil))))
+
+          (interpret '(rw-cue-percept) md)
+          (when (equal :left (model-response md)) (setf tally (1+ tally)))))
+        (push tally tally-90-match)
+        
+        ;;(setf (model-strength-assoc md) 0.10)
+        (setf tally 0)
+        (dotimes (we 100)
+          (let* ((md (make-model :strength-assoc 0.1 :current test-input-2 :stm (list test-input-1 input-nil input-nil))))
+          (interpret '(rw-cue-percept) md)
+          (when (equal :left (model-response md)) (setf tally (1+ tally)))))
+        (push tally tally-10-match)
+        )
+    
+
+      ;;(interpret '(attend) md)
+      ;;(print md)
+      ;;(check (equal (input-location test-input-3) (model-response md)) "current is now not matched with cue")
+
+      (dotimes (faff 100)
+        (setf tally 0)
+        (dotimes (we 100)
+          (let* ((md (make-model :strength-assoc 0.5 :current test-input-3 :stm (list test-input-1 input-nil input-nil))))
+
+          (interpret '(rw-cue-percept) md)
+          (when (equal :left (model-response md)) (setf tally (1+ tally)))))
+        (push tally tally-50-no)
+
+        ;;(setf (model-strength-assoc md) 0.90)
+        (setf tally 0)
+        (dotimes (we 100)
+          (let* ((md (make-model :strength-assoc 0.9 :current test-input-3 :stm (list test-input-1 input-nil input-nil))))
+
+          (interpret '(rw-cue-percept) md)
+          (when (equal :left (model-response md)) (setf tally (1+ tally)))))
+        (push tally tally-90-no)
+        
+        (setf (model-strength-assoc md) 0.10)
+        (setf tally 0)
+        (dotimes (we 100)
+          (let* ((md (make-model :strength-assoc 0.1 :current test-input-3 :stm (list test-input-1 input-nil input-nil))))
+
+          (interpret '(rw-cue-percept) md)
+          (when (equal :left (model-response md)) (setf tally (1+ tally)))))
+        (push tally tally-10-no)
+        )
+
+      (print tally-50-match)
+      (print (list (avg tally-50-match) 0.975))
+      ;;(check (AND (< 55 (avg tally-50-match)) (> 95 (avg tally-50-match))) "tally-50-match avg") ;;0.975
+
+      (print tally-50-no)
+      (print (list (avg tally-50-no) 0.925))
+      ;;(check (AND (< 55 (avg tally-50-no)) (> 95 (avg tally-50-no))) "tally-50-no avg")
+
+      (print tally-90-match)
+      (print (list (avg tally-90-match) 0.995))
+      ;;(check (AND (< 55 (avg tally-90-match)) (> 95 (avg tally-90-match))) "tally-90-match avg") ;;0.995
+
+      (print tally-90-no)
+      (print (list (avg tally-90-no) 0.905))
+      ;;(check (AND (< 55 (avg tally-90-no)) (> 95 (avg tally-90-no))) "tally-90-no avg") ;; 0.905
+
+      (print tally-10-match)
+      (print (list (avg tally-10-match) 0.955))
+      ;;(check (AND (< 55 (avg tally-10-match)) (> 95 (avg tally-10-match))) "tally-10-match avg") ;;0.955
+
+      (print tally-90-no)
+      (print (list (avg tally-10-no) 0.945))
+      ;;(check (AND (< 55 (avg tally-10-no)) (> 95 (avg tally-10-no))) "tally-10-no avg") ;; 0.945
+
+      )
+  )
+;; WORKS: Aj (requires manual checking of output because i'm lazy)
+  
+          
+(defun test-if-sa ()
+  (let* ((md (make-model :current test-input-1 :strength-assoc 0.5)))
+    (interpret '(if-strength-assoc) md)
+    (check (equal nil (model-response md)) "no change because not at threshold")
+    (let* ((md (make-model :current test-input-1 :strength-assoc 0.71)))
+      (interpret '(if-strength-assoc) md)
+      (check (equal :left (model-response md)) "changed in line with cue"))))
+;; WORKS: Aj
+      
+
+    
+
+
+(defun test-current-type ()
+  (let ((md (make-model :salient test-input-2 :current test-input-1)))
+    (interpret '(if (current-target-p) (respond-left) (respond-right)) md)
+    (check (equal :right (model-response md)) "check right response as not target")
+    (interpret '(if (current-cue-p) (respond-left) (respond-right)) md)
+    (check (equal :left (model-response md)) "check left response as is cue")
+    (interpret '(prog2 (attend) (if (current-target-p) (respond-left) (respond-right))) md)
+    (check (equal :left (model-response md)) "check left response as is target")
+    (interpret '(if (current-cue-p) (respond-left) (respond-right)) md)
+    (check (equal :right (model-response md)) "check right response as not cue")
+    ))
+;; works: Aj
+
+(defun test-retrieve ()
+  (let ((md (make-model :salient test-input-2 :current test-input-1)))
+    (interpret '(prog3 (put-stm) (prog2 (attend) (put-stm)) (put-stm)) md)
+
+    (check (equal (input-location test-input-1) (input-location (third (model-stm md)))) "stm3 is item1")
+    (check (equal (input-location test-input-2) (input-location (second (model-stm md)))) "stm2 is item2")
+    (check (equal (input-location test-input-2) (input-location (first (model-stm md)))) "stm1 is item2")
+    (check (equal (input-location test-input-2) (input-location (model-current md))) "model current is item2")
+    
+    (interpret '(retrieve-3) md)
+    (check (equal (input-location test-input-1) (input-location (model-current md))) "model current is now item1, which was in stm3")
+    (interpret '(retrieve-2) md)
+    (check (equal (input-location test-input-2) (input-location (model-current md))) "model current is now item2, which was in stm2")
+    (interpret '(retrieve-3) md)
+    (check (equal (input-location test-input-1) (input-location (model-current md))) "model current is now item1, which was in stm3")
+    (interpret '(retrieve-1) md)
+    (check (equal (input-location test-input-2) (input-location (model-current md))) "model current is now item2, which was in stm1")
+
+    (interpret '(retrieve-target-stm) md)
+    (check (equal (input-type test-input-2) (input-type (model-current md))) "model current is now the target item")
+    (interpret '(retrieve-cue-stm) md)
+    (check (equal (input-type test-input-1) (input-type (model-current md))) "model current is now the most recent stimulus item")
+    ))
+;; WORKS: Aj
+
+(defun test-shift-attn ()
+  (let ((md (make-model :attfocus :centre)))
+    (check (equal (model-attfocus md) :centre)  "attention focus is centre")
+    (interpret '(shift-attn-cw) md)
+    (check (equal (model-attfocus md) :right)  "attention focus is right")
+    (interpret '(shift-attn-cw) md)
+    (check (equal (model-attfocus md) :left)  "attention focus is left (all the way round)")
+    (interpret '(shift-attn-cw) md)
+    (check (equal (model-attfocus md) :centre)  "attention focus is centre (from left)")
+    (interpret '(shift-attn-ccw) md)
+    (check (equal (model-attfocus md) :left)  "attention focus is left")
+    (interpret '(shift-attn-ccw) md)
+    (check (equal (model-attfocus md) :right)  "attention focus is right (from all the way round)")
+    (interpret '(shift-attn-ccw) md)
+    (check (equal (model-attfocus md) :centre)  "attention focus is centre (from right)")
+    ))
+;; WORKS: Aj
+  
+
+
+
+;; timings have changed, so that ps have to give a response within time to save the results, rather than in the operator code... maybe change this though?
+(defun test-dmts-ops ()
+  (let ((md (make-model :inputs (list input-1 input-2 input-3))))
+    (check (equal input-nil (model-current md)) "current starts with input-nil")
+    (interpret '(detect-attend) md)
+    (check (equal input-1 (model-current md)) "current changes to input1")
+    (interpret '(prog2 (move-att-left) (detect-attend)) md)
+    (check (equal input-nil (model-current md)) "current changes to nil, due to clock")
+    (setf (model-clock md) 1600)
+    (interpret '(detect-attend) md)
+    (check (equal input-2 (model-current md)) "current changes to input2")
+    (interpret '(prog2 (move-att-right) (detect-attend)) md)
+    (check (equal input-3 (model-current md)) "current changes to 3")
+    (check (equal nil (model-response md)) "default response is nil")
+    (setf (model-clock md) (- (first *response-window*) 200))
+    (interpret '(respond-left) md)
+    (check (equal nil (model-response md)) "no response, due to clock (too early)")
+    (setf (model-clock md) (first *response-window*))
+    (interpret '(respond-right) md)
+    (check (equal :right (model-response md)) "responds right")
+    (interpret '(respond-left) md)
+    (check (equal :left (model-response md)) "responds left")
+    (interpret '(respond-current) md)
+    (check (equal :right (model-response md)) "responds current - input3 (right)")
+    ))
+
+(defun test-program-depth ()
+  (check (= 0 (program-depth '())) "empty tree")
+  (check (= 1 (program-depth '(x))) "single entry")
+  (check (= 2 (program-depth '(x (a) (b)))) "three items, two levels")
+  (check (= 1 (program-depth '(x a b))) "three items, one level, terminals")
+  (check (= 3 (program-depth '(x (a) (b (c))))) "four items, three levels")
+  )
+
+(defun test-program-size ()
+  (check (= 0 (program-size '())) "empty tree")
+  (check (= 1 (program-size '(x))) "single entry")
+  (check (= 3 (program-size '(x (a) (b)))) "three items, one level")
+  (check (= 3 (program-size '(x a b))) "three items, one level, terminals")
+  (check (= 4 (program-size '(x (a) (b (c))))) "four items, two levels")
+  )
+
+(defun run-tests ()
+  (format t "~&Testing: ")
+  (test-nil-op)
+  (test-if)
+  (test-prog)
+  (test-put-stm)
+  (test-attend)
+  (test-move-att)
+  (test-attn-capture)
+  (test-detect)
+  (test-respond)
+  (test-rehearsal)
+  (test-while)
+  (test-wait)
+  (test-dotimes)
+  (test-compare-current1-Rc)
+  (test-compare-current1-r1)
+  (test-compare-1-2-p)
+  (test-compare-current1-p)
+  (test-magic-operator)
+  (test-retrieve)
+  (test-dmts-ops)
+  ;;(test-program-depth)
+  ;;(test-program-size)
+  (format t "~%-------- Done~&"))
+
+
+
+

published-results/sgai-2023-heuristics/README.md

@@ -0,0 +1,7 @@
+# SGAI 2023: Heuristic Search of Heuristics
+
+This folder contains the code for the experimental results 
+reported in:
+
+* A. Pirrone, P.C.R. Lane, L.K. Bartlett, N.Javed and F. Gobet, 'Heuristic search of heuristics', to appear in M.Bramer and F.Stahl (Eds.) _Artificial Intelligence XL. SGAI 2023. Lecture Notes in Computer Science(), vol 14381_, pp.407-420, 2023. (Springer, Cham.) https://doi.org/10.1007/978-3-031-47994-6_36
+

published-results/sgai-2023-heuristics/with_noise/task_with_noise.lisp

@@ -0,0 +1,600 @@
+(require :asdf)
+(require :gems)
+(require :lhstats)
+
+(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 stored-state (make-random-state t))
+(setf *random-state* stored-state)
+
+;(print stored-state)
+ 
+
+(defvar *max-generations* 1000)
+(defvar *population-size* 1000)
+
+(defvar *fitness-rt_low* 0.35)   
+(defvar *fitness-rt_high* 0.35)       
+(defvar *fitness-sd_low* 0)  
+(defvar *fitness-sd_high* 0)      
+(defvar *fitness-acc_low* 0.3)       
+(defvar *fitness-acc_high* 0)   
+(defvar *propn-fitness-size* 0)     
+
+(defvar *time-rt* 714)            
+(defvar *rtlow* 784)            
+(defvar *rthigh* 704)           
+(defvar *sdlow* 294)            
+(defvar *sdhigh* 242)          
+(defvar *acclow* 1)         
+(defvar *acchigh* 1)          
+(defvar *size-ps* 100)          
+
+
+(defstruct model
+  "Defines the state of a model and its interactions with the environment"
+  clock     ; core model   
+  current
+  stm
+  (attFocus :centre) ;; focus of attention; default is centre
+  salient   ;; salient is what is salient in the visual field.
+  response  
+  inputs    ;; buffers for inputs
+  _screenLeft
+  _screenCentre
+  _screenRight
+  ( _inputName  "_")
+  ( _type :stimulus)
+  )
+  
+(defstruct input
+  (name nil)
+  (location :central)
+  (type :stimulus))
+  
+(defstruct result inputs timing response rt_low rt_high acc_low acc_high)
+
+(defun detect-main (md)
+  (let ((current-stimuli (timeline (model-clock md)))   
+        (att (model-attFocus md))
+        (stim nil))
+    (setf stim (first (find-if #'(lambda (y)
+                                   (eq (second y) att))
+                               current-stimuli)))
+    (setf (model-_inputname md) (subseq (symbol-name stim) 0 3))
+    (case att
+      (left   (setf (model-_screenLeft   md) stim))
+      (centre (setf (model-_screenCentre md) stim))
+      (right  (setf (model-_screenRight  md) stim)))))
+      
+(defun timeline (time)
+  (cond
+    ((and (>= time 0) (< time 10000)) '(stim1 centre))
+    (t nil)))
+;; 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"))))
+;; interpret function evaluates the given operator (program), in the context of
+;; md, which is a model+environment definition
+(defun interpret (operator md)                                                
+  (when (syntax-tree:node-p operator) (incf (syntax-tree:node-entries operator))) 
+  (unless  (> (model-clock md) 10000) 
+    (case (operator-label operator)
+    
+      (:put-stm
+       (incf (model-clock md) $cogT)
+       (setf (model-stm md) 
+             (if (= 3 (length (model-stm md)))
+                 (list (model-current md)
+                       (first (model-stm md))
+                       (second (model-stm md)))
+                 (cons (model-current md)
+                       (model-stm md)))))
+                       
+      (:detect
+       (incf (model-clock md) $inputT)
+       (setf (model-salient md) (model-inputs md)))
+       
+      (:sample
+       (incf (model-clock md) $inputT)
+           (setf (model-current md) (model-salient md))
+           (if (< (random 1.0) .75)
+           (setf (model-current md) (model-salient md))
+           (if   (eq (model-salient md) 1); 0 is false, other numbers true
+             (setf (model-current md) 2)
+             (setf (model-current md) 1))
+             )         
+             )
+           
+           
+       
+       
+     
+       
+      (:respond
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) 1)  (model-current md)  0)))
+
+      (:conservative
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+       (cond ( (> (model-current md) 3) 
+                 1)
+          		((< (model-current md) -3)
+                 2)
+          		((and (< (model-current md) 3)  (> (model-current md) -3) ) 
+                   0)
+
+             )))   
+
+
+      (:threshold
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+       (cond ( (> (model-current md) 1.2) 
+                 1)
+          		((<= (model-current md) 1.2)
+                 0)
+
+             )))   
+
+            (:respond_low
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (model-current md) -3)  2  0)))      
+             
+      (:respondrandom
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .5) 1  2)))
+             
+      (:respond6
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .6)  (model-current md)  0)))
+             
+      (:respond7
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .7)  (model-current md)  0)))
+             
+      (:respond8
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .8)  (model-current md)  0)))
+      (:respond9
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .9)  (model-current md)  0)))
+             
+      (:ifM1
+       (incf (model-clock md) $syntaxT)
+       (if  (eq 1 (model-current md)) ; 0 is false, other numbers true
+            (interpret (first (operator-children operator)) md)
+            ))
+            
+      (:ifM2
+       (incf (model-clock md) $syntaxT)
+       (if  (eq 2 (model-current md)) ; 0 is false, other numbers true
+            (interpret (first (operator-children operator)) md)
+            ))
+            
+      (:if-mc
+       (incf (model-clock md) $syntaxT)
+       
+        (if  (eq 1 (model-current md)) ; 0 is false, other numbers true
+            (interpret (first (operator-children operator)) md)
+            (interpret (second (operator-children operator)) md)
+            )
+       
+       )
+      
+      (:ifosidf
+        (incf (model-clock md) $syntaxT)
+        (if (interpret (first (operator-children operator)) md)
+            (interpret (second (operator-children operator)) md)
+            (interpret (third (operator-children operator)) md)))
+            
+      (:prog2
+          (incf (model-clock md) $syntaxT)
+          (interpret (first (operator-children operator)) md)
+        (interpret (second (operator-children operator)) md))
+        
+      (:donothing
+       (incf (model-clock md) 0))
+       
+      (: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))
+       
+      (: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))
+       
+      (: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-5 
+       (incf (model-clock md) $syntaxT)
+       (dotimes (i 5)
+         (interpret (first (operator-children operator)) md)))
+         
+      (:dotimes-10
+       (incf (model-clock md) $syntaxT)
+       (dotimes (i 10)
+         (interpret (first (operator-children operator)) md)))
+         
+      (:while-50
+       (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 50))
+                  (> x 4))) ;; as a safeguard...
+           (interpret (first (operator-children operator)) md))))
+      
+      (: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))))
+      
+      
+      (:access-stm-1 
+       (incf (model-clock md) $stmT)
+       (setf (model-current md) (first (model-stm md))))
+       
+      (:access-stm-2
+       (incf (model-clock md) $stmT)
+       (setf (model-current md) (second (model-stm md))))
+       
+      (:access-stm-3
+       (incf (model-clock md) $stmT)
+       (setf (model-current md) (third (model-stm md))))
+       
+      (:compare-1-2
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (if (= (first (model-stm md)) (second (model-stm md))) (first (model-stm md))  (model-current md))))
+             
+      (:compare-2-3
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (if (= (second (model-stm md)) (third (model-stm md))) (second (model-stm md))  (model-current md))))
+             
+      (:compare-1-3
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (if (= (first (model-stm md)) (third (model-stm md))) (first (model-stm md))  (model-current md))))
+
+
+    (:sum-1-2
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (+ (first (model-stm md))  (second (model-stm md))))
+             
+             
+             )
+             
+(:boost
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (+ (model-current md)  1))
+          
+             )
+(:decay
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (* (model-current md)  0))
+             
+            
+             )
+      (:sum-1-3
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (+ (first (model-stm md))  (third (model-stm md))))
+            )
+
+              (:sum-2-3
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (+ (second (model-stm md))  (third (model-stm md))))
+            )
+
+     (:if
+       (incf (model-clock md) $syntaxT)
+       (if (> (model-current md) 1.2)
+       (interpret (first (operator-children operator)) md)
+       (interpret (second (operator-children operator)) md)))
+
+
+
+      
+      (otherwise ; error if comes across an unknown operator
+       (error "interpret: unknown operator ~a" (operator-label operator))))))
+;; operator set (name . number-of-children)
+;; TIP: comment out individual lines to ignore specific operators
+(defun operator-set () 
+  '(
+    (ACCESS-STM-1 . 0)
+    (ACCESS-STM-2 . 0)
+    (ACCESS-STM-3 . 0)
+    ;(COMPARE-1TO3 . 0)
+    (COMPARE-1-2 . 0)
+    (COMPARE-1-3 . 0)
+    (COMPARE-2-3 . 0)
+    (SUM-1-2 . 0)
+    ;(SUM-1-3 . 0)
+    ;(SUM-2-3 . 0)
+    ;(DETECT . 0)
+    ;(WHILE-50 . 1)
+    ;(WHILE-100 . 1)
+    ;(WHILE-200 . 1)
+    (PUT-STM . 0)
+    (SAMPLE . 0)
+    ;(BOOST . 0)
+    ;(DECAY . 0)
+    ;(SAMPLE4 . 0)
+    (THRESHOLD . 0)
+    ;(CONSERVATIVE . 0)
+    ;(RESPONDRANDOM . 0)
+    ;(RESPOND6 . 0)
+    ;(RESPOND7 . 0)
+    ;(RESPOND8 . 0)
+    ;(RESPOND9 . 0)
+    (WAIT-50 . 0)
+    (WAIT-25 . 0)
+    (WAIT-100 . 0)
+    (WAIT-200 . 0)
+    (WAIT-1000 . 0)
+    (WAIT-1500 . 0)
+    (DONOTHING . 0)
+    (DOTIMES-2 . 1)
+    (DOTIMES-3 . 1)
+    (DOTIMES-5 . 1)
+    (DOTIMES-10 . 1)
+    (PROG2 . 2)
+    (PROG3 . 3)
+    (PROG4 . 4)
+    (IF . 2)
+    ;(IF_NC . 2)
+    ;(IF_CURRENT_TH . 3)
+    ;(IF_CURRENT_CON . 3)  
+    ))
+;; 1 is high magnitude, 2 is low magnitude
+
+(defparameter stimuli '(
+                         .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        
+                        ))
+;; -- run-experiment template
+;;    Complete the run-experiment code. 
+;; -- output: The return value(s) is used by 'evaluate-fitness' below.
+
+(defun run-experiment (program) 
+  (let ((results '())
+        (expt-stimuli (statistics:random-sample (length stimuli) stimuli)))
+    (dolist (input expt-stimuli)
+      ;; -- begin single trial
+      (let ((md (make-model :clock 0 :current 0 :stm '(0 0 0)
+                            :salient input :inputs input :response 0)))
+        (interpret program md)
+        ;; -- collect information and create result
+        (let ((result (make-result :timing 0 :inputs input :response 0 :rt_low 0 :rt_high 0 :acc_low 0 :acc_high 0)))
+          (setf (result-response result) (model-response md))           ; record model's response
+                    (setf (result-acc_low result) (model-response md))           ; record model's response
+
+          (if (eq (model-inputs md) .6)
+              (setf (result-rt_low result) (model-clock md) (result-rt_high result) -1000)
+              (setf (result-rt_high result) (model-clock md) (result-rt_low result) -1000))
+          (push result results))))
+    results))
+    
+(defun filter-non-negative (l)
+  (cond
+    ((null l)                   ;; empty list
+     nil)
+    ((>= (first l) 0)      ;; number >= 0
+     (cons (first l) (filter-non-negative (rest l))))
+    (t                         ;; all other cases 
+     (filter-non-negative (rest l)))))
+     
+(defun fitness-acc_low (acc_low)
+  (abs (- *acclow* acc_low)))
+(defun fitness-acc_high (acc_high)
+  (abs (- *acchigh* acc_high)))
+
+;; Computes the f_s objective function.
+(defun fitness-size (program-size)
+  (gems:half-sigmoid (/ program-size *size-ps*)))
+
+(defun fitness-sd_low (sd_low)
+  (gems:half-sigmoid (/ (abs (- sd_low *sdlow*))
+                        *time-rt*)))
+  
+(defun fitness-sd_high (sd_high)
+  (gems:half-sigmoid (/ (abs (- sd_high *sdhigh*))
+                        *time-rt*)))
+  
+(defun fitness-rt_low (rt_low)
+  (gems:half-sigmoid (/ (abs (- rt_low *rtlow*))
+                        *time-rt*)))
+(defun fitness-rt_high (rt_high)
+  (gems:half-sigmoid (/ (abs (- rt_high *rthigh*))
+                        *time-rt*)))
+
+(defun evaluate-fitness (individual)
+  "Return the values (fitness extras) for given individual"
+  (let* ((program (gems:individual-tree individual))
+         (results (run-experiment program))
+         (acc_low (alexandria:mean (filter-non-negative (mapcar #'result-acc_low results))))
+         (f-acc_low (fitness-acc_low acc_low)) 
+         (acc_high (alexandria:mean (filter-non-negative (mapcar #'result-acc_high results))))
+         (f-acc_high (fitness-acc_high acc_high))
+         (rt_low (alexandria:mean (filter-non-negative (mapcar #'result-rt_low results))))
+         (f-rt_low (fitness-rt_low rt_low)) 
+         (rt_high (alexandria:mean (filter-non-negative (mapcar #'result-rt_high results))))
+         (f-rt_high (fitness-rt_high rt_high))
+         (sd_low (alexandria:standard-deviation (filter-non-negative (mapcar #'result-rt_low results))))
+         (f-sd_low (fitness-sd_low sd_low)) 
+         (sd_high (alexandria:standard-deviation (filter-non-negative (mapcar #'result-rt_high results))))
+         (f-sd_high (fitness-sd_high sd_high))
+         (program-size (gems:program-size program))
+         (f-s (fitness-size program-size))
+         )
+    (values (+ (* *fitness-rt_low* f-rt_low)
+               (* *fitness-rt_high* f-rt_high)
+               (* *fitness-sd_low* f-sd_low)
+               (* *fitness-sd_high* f-sd_high)
+               (* *fitness-acc_low* f-acc_low)
+               (* *fitness-acc_high* f-acc_high)
+               (* *propn-fitness-size* f-s)
+               )
+            (list rt_low f-rt_low rt_high f-rt_high acc_low f-acc_low  program-size f-s))))
+;; -- run-go template
+;;    Complete the run-gp code, or use your own functions to 
+;;    call the GP code.
+                                        ;(defun run-gp ()
+                                        ;  (gems:launch (operator-set) #'evaluate-fitness :total-generations 1000 :population-size 100)
+                                        ;  )
+                                        ;(run-gp)
+(defun run-gp (&key (max-generations *max-generations*)
+                 (population-size *population-size*)
+                 (f-rt_low *fitness-rt_low*) 
+                 (f-rt_high *fitness-rt_high*)
+                 (f-sd_low *fitness-sd_low*) 
+                 (f-sd_high *fitness-sd_high*)
+                 (f-acc_low *fitness-acc_low*)
+                 (f-acc_high *fitness-acc_high*)
+                 (rt *time-rt*)
+                 (logger nil) ; logger function
+                 )
+  "Sets all relevant parameters for the GP system and model evaluation"
+  (setf *fitness-rt_low* f-rt_low
+        *fitness-rt_high* f-rt_high
+        *fitness-sd_low* f-sd_low
+        *fitness-sd_high* f-sd_high
+        *fitness-acc_low* f-acc_low
+        *fitness-acc_high* f-acc_high
+        *time-rt* rt)
+  (gems:launch (operator-set) #'evaluate-fitness
+               :total-generations *max-generations*
+               :population-size *population-size*
+               :logger logger))
+               
+(defun make-filename (base args extn)
+  "Creates a filename with 'args' spliced into name"
+  (uiop:strcat (remove #\. (format nil "~a~{-~$~}" base args))
+               extn))
+               
+;; (defun log-name-section-4 ()
+;;   (make-filename "log" (list) ".csv"))
+  
+          
+(dolist (defn '(()))
+    (run-gp :max-generations *max-generations*
+            :population-size *population-size*
+            :rt *time-rt*
+            :logger 
+(gems:combine-loggers
+  (gems:make-logger "log.csv")            ; 1
+  (gems:make-logger "final-population.yml"     ; 2
+                    :kind :trace
+                    :filter #'(lambda (generation-number) (= generation-number *max-generations*))
+                    ))))
+
+
+                                             
+(dolist (defn '(()))
+  (let ((results (gpstats:read-trace (make-filename "final-population" defn ".yml"))))
+    (gpstats:write-fitness-generations results (make-filename "fitness" defn ""))
+                                        ; data for heatmap of model similarity
+    (gpstats:write-similarity-generations results (make-filename "similarity" defn ""))
+                                        ; data for proportions of dead code in population
+    (gpstats:write-deadcode-generations results (make-filename "sample-ndc" defn "")
+                                        #'run-experiment)
+    (let* ((last-generation (rest (first (last results))))
+           (best-models (gpstats:best-individuals-in-generation last-generation))
+           (best-ndc-models (gpstats:clean-individuals best-models #'run-experiment)))   ; 1
+      (gpstats:write-similarity-individuals best-ndc-models
+                                            (make-filename "best" defn ".dat"))
+      (format t "Found ~a best models in final generation, with ~a unique, cleaned models.~&"
+              (length best-models) (length best-ndc-models))
+      (print best-ndc-models)))
+  )

published-results/sgai-2023-heuristics/without_noise/task_without_noise.lisp

@@ -0,0 +1,595 @@
+(require :asdf)
+(require :gems)
+(require :lhstats)
+
+(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 stored-state (make-random-state t))
+(setf *random-state* stored-state)
+
+;(print stored-state)
+ 
+
+(defvar *max-generations* 500)
+(defvar *population-size* 500)
+
+(defvar *fitness-rt_low* 0.35)   
+(defvar *fitness-rt_high* 0.35)       
+(defvar *fitness-sd_low* 0)  
+(defvar *fitness-sd_high* 0)      
+(defvar *fitness-acc_low* 0.3)       
+(defvar *fitness-acc_high* 0)   
+(defvar *propn-fitness-size* 0)     
+
+(defvar *time-rt* 714)            
+(defvar *rtlow* 784)            
+(defvar *rthigh* 704)           
+(defvar *sdlow* 294)            
+(defvar *sdhigh* 242)          
+(defvar *acclow* 1)         
+(defvar *acchigh* 1)          
+(defvar *size-ps* 100)          
+
+
+(defstruct model
+  "Defines the state of a model and its interactions with the environment"
+  clock     ; core model   
+  current
+  stm
+  (attFocus :centre) ;; focus of attention; default is centre
+  salient   ;; salient is what is salient in the visual field.
+  response  
+  inputs    ;; buffers for inputs
+  _screenLeft
+  _screenCentre
+  _screenRight
+  ( _inputName  "_")
+  ( _type :stimulus)
+  )
+  
+(defstruct input
+  (name nil)
+  (location :central)
+  (type :stimulus))
+  
+(defstruct result inputs timing response rt_low rt_high acc_low acc_high)
+
+(defun detect-main (md)
+  (let ((current-stimuli (timeline (model-clock md)))   
+        (att (model-attFocus md))
+        (stim nil))
+    (setf stim (first (find-if #'(lambda (y)
+                                   (eq (second y) att))
+                               current-stimuli)))
+    (setf (model-_inputname md) (subseq (symbol-name stim) 0 3))
+    (case att
+      (left   (setf (model-_screenLeft   md) stim))
+      (centre (setf (model-_screenCentre md) stim))
+      (right  (setf (model-_screenRight  md) stim)))))
+      
+(defun timeline (time)
+  (cond
+    ((and (>= time 0) (< time 10000)) '(stim1 centre))
+    (t nil)))
+;; 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"))))
+;; interpret function evaluates the given operator (program), in the context of
+;; md, which is a model+environment definition
+(defun interpret (operator md)                                                
+  (when (syntax-tree:node-p operator) (incf (syntax-tree:node-entries operator))) 
+  (unless  (> (model-clock md) 10000) 
+    (case (operator-label operator)
+    
+      (:put-stm
+       (incf (model-clock md) $cogT)
+       (setf (model-stm md) 
+             (if (= 3 (length (model-stm md)))
+                 (list (model-current md)
+                       (first (model-stm md))
+                       (second (model-stm md)))
+                 (cons (model-current md)
+                       (model-stm md)))))
+                       
+      (:detect
+       (incf (model-clock md) $inputT)
+       (setf (model-salient md) (model-inputs md)))
+       
+      (:sample
+       (incf (model-clock md) $inputT)
+           (setf (model-current md) (model-salient md))
+           
+             )
+           
+           
+       
+       
+     
+       
+      (:respond
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) 1)  (model-current md)  0)))
+
+      (:conservative
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+       (cond ( (> (model-current md) 3) 
+                 1)
+          		((< (model-current md) -3)
+                 2)
+          		((and (< (model-current md) 3)  (> (model-current md) -3) ) 
+                   0)
+
+             )))   
+
+
+      (:threshold
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+       (cond ( (> (model-current md) 1.2) 
+                 1)
+          		((<= (model-current md) 1.2)
+                 0)
+
+             )))   
+
+            (:respond_low
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (model-current md) -3)  2  0)))      
+             
+      (:respondrandom
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .5) 1  2)))
+             
+      (:respond6
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .6)  (model-current md)  0)))
+             
+      (:respond7
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .7)  (model-current md)  0)))
+             
+      (:respond8
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .8)  (model-current md)  0)))
+      (:respond9
+       (incf (model-clock md) $outputT)
+       (setf (model-response md)
+             (if (< (random 1.0) .9)  (model-current md)  0)))
+             
+      (:ifM1
+       (incf (model-clock md) $syntaxT)
+       (if  (eq 1 (model-current md)) ; 0 is false, other numbers true
+            (interpret (first (operator-children operator)) md)
+            ))
+            
+      (:ifM2
+       (incf (model-clock md) $syntaxT)
+       (if  (eq 2 (model-current md)) ; 0 is false, other numbers true
+            (interpret (first (operator-children operator)) md)
+            ))
+            
+      (:if-mc
+       (incf (model-clock md) $syntaxT)
+       
+        (if  (eq 1 (model-current md)) ; 0 is false, other numbers true
+            (interpret (first (operator-children operator)) md)
+            (interpret (second (operator-children operator)) md)
+            )
+       
+       )
+      
+      (:ifosidf
+        (incf (model-clock md) $syntaxT)
+        (if (interpret (first (operator-children operator)) md)
+            (interpret (second (operator-children operator)) md)
+            (interpret (third (operator-children operator)) md)))
+            
+      (:prog2
+          (incf (model-clock md) $syntaxT)
+          (interpret (first (operator-children operator)) md)
+        (interpret (second (operator-children operator)) md))
+        
+      (:donothing
+       (incf (model-clock md) 0))
+       
+      (: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))
+       
+      (: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))
+       
+      (: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-5 
+       (incf (model-clock md) $syntaxT)
+       (dotimes (i 5)
+         (interpret (first (operator-children operator)) md)))
+         
+      (:dotimes-10
+       (incf (model-clock md) $syntaxT)
+       (dotimes (i 10)
+         (interpret (first (operator-children operator)) md)))
+         
+      (:while-50
+       (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 50))
+                  (> x 4))) ;; as a safeguard...
+           (interpret (first (operator-children operator)) md))))
+      
+      (: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))))
+      
+      
+      (:access-stm-1 
+       (incf (model-clock md) $stmT)
+       (setf (model-current md) (first (model-stm md))))
+       
+      (:access-stm-2
+       (incf (model-clock md) $stmT)
+       (setf (model-current md) (second (model-stm md))))
+       
+      (:access-stm-3
+       (incf (model-clock md) $stmT)
+       (setf (model-current md) (third (model-stm md))))
+       
+      (:compare-1-2
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (if (= (first (model-stm md)) (second (model-stm md))) (first (model-stm md))  (model-current md))))
+             
+      (:compare-2-3
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (if (= (second (model-stm md)) (third (model-stm md))) (second (model-stm md))  (model-current md))))
+             
+      (:compare-1-3
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (if (= (first (model-stm md)) (third (model-stm md))) (first (model-stm md))  (model-current md))))
+
+
+    (:sum-1-2
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (+ (first (model-stm md))  (second (model-stm md))))
+             
+             
+             )
+             
+(:boost
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (+ (model-current md)  1))
+          
+             )
+(:decay
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (* (model-current md)  0))
+             
+            
+             )
+      (:sum-1-3
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (+ (first (model-stm md))  (third (model-stm md))))
+            )
+
+              (:sum-2-3
+       (incf (model-clock md) $cogT)
+       (setf (model-current md)
+             (+ (second (model-stm md))  (third (model-stm md))))
+            )
+
+     (:if
+       (incf (model-clock md) $syntaxT)
+       (if (> (model-current md) 1.2)
+       (interpret (first (operator-children operator)) md)
+       (interpret (second (operator-children operator)) md)))
+
+
+
+      
+      (otherwise ; error if comes across an unknown operator
+       (error "interpret: unknown operator ~a" (operator-label operator))))))
+;; operator set (name . number-of-children)
+;; TIP: comment out individual lines to ignore specific operators
+(defun operator-set () 
+  '(
+    (ACCESS-STM-1 . 0)
+    (ACCESS-STM-2 . 0)
+    (ACCESS-STM-3 . 0)
+    ;(COMPARE-1TO3 . 0)
+    (COMPARE-1-2 . 0)
+    (COMPARE-1-3 . 0)
+    (COMPARE-2-3 . 0)
+    (SUM-1-2 . 0)
+    ;(SUM-1-3 . 0)
+    ;(SUM-2-3 . 0)
+    ;(DETECT . 0)
+    ;(WHILE-50 . 1)
+    ;(WHILE-100 . 1)
+    ;(WHILE-200 . 1)
+    (PUT-STM . 0)
+    (SAMPLE . 0)
+    ;(BOOST . 0)
+    ;(DECAY . 0)
+    ;(SAMPLE4 . 0)
+    (THRESHOLD . 0)
+    ;(CONSERVATIVE . 0)
+    ;(RESPONDRANDOM . 0)
+    ;(RESPOND6 . 0)
+    ;(RESPOND7 . 0)
+    ;(RESPOND8 . 0)
+    ;(RESPOND9 . 0)
+    (WAIT-50 . 0)
+    (WAIT-25 . 0)
+    (WAIT-100 . 0)
+    (WAIT-200 . 0)
+    (WAIT-1000 . 0)
+    (WAIT-1500 . 0)
+    (DONOTHING . 0)
+    (DOTIMES-2 . 1)
+    (DOTIMES-3 . 1)
+    (DOTIMES-5 . 1)
+    (DOTIMES-10 . 1)
+    (PROG2 . 2)
+    (PROG3 . 3)
+    (PROG4 . 4)
+    (IF . 2)
+    ;(IF_NC . 2)
+    ;(IF_CURRENT_TH . 3)
+    ;(IF_CURRENT_CON . 3)  
+    ))
+;; 1 is high magnitude, 2 is low magnitude
+
+(defparameter stimuli '(
+                         .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 .6 .75 
+                        
+                        ))
+;; -- run-experiment template
+;;    Complete the run-experiment code. 
+;; -- output: The return value(s) is used by 'evaluate-fitness' below.
+
+(defun run-experiment (program) 
+  (let ((results '())
+        (expt-stimuli (statistics:random-sample (length stimuli) stimuli)))
+    (dolist (input expt-stimuli)
+      ;; -- begin single trial
+      (let ((md (make-model :clock 0 :current 0 :stm '(0 0 0)
+                            :salient input :inputs input :response 0)))
+        (interpret program md)
+        ;; -- collect information and create result
+        (let ((result (make-result :timing 0 :inputs input :response 0 :rt_low 0 :rt_high 0 :acc_low 0 :acc_high 0)))
+          (setf (result-response result) (model-response md))           ; record model's response
+                    (setf (result-acc_low result) (model-response md))           ; record model's response
+
+          (if (eq (model-inputs md) .6)
+              (setf (result-rt_low result) (model-clock md) (result-rt_high result) -1000)
+              (setf (result-rt_high result) (model-clock md) (result-rt_low result) -1000))
+          (push result results))))
+    results))
+    
+(defun filter-non-negative (l)
+  (cond
+    ((null l)                   ;; empty list
+     nil)
+    ((>= (first l) 0)      ;; number >= 0
+     (cons (first l) (filter-non-negative (rest l))))
+    (t                         ;; all other cases 
+     (filter-non-negative (rest l)))))
+     
+(defun fitness-acc_low (acc_low)
+  (abs (- *acclow* acc_low)))
+(defun fitness-acc_high (acc_high)
+  (abs (- *acchigh* acc_high)))
+
+;; Computes the f_s objective function.
+(defun fitness-size (program-size)
+  (gems:half-sigmoid (/ program-size *size-ps*)))
+
+(defun fitness-sd_low (sd_low)
+  (gems:half-sigmoid (/ (abs (- sd_low *sdlow*))
+                        *time-rt*)))
+  
+(defun fitness-sd_high (sd_high)
+  (gems:half-sigmoid (/ (abs (- sd_high *sdhigh*))
+                        *time-rt*)))
+  
+(defun fitness-rt_low (rt_low)
+  (gems:half-sigmoid (/ (abs (- rt_low *rtlow*))
+                        *time-rt*)))
+(defun fitness-rt_high (rt_high)
+  (gems:half-sigmoid (/ (abs (- rt_high *rthigh*))
+                        *time-rt*)))
+
+(defun evaluate-fitness (individual)
+  "Return the values (fitness extras) for given individual"
+  (let* ((program (gems:individual-tree individual))
+         (results (run-experiment program))
+         (acc_low (alexandria:mean (filter-non-negative (mapcar #'result-acc_low results))))
+         (f-acc_low (fitness-acc_low acc_low)) 
+         (acc_high (alexandria:mean (filter-non-negative (mapcar #'result-acc_high results))))
+         (f-acc_high (fitness-acc_high acc_high))
+         (rt_low (alexandria:mean (filter-non-negative (mapcar #'result-rt_low results))))
+         (f-rt_low (fitness-rt_low rt_low)) 
+         (rt_high (alexandria:mean (filter-non-negative (mapcar #'result-rt_high results))))
+         (f-rt_high (fitness-rt_high rt_high))
+         (sd_low (alexandria:standard-deviation (filter-non-negative (mapcar #'result-rt_low results))))
+         (f-sd_low (fitness-sd_low sd_low)) 
+         (sd_high (alexandria:standard-deviation (filter-non-negative (mapcar #'result-rt_high results))))
+         (f-sd_high (fitness-sd_high sd_high))
+         (program-size (gems:program-size program))
+         (f-s (fitness-size program-size))
+         )
+    (values (+ (* *fitness-rt_low* f-rt_low)
+               (* *fitness-rt_high* f-rt_high)
+               (* *fitness-sd_low* f-sd_low)
+               (* *fitness-sd_high* f-sd_high)
+               (* *fitness-acc_low* f-acc_low)
+               (* *fitness-acc_high* f-acc_high)
+               (* *propn-fitness-size* f-s)
+               )
+            (list rt_low f-rt_low rt_high f-rt_high acc_low f-acc_low  program-size f-s))))
+;; -- run-go template
+;;    Complete the run-gp code, or use your own functions to 
+;;    call the GP code.
+                                        ;(defun run-gp ()
+                                        ;  (gems:launch (operator-set) #'evaluate-fitness :total-generations 1000 :population-size 100)
+                                        ;  )
+                                        ;(run-gp)
+(defun run-gp (&key (max-generations *max-generations*)
+                 (population-size *population-size*)
+                 (f-rt_low *fitness-rt_low*) 
+                 (f-rt_high *fitness-rt_high*)
+                 (f-sd_low *fitness-sd_low*) 
+                 (f-sd_high *fitness-sd_high*)
+                 (f-acc_low *fitness-acc_low*)
+                 (f-acc_high *fitness-acc_high*)
+                 (rt *time-rt*)
+                 (logger nil) ; logger function
+                 )
+  "Sets all relevant parameters for the GP system and model evaluation"
+  (setf *fitness-rt_low* f-rt_low
+        *fitness-rt_high* f-rt_high
+        *fitness-sd_low* f-sd_low
+        *fitness-sd_high* f-sd_high
+        *fitness-acc_low* f-acc_low
+        *fitness-acc_high* f-acc_high
+        *time-rt* rt)
+  (gems:launch (operator-set) #'evaluate-fitness
+               :total-generations *max-generations*
+               :population-size *population-size*
+               :logger logger))
+               
+(defun make-filename (base args extn)
+  "Creates a filename with 'args' spliced into name"
+  (uiop:strcat (remove #\. (format nil "~a~{-~$~}" base args))
+               extn))
+               
+;; (defun log-name-section-4 ()
+;;   (make-filename "log" (list) ".csv"))
+  
+          
+(dolist (defn '(()))
+    (run-gp :max-generations *max-generations*
+            :population-size *population-size*
+            :rt *time-rt*
+            :logger 
+(gems:combine-loggers
+  (gems:make-logger "log.csv")            ; 1
+  (gems:make-logger "final-population.yml"     ; 2
+                    :kind :trace
+                    :filter #'(lambda (generation-number) (= generation-number *max-generations*))
+                    ))))
+
+
+                                             
+(dolist (defn '(()))
+  (let ((results (gpstats:read-trace (make-filename "final-population" defn ".yml"))))
+    (gpstats:write-fitness-generations results (make-filename "fitness" defn ""))
+                                        ; data for heatmap of model similarity
+    (gpstats:write-similarity-generations results (make-filename "similarity" defn ""))
+                                        ; data for proportions of dead code in population
+    (gpstats:write-deadcode-generations results (make-filename "sample-ndc" defn "")
+                                        #'run-experiment)
+    (let* ((last-generation (rest (first (last results))))
+           (best-models (gpstats:best-individuals-in-generation last-generation))
+           (best-ndc-models (gpstats:clean-individuals best-models #'run-experiment)))   ; 1
+      (gpstats:write-similarity-individuals best-ndc-models
+                                            (make-filename "best" defn ".dat"))
+      (format t "Found ~a best models in final generation, with ~a unique, cleaned models.~&"
+              (length best-models) (length best-ndc-models))
+      (print best-ndc-models)))
+  )