;;;<pre><xmp>
;;;  -*- mode: LISP; Package: CL-USER; Syntax: COMMON-LISP;  Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Author      : Mike Byrne
;;; Copyright   : (c)1998 CMU/Mike Byrne, All Rights Reserved
;;; Availability: public domain
;;; Address     : Carnegie Mellon University
;;;             : Psychology Department
;;;             : Pittsburgh,PA 15213-3890
;;;             : byrne+@andrew.cmu.edu
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Filename    : kk-exp.model
;;; Version     : 1.0
;;; 
;;; Description : Simulation of the Karlin & Kestenbaum (1968) experiment.
;;;             : To run a single trial, load this file and call
;;;             : (run-kk-trial x), where X is the SOA.  To run a simulation
;;;             : of all SOAs, call (test-kk x), where x is the number of
;;;             : runs at each SOA over which averaging is done.
;;; 
;;; 
;;; ----- History -----
;;; 98.02.02 Mike Byrne
;;;             : Genesis of single-file version with all output to 
;;;             : standard out.
;;; 
;;; 98.02.04 Dan Bothell
;;;             : General changes to facilitate running over the web:
;;;             : a) function names and class names changed by appending
;;;             : -kk (if not already part of the name) to avoid 
;;;             : conflict with other models (current and future)
;;;             : b) added *local-symbols* and *WWW-interface*
;;;             : c) changed methods finish-trial-kk and run-sim so that 
;;;             : output only when requested
;;;             : d) added output-kk function for displaying data in
;;;             : tables, and graphs (on the web)
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defvar *www-interface*)

(setf  *WWW-interface* 
      '((:heading "Simulation of the Karlin & Kestenbaum (1968) experiment" 2)
        (:table)
        
        (:table)
        "Number of runs (1-50): "     (:string :sy *runs*  10)
        (:table-end)
        
        (:table)
        (:checkbox "Trace" :sy *v*  nil)  (:new-row)
        (:checkbox "Text output" :sy *text*  t) (:new-row)
        (:checkbox "Graphic output" :sy *graphic*  nil) (:new-row)
        (:checkbox "Show simulation and experiment data on one graph" :sy *overlay*  nil)
         (:table-end)
        
        (:table-end)
        (:new-para)
        (:heading "Model not currently available" 2)
#|
        (:button "Show Experiment Results" "(output-kk *kk-exp-data* nil)")
           
        (:new-para)
        
        (:button "Run model" "(if (and (numberp *runs*))
                                   (progn
                                       
                                       (test-kk (min 50 (max 1 *runs*)))
                                       (window-close *experiment*)
                                       (setf *experiment* nil))

                                   (format *standard-output* \"All parameters must be numbers~%\"))")
        (:reset "Default values")
        (:button "Production Rules" "(let ((prods (no-output (pp))))
                                       (dolist (x prods)
                                         (pp-fct (list x))
                                         (spp-fct (list x))
                                         (format *standard-output* \"~%\")))")
        (:button "Chunk types" "(chunk-type)")
        (:button "Chunks" "(dm)")
         (:new-para)
         "TIME and SIZE:"
        (:new-para)
        "- It usually takes about 1 minute for 10 runs of the model"
        (:new-line)
        "- The trace of 1 run is approximatly 500k (300 pages) in size"
|#
        (:new-para)))






(defvar *tc* 0 "Trial counter")
(defvar *soa* 0)
(defvar *experiment* nil)
(defvar *v*)

(setf *experiment* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The trial-kk class
;;;
;;;             : A class for storing information about trials, like condition
;;;             : stimuli, and the like.  Used by the EXPEIRMENT-WINDOW class.
;;;             : A WRITE-TRIAL method is expected for printing the trial
;;;             : information to the data file.
;;;


;;; trial-kk      [Class]
;;; Description :  A class for storing information about a particular trial.

(defclass trial-kk ()
  ((kind :accessor trial-kind :initarg :trial-kind :initform nil)
   (block :accessor trial-block :initarg :trial-block :initform nil)))


;;; write-trial-kk      [Generic Function]
;;; Description : Writes a text representation (for the data file) of the trial
;;;             : to the given stream

(defgeneric write-trial-kk (trial-kk stream)
  (:documentation
   "Writes a text representation (for the data file) of the trial to
    the given stream"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;             
;;; The EXPERIMENT-WINDOW class
;;;
;;;             : A class for the actual experiment window and trial management.
;;;             : This class assumes that the experiment happens in blocks.
;;;             : If not, well, build only one block of trials.
;;;             : Any derived subclass will probably want to supply certain
;;;             : methods:
;;;             : 
;;;             : INITIALIZE-INSTANCE, to set up the experiment:  set the 
;;;             : data file path and number of blocks in the experiment,
;;;             : write a first line to the data file, that kind of thing.
;;;             : 
;;;             : A BUILD-TRIAL-LIST method, for building lists of trial
;;;             : objects.
;;;             : 
;;;             : An :AFTER method for SETUP-TRIAL, to do setup for each trial.
;;;             : 
;;;             : A :BEFORE for finish-trial-kk, to do cleanup for each trial.
;;;

;;; EXPERIMENT-WINDOW      [Class]
;;; Description : Base class for the experiment window, including slots for
;;;             : trial management and the data file.

(defclass experiment-window-kk (dialog)
  ((trial-list :accessor trial-list :initform nil)
   (current-trial :accessor current-trial :initform nil)
   (num-blocks :accessor nblocks :initarg :nblocks :initform nil)
   (current-block :accessor cblock :initform 0)
   (data-file :accessor data-file)
              ;; :initform (choose-new-file-dialog :prompt "Save data in:"))
   (completed-trials :accessor completed-trials 
                     :initform nil)
   )
  (:default-initargs
    :view-position #@(2 39)
    :view-size #@(636 439)
    :close-box-p NIL))


;;; build-trial-list-kk      [Generic Function]
;;; Description : Method to be supplied by the subclass.  This method should
;;;             : return a list containing one block's worth of trial objects
;;;             : to be presented by the experiment window.

(defgeneric build-trial-list-kk (experiment-window-kk)
  (:documentation
   ""))


;;; start-block-kk      [Method]
;;; Description : Does a garbage collect, builds the trial list if necessary,
;;;             : and calls SETUP-TRIAL to initiate the next trial

(defmethod start-block-kk ((self experiment-window-kk))
  "Sets up the things needed for a block of trials"
  (gc)
  (unless (trial-list self)
    (setf (trial-list self) (build-trial-list-kk self)))
  (incf (cblock self))
  (setup-trial-kk self))



;;; finish-block-kk      [Method]
;;; Description : When a block is done:  beep, write out whatever trials are
;;;             : still around in memory, and display the break message.

(defmethod finish-block-kk ((self experiment-window-kk))
  "Called when the list of trials is exhausted"
  (beep)
  (write-trials-kk self)
  (if (= (cblock self) (nblocks self))
    (finish-experiment-kk self)
    (progn
        (warning-kk 
         (format nil "Finished block ~A of ~A. Please take a short break to help your concentration." 
           (cblock self) (nblocks self)))
        (start-block-kk self))))


;;; finish-experiment-kk      [Method]
;;; Description : When the experiment is done:  beep, close the experiment
;;;             : window, display a finished message, and clean up the
;;;             : data file.

(defmethod finish-experiment-kk ((self experiment-window-kk))
  "At the end, do all this"
  (beep)
  (window-close self)
  (warning-kk "You're done, thank you! Please see the experimenter.")
  (set-mac-file-creator (data-file self) :|R*ch|)
  (lock-file (data-file self)))


;;; finish-trial-kk      [Method]
;;; Description : When a trial finishes, set the relevant info within the
;;;             : trial object, push the trial object onto the completed
;;;             : list, and setup a new trial

(defmethod finish-trial-kk ((self experiment-window-kk))
  "Does basic trial clean-up"
  (let ((this-trial (current-trial self)))
    (setf (trial-block this-trial) (cblock self))
    (push this-trial (completed-trials self))
   )
  (if (null (trial-list self))
    (finish-block-kk self)
    (setup-trial-kk self)))


;;; setup-trial-kk      [Method]
;;; Description : Pop trial-list into the current trial slot.  Definitely
;;;             : requires an :AFTER method from the subclass.

(defmethod setup-trial-kk ((self experiment-window-kk))
  (setf (current-trial self) (pop (trial-list self))))



;;; write-trials-kk      [Method]
;;; Date        : 97.1.10
;;; Description : 

(defmethod write-trials-kk ((self experiment-window-kk))
  "Writes the current list of completed trials and deletes those trials"
  (when (completed-trials self)
    (with-open-file (str (data-file self) 
                         :direction :output :if-exists :append)
      (dolist (the-trial (reverse (completed-trials self)))
        (write-trial-kk the-trial str)))
    (setf (completed-trials self) nil)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Misc utility stuff


(defun warning-kk (string)
  "Displays a warning dialog, with a cursor."
  (message-dialog string :position #@(150 150)))



;;; sim-spec-kk      [Class]
;;; Date        : 97.06.12
;;; Description : Base class from which SIM-SPECS should inherit.  Note that
;;;             : several other methods expected for subclasses:
;;;             : RUN-TRIAL, a method which actually causes a trial to be run.
;;;             :       This one is really required.
;;;             : COLLECT-DATA, for gathering and averaging the data after a
;;;             :       set of trials.
;;;             : SET-PARAMS, a method for setting any parameters based on the
;;;             :       trial specification.
;;;             : PRINT-SPEC, which should be an :AFTER method--for printing
;;;             :       out the data once a trial has been run.

(defclass sim-spec-kk ()
  ((type :accessor type :initarg :type :initform 'TRIAL)
   (ntimes :accessor ntimes :initarg :n)
   (base-rt :accessor base-rt :initform nil)))


;;; run-sim-kk      [Method]
;;; Date        : 97.06.12
;;; Description : Basic method for running a set of trials of some 
;;;             : specification.

(defmethod run-sim-kk ((spec sim-spec-kk))
  "Run a simulation specification."
  (gc)
  (set-params-kk spec)
  (dotimes (i (ntimes spec))
    (when *v* (format t "~% <=======> Trial #~S <=======>" i))
    (run-trial-kk spec)
    (incf *tc*))
  (collect-data-kk spec))


;;; print-spec-kk      [Method]
;;; Date        : 97.06.12
;;; Description : Prints a newline, the trial type, and the number of runs
;;;             : that went into the simulation

(defmethod print-spec-kk ((spec sim-spec-kk) stream)
  "Base method for printing a simulation specification"
  (format stream "~%~A	" (ntimes spec)))


;;; stubs

(defmethod collect-data-kk ((spec sim-spec-kk))
  (format t "~%~%<&> No method defined for COLLECT-DATA. <&>~%~%"))

(defmethod set-params-kk ((spec sim-spec-kk))
  (format t "~%~%<&> No method defined for SET-PARAMS. <&>~%~%"))


;;; run-specs-kk      [Function]
;;; Date        : 97.06.12
;;; Description : Takes a list of simulation specification and an output file
;;;             : path, running all the specs, writing the data for each spec,
;;;             : and keeping track of time.

(defun run-specs-kk (spec-lis output-stream)
  "Run and print to <outfile-path> a list of simulation specifications."
  (let ((*tc* 0)
        ;(start-time (get-internal-real-time))
        ;(run-time nil)
        )
    (dolist (spec spec-lis)
      (run-sim-kk spec)
      (print-spec-kk spec output-stream))
    ;(setf run-time (float (/  (- (get-internal-real-time) start-time) 1000)))
    ;(format t "~%~%~A trials in ~,3F sec" *tc* run-time)
    ;(format t "~% or ~,3F secs/trial." (/ run-time *tc*))
))



(defun flip-kk ()
  (= 0 (random 2)))

(defun flipval-kk (val1 val2)
  (if (flip-kk)
    val1
    val2))

(defclass kk-trial (trial-kk)
  ((soa :accessor soa :initarg :soa)
   (rt1 :accessor rt1 :initform 0)
   (rt2 :accessor rt2 :initform 0)))

(defmethod write-trial-kk ((the-t kk-trial) stream)
  (format stream "~A	" (soa the-t))
  (format stream "~A	" (rt1 the-t))
  (format stream "~A~%" (rt2 the-t)))



(defclass kk-exp (experiment-window-kk)
  ((text :accessor text :initform (make-dialog-item 'static-text-dialog-item
                                    #@(119 62) #@(51 16) "" 'nil))
   (got1 :accessor got1 :initform nil)
   )
  (:default-initargs
    :view-position #@(150 110)
    :view-size #@(300 150)
    :view-font '("chicago" 12 :srcor :plain (:color-index 0))
    :close-box-p T
    :window-title "KK sim"
    ))


(defmethod view-key-event-handler ((tw kk-exp) key)
   (declare (ignore key))
  
 (when (got1 tw)
    (setf (rt2 (current-trial tw)) (- (pm-get-time) (soa (current-trial tw))))
    (finish-trial-kk tw))
  (unless (got1 tw)
    (setf (rt1 (current-trial tw)) (pm-get-time))
    (maybe-make-detection-event-kk)
    (setf (got1 tw) t)))

(defun maybe-make-detection-event-kk ()
  (awhen (audicon (audio-m *mp*))
    (let ((detect-time (+ (onset (first it)) (delay (first it)))))
      (when (< (mp-time *mp*) detect-time)
        (pm-timed-event (+ detect-time 0.001) #'identity nil)))))
  

(defmethod finish-trial-kk ((tw kk-exp))
  (when *v*
    (format *standard-output* "~%SOA	RT1	RT2~%")
    (write-trial-kk (current-trial tw) *standard-output*))
  (remove-subviews tw (text tw))
  (push (current-trial tw) (completed-trials tw))
  )


(defmethod start-trial-kk ((tw kk-exp))
  (setf (current-trial tw) (make-instance 'kk-trial :soa *soa*))
  (setf (got1 tw) nil)
  (set-dialog-item-text (text tw) (flipval-kk "1" "2"))
  (add-subviews tw (text tw))
  (event-dispatch)
  (reset)
  (pm-proc-screen)
  (new-tone-sound (flipval-kk 600 3000) 0.035 (float (/ *soa* 1000.)))
  )



(defclass kk-sim-spec (sim-spec-kk)
  ((soa :accessor soa :initarg :soa :initform 0.0)
   (rt1 :accessor rt1 :initform nil)
   (rt2 :accessor rt2 :initform nil)))


(defmethod set-params-kk ((spec kk-sim-spec))
  (setf *soa* (soa spec))
  (setf (completed-trials *experiment*) nil))


(defmethod run-trial-kk ((spec kk-sim-spec))
  (start-trial-kk *experiment*)
  (pm-run 2.))


(defmethod collect-data-kk ((spec kk-sim-spec))
  (setf (rt1 spec) (rt1-avg-kk (completed-trials *experiment*)))
  (setf (rt2 spec) (rt2-avg-kk (completed-trials *experiment*))))


(defmethod print-spec-kk :after ((spec kk-sim-spec) stream)
  (format stream "~A	" (soa spec))
  (format stream "~5,1F	" (rt1 spec))
  (format stream "~5,1F	" (rt2 spec)))


(defun test-kk (n)
  (unless *experiment* (build-window-kk))
  (let ((dummy-str (make-string-output-stream)) 
        (accum nil))
    (format dummy-str "~%~%N	SOA	RT1	RT2~%")
    (dolist (soa '(90 190 290 390 490 590 690 790 890 990 1050 1150))
      (push (make-instance 'kk-sim-spec :soa soa :n n) accum))
    (setf accum (nreverse accum))
    (window-select *experiment*)
    (run-specs-kk accum dummy-str)
    ;(format t (get-output-stream-string dummy-str))
    (output-kk (convert-kk accum) t)))

(defun convert-kk (specs)
  (let ((res nil))
    (dolist (x specs)
      (push (list (soa x) (rt1 x) (rt2 x)) res))
    (reverse res)))

(defun rt1-avg-kk (tlis)
  (let ((accum 0))
    (dolist (trial tlis)
      (incf accum (rt1 trial)))
    (float (/ accum (length tlis)))))


(defun rt2-avg-kk (tlis)
  (let ((accum 0))
    (dolist (trial tlis)
      (incf accum (rt2 trial)))
    (float (/ accum (length tlis)))))


(defun build-window-kk ()
  (setf *experiment* (make-instance 'kk-exp))
  (PM-INSTALL-DEVICE *experiment*))


(defun run-kk-trial (&optional (soa 0))
  (unless *experiment* (build-window-kk))
  (setf *soa* soa)
  (setf (completed-trials *experiment*) nil)
  (start-trial-kk *experiment*)
  (pm-run 2.))


(defun step-kk-trial ()
  (start-trial-kk *experiment*)
  (pm-step))



;;;
;;; New code for the web interface
;;;

(defvar *runs*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)

(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)
(setf *v* nil)
(setf *runs* 10)

(defparameter *kk-exp-data* '((90 373 514)(190 366 429)(290 379 385)(390 395 331)
                             (490 390 302)(590 383 283)(690 378 294)(790 394 288)
                             (890 379 281)(990 397 283)(1050 378 277)(1150 394 280)))


(defun output-kk (res sim)
  (when *text*
    (format *standard-output* "~%~%~a data:~%" (if sim "Simulation" "Experimental"))
    (format t "~%SOA      RT1      RT2~%")
    (dolist (x res)
      (format *standard-output* "~4d    ~5,1f    ~5,1f~%" (car x) (second x) (third x)))
    
    (format *standard-output* "~%")
    
    (when (and sim *overlay*)
      (format *standard-output* "~%~%Experimental data:~%")
      (format t "~%SOA      RT1      RT2~%")
      (dolist (x *kk-exp-data*)
        (format *standard-output* "~4d    ~5,1f    ~5,1f~%" (car x) (second x) (third x)))
      
      (format *standard-output* "~%"))
    
    (unless *graphic* (format *standard-output*
                              "~%</pre>If your browser supports JAVA, you
                               can display the data in a graph by checking
                               the Graphic output box on the interface page.<pre>~%~%")))
  (when *graphic*
    (format *standard-output* "
                   <applet
                    code = \"DansGraphs.class\"
                    width = 500
                    height = 500>

                    <PARAM name=\"title\" value=\"Data for Karlin and Kestenbaum Experiment\">
                    <PARAM name=\"longestline\" value=\"12\">
                    <PARAM name=\"numlines\" value=\"~S\">
                    <PARAM name=\"xmin\" value=\"0\">
                    <PARAM name=\"xmax\" value=\"1200\">
                    <PARAM name=\"ymax\" value=\"600\">
                    <PARAM name=\"ymin\" value=\"0\">
                    <PARAM name=\"xdiv\" value=\"100\">
                    <PARAM name=\"ydiv\" value=\"50\">
                    <PARAM name=\"xspacing\" value=\"200\">
                    <PARAM name=\"yspacing\" value=\"100\">
                    <PARAM name=\"xval0\" value=\"90;190;290;390;490;590;690;790;890;990;1050;1150;\">
                    <PARAM name=\"xval1\" value=\"90;190;290;390;490;590;690;790;890;990;1050;1150;\">
                    <PARAM name=\"xname\" value=\"SOA (ms)\">
                    <PARAM name=\"yname\" value=\"RT (ms)\">
                    <PARAM name=\"lcolor0\" value=\"0\">
                    <PARAM name=\"lcolor1\" value=\"1\">
                    <PARAM name=\"lstyle0\" value=\"~s\">
                    <PARAM name=\"lstyle1\" value=\"~s\">

                    <PARAM name=\"name0\" value=\"~a Task 1\">
                    <PARAM name=\"name1\" value=\"~a Task 2\">
          "
            (if (and sim *overlay*) 4 2)
            (if sim 2 6553)
            (if sim 2 6553)
            (if sim "Simulation Data " "Experiment Data ")
            (if sim "Simulation Data " "Experiment Data "))

    (format *standard-output* "<PARAM name=\"yval0\" value=\"")

    (dolist (x res)
      (format *standard-output* "~6,2f;" (second x)))

    (format *standard-output* "\">")

    (format *standard-output* "<PARAM name=\"yval1\" value=\"")

    (dolist (x res)
      (format *standard-output* "~6,2f;" (third x)))

    (format *standard-output* "\">")
    
    
    (when (and *overlay* sim)
      (format *standard-output* "
                     <PARAM name=\"lcolor2\" value=\"0\">
                    <PARAM name=\"lcolor3\" value=\"1\">
                    <PARAM name=\"lstyle2\" value=\"6553\">
                    <PARAM name=\"lstyle3\" value=\"6553\">
                    <PARAM name=\"xval2\" value=\"90;190;290;390;490;590;690;790;890;990;1050;1150;\">
                    <PARAM name=\"xval3\" value=\"90;190;290;390;490;590;690;790;890;990;1050;1150;\">
                    <PARAM name=\"name2\" value=\"Experiment Data Task 1\">
                    <PARAM name=\"name3\" value=\"Experiment Data Task 2\">
                    <PARAM name=\"yval2\" value=\"")
      
      (dolist (x *kk-exp-data*)
        (format *standard-output* "~6,2f;" (second x)))
      
      (format *standard-output* "\">")
      
      (format *standard-output* "<PARAM name=\"yval3\" value=\"")
      
      (dolist (x *kk-exp-data*)
        (format *standard-output* "~6,2f;" (third x)))
      
      (format *standard-output* "\">"))
    
    (format *standard-output* "
             <HR> Your browser does not support JAVA, so you cannot view the graphs.~%
             </HR></applet>")))





;;;; ---------------------------------------------------------------------- ;;;;</xmp><pre><a name="model">
;;;; Actual ACT-R/PM model of the task.
;;;; ---------------------------------------------------------------------- ;;;;</a>

(clearall)

(pm-add-types-and-chunks)
(pm-reset)
(pm-set-params :optimize-visual nil :auto-dequeue t)
(pm-set-params :motor-proc-events t :randomize-time t)

(sgp-fct (list :era t :v *v*))
(chunk-type kk-goal step)

(add-dm (goal1 isa kk-goal)
        (tloc isa visual-location screen-x 119 screen-y 62))

(pm-attend-location 119 62)

(goal-focus goal1)



(p seen-two
   =goal>
     isa kk-goal
     step nil
   =loc>
     isa visual-object
     time now
     value "2"
==>
  !send-command! :MOTOR punch :hand left :finger ring
  =goal>
    step 1)


(p seen-one
   =goal>
     isa kk-goal
     step nil
   =loc>
     isa visual-object
     time now
     value "1"
==>
   !send-command! :MOTOR punch :hand left :finger pinkie
  =goal>
    step 1)

   

(p heard-high
   =goal>
     isa kk-goal
     step 1
   =event>
     isa audio-event
     time now
     pitch high
   =mgr>
     isa module-state
     module :motor
     processor free
==>
   !send-command! :MOTOR punch :hand right :finger index
   =goal>
     step 2)


(p heard-low
   =goal>
     isa kk-goal
     step 1
   =event>
     isa audio-event
     time now
     pitch low
   =mgr>
     isa module-state
     module :motor
     processor free
==>
   !send-command! :MOTOR punch :hand right :finger middle
   =goal>
     step 2)

#|
(p wait
   =goal>
     isa kk-goal
     step 1
==>
   )

(parameters wait :r 0.2 :effort 0.002)
|#


(p done
   =goal>
     isa kk-goal
     step 2
   =mgr>
     isa module-state
     module :motor
     modality free
==>
   !pop!)