;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;
;;; ACT-R Button Press Model
;;; works with ACT-R 4.0 (2/6/97 or newer)
;;;
;;; coded by: Dan Bothell
;;; revised by: Marsha Lovett
;;;
;;; This file contains an ACT-R model
;;; of the Myers, Fort, Katz, and Suydam (1963)
;;; choice experiment.
;;;
;;; In the experiment subjects were to
;;; press one of two buttons on each
;;; trial, and were informed after
;;; choosing whether it was the correct
;;; button.  The correct button to press
;;; was randomly chosen on each trial,
;;; with a probability p for button 1
;;; and 1-p for button 2.
;;;
;;; One group of subjects was paid 10 cents for
;;; each correct answer, another group was paid
;;; 1 cent, and another group was not paid.
;;;
;;; A command line interface,
;;; and a WWW interface are included.
;;;
;;; To use the command line interface,
;;; set the parameters with setf, and then
;;; call (button-press-myers-decay n) to simulate n button
;;; presses.
;;;
;;;
;;; To use the WWW interface, you need to run
;;; the ACT-R on the Web application (follow the
;;; instructions provided with it), or use a
;;; web browser to connect to a site that has
;;; the model installed.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Global Variables

(defvar *act-r-button-press* 1)   ;; set by the model to the current button pressed
                                  ;; (0 for button 1, 1 for button 2)

;;; the rest are the parameters for the model, and are set by the interfaces

(defvar *choice-g*)
(defvar *choice-g-penny*)
(defvar *choice-g-dime*)
(defvar *egt*)
(defvar *v*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)
(defvar *button-press-runs*)
(defvar *pl*)
(defvar *answer*)
(defvar *curr-prob*)

(setf *pl* .714)
(setf *choice-g* .75)
(setf *choice-g-penny* 1.04)
(setf *choice-g-dime* 1.17)
(setf *egt* .24)
(setf *v* nil)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)
(setf *curr-prob* 0.6)

;;; p button1 = .6 .7 .8 (no pay)
;;; p button1 = .6 .7 .8 (1 cent condtiion)
;;; p button1 = .6 .7 .8 (10 cent condition)
(defparameter *myers-decay-data* '(.616 .753 .871 .653 .871 .925 .713 .868 .951))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This section contains the interface for the WWW using the
;;; ACT-R on the Web application by Elmar Schwarz

(defvar *WWW-interface*)

(setf  *WWW-interface*
      '((:heading "Myers, Fort, Katz, and Suydam (1963) Experiment Model (with decay)" 2)
        (:table)

        (:table)
        "Decay parameter:" (:string :sy *pl* .714) (:new-row)
        "Expected Gain Noise (t): " (:string :sy *egt*            .24)  (:new-row)
        "G (unpaid): "                     (:string :sy *choice-g*       .75)  (:new-row)
        "G (penny): "                      (:string :sy *choice-g-penny* 1.04)  (:new-row)
        "G (dime): "                       (:string :sy *choice-g-dime*  1.17)  (:new-row)
        "Subjects per condition (max 10): "  (:string :sy *button-press-runs* 1)
        (: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)
        (:button "Show Experiment Results" "(display-myers-decay *myers-decay-data* nil)")
        (:new-para)
        (:button "Run model" "(if (and (numberp *pl*) (numberp *choice-g-dime*) (numberp *choice-g-penny*) (numberp *choice-g*) (numberp *egt*) (numberp *button-press-runs*))
                                  (button-press-myers-decay (min 10 (max *button-press-runs* 1)))
                                  (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 a run of 1 subject per condition"
        (:new-line)
        "- The trace of 1 run of 1 subject per condition is approximatly 150k (100 pages) in size"))

;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; distribution-myers-decay-fct takes 4 arguments: production, p (probability),
;;; n (total number of trials), and s (seconds per trial)
;;; it sets up production's history to have evenly distributed
;;; eventual successes and failures with p*n eventual successes and
;;; (1-p)*n eventual failures.  creation time is set to be n*s seconds
;;; before simulation begins.
;;; Note: this simulation only runs the "test phase", so this function
;;; sets up production as if training phase had just completed
(defun distribution-myers-decay-fct (production p n s)
  (spp-fct (list production
                 :creation-time (- (* n s))
                 :successes (* n p (- 2.0 p))
;                :successes n
                 :failures 0
                 :eventual-successes (* p n)
                 :eventual-failures (round (* p (- 1.0 p) n))
;                :eventual-failures (* n (- 1.0 p))
)))

;;; get-answer modifies the chunk the-answer according to probability of current condition
(defun get-answer-myers-decay ()
  (if (< (random 1.0) *curr-prob*)
      (and (setf *answer* 'one) (when *v* (format *standard-output* "ONE IS CORRECT~%")))
      (and (setf *answer* 'two) (when *v* (format *standard-output* "TWO IS CORRECT~%")))))

;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; button-press-myers-decay takes one parameter which specifies how many subjects to
;;; run per condition of a simulation of the Myers et al experiment.  Each subject
;;; goes through 100 test trials.
;;;  First, the ACT-R parameters are set according to the values given in
;;; the global variables (as set by the interface). Then, the model is called to
;;; run through 100 button-pressing trials, and the button presses are recorded.
;;; After all of the conditions have been run a summary of the experiment results
;;; is displayed.

(defun button-press-myers-decay (n)
  (let ((result nil)
        (b1-pressed 0))

    (dotimes (i 3)

      (dolist (b1-p '( .6 .7 .8 ))

        (when *v* (format *standard-output* "~%~%Probability of button1= ~S (~S):~%~%" b1-p (if (= i 0) 'unpaid (if (= i 1) 'penny 'dime))))

        (reset)

        (sgp-fct (list :ol nil
                       :era t
                       :er t
                       :lt nil
                       :ut nil
                       :g  (if (= i 0) *choice-g* (if (= i 1) *choice-g-penny* *choice-g-dime*))
                       :egs (/ *egt* (sqrt 2))
                       :v *v*
                       :pl *pl*))

        (setf *curr-prob* b1-p)
        (distribution-myers-decay-fct 'choose-button-1 b1-p 300 1.0)
        (distribution-myers-decay-fct 'choose-button-2 (- 1 b1-p) 300 1.0)

        (setf b1-pressed 0)
        (dotimes (subj n)
          (dotimes (i 100)
            (goal-focus goal)
            (modfocus pressed nil)
            (run)

            (when (=  *act-r-button-press* 0 ) (incf b1-pressed))))
        (setf result (cons (/ b1-pressed (* 100.0 n)) result))))

      (format *standard-output* "~%~%Simulation parameters: (~S ~S ~S ~S ~S ~S)~%" *pl* *egt* *choice-g* *choice-g-penny* *choice-g-dime* n)

      (display-myers-decay (reverse result) t)))

;;; display-myers-decay takes two parameters
;;; the results data to display and a flag to specify if the
;;; data is for a simulation
;;; and outputs a display of % choice for button 1,
;;; in either text, a graph (on the web),
;;; or both, depending on the settings of *text* and *graphic*

(defun display-myers-decay (data simulation)

  (when *text*
    (format *standard-output* "~%~%~a data:~%" (if simulation "Simulation" "Experimental"))
    (format t "~%         p of Button 1        button 1 chosen~%")
    (do ((pay '(0 0 0 1 1 1 10 10 10)(cdr pay))
         (x data (cdr x))
         (p '(.6 .7 .8 .6 .7 .8 .6 .7 .8) (cdr p)))
        ((null x))
      (when (= (car p) .6)
        (format *standard-output* "Pay ~s cents~%" (car pay)))

      (format *standard-output* "         ~7,1F              ~9,3F~%" (car p) (car x)))

    (format *standard-output* "~%")

    (when (and simulation *overlay*)
      (format *standard-output* "~%~%Experimental data:~%")
      (format t "~%         p of Button 1        button 1 chosen~%")
      (do ((pay '(0 0 0 1 1 1 10 10 10)(cdr pay))
           (x *myers-decay-data* (cdr x))
           (p '(.6 .7 .8 .6 .7 .8 .6 .7 .8) (cdr p)))
          ((null x))
        (when (= (car p) .6)
        (format *standard-output* "Pay ~s cents~%" (car pay)))

        (format *standard-output* "         ~7,1F              ~9,3F~%" (car p) (car 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 = 400
        height = 400>

        <PARAM name=\"title\" value=\"Data for Myers et al\">
        <PARAM name=\"longestline\" value=\"3\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xmin\" value=\".6\">
        <PARAM name=\"xmax\" value=\".8\">
        <PARAM name=\"ymax\" value=\"1.0\">
        <PARAM name=\"ymin\" value=\".4\">
        <PARAM name=\"ydiv\" value=\".1\">
        <PARAM name=\"xspacing\" value=\"0.1\">
        <PARAM name=\"yspacing\" value=\"0.2\">
        <PARAM name=\"xval0\" value=\".6;.7;.8;\">
        <PARAM name=\"xval1\" value=\".6;.7;.8;\">
        <PARAM name=\"xval2\" value=\".6;.7;.8;\">
        <PARAM name=\"xname\" value=\"p of Button 1\">
        <PARAM name=\"yname\" value=\"Button 1 chosen\">
        
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lcolor2\" value=\"2\">

        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        
        <PARAM name=\"name0\" value=\"~a\">
        <PARAM name=\"name1\" value=\"~a\">
        <PARAM name=\"name2\" value=\"~a\">"
            (if (and simulation *overlay*) 6 3)
            (if simulation 2 6553)
            (if simulation 2 6553)
            (if simulation 2 6553)
            (if simulation "Simulation Data (unpaid)" "Experiment Data (unpaid)")
            (if simulation "Simulation Data (paid .01)" "Experiment Data (paid .01)")
            (if simulation "Simulation Data (paid .10)" "Experiment Data (paid .10)"))

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

    (dotimes (i 3)
      (format *standard-output* "~f;" (nth i data)))

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

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

    (dotimes (i 3)
      (format *standard-output* "~f;" (nth (+ i 3) data)))

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

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

    (dotimes (i 3)
      (format *standard-output* "~f;" (nth (+ i 6) data)))

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

    (when (and *overlay* simulation)
      (format *standard-output* "
        
        <PARAM name=\"lcolor3\" value=\"0\">
        <PARAM name=\"lcolor4\" value=\"1\">
        <PARAM name=\"lcolor5\" value=\"2\">

        <PARAM name=\"lstyle3\" value=\"6553\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"xval3\" value=\".6;.7;.8;\">
        <PARAM name=\"xval4\" value=\".6;.7;.8;\">
        <PARAM name=\"xval5\" value=\".6;.7;.8;\">
        <PARAM name=\"yval3\" value=\"")

      (dotimes (i 3)
        (format *standard-output* "~f;" (nth i *myers-decay-data*)))

      (format *standard-output* "\">
          <PARAM name=\"name3\" value=\"Experiment Data (unpaid)\">"))

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

      (dotimes (i 3)
        (format *standard-output* "~f;" (nth (+ i 3) *myers-decay-data*)))

      (format *standard-output* "\">
          <PARAM name=\"name4\" value=\"Experiment Data (paid .01)\">")

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

      (dotimes (i 3)
        (format *standard-output* "~f;" (nth (+ i 6) *myers-decay-data*)))

      (format *standard-output* "\">
          <PARAM name=\"name5\" value=\"Experiment Data (paid .10)\">")

    (format *standard-output* "
             <HR> Your browser does not support JAVA, so you cannot view the graphs.~%
             </HR></applet>")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The rest of the file contains the
;;; actual ACT-R model to guess the button to press.
;;; There are 2 productions, one to press button 1, and
;;; one to press button 2.  When the goal is set to
;;; press a button, either one can fire.  The one which
;;; fires is based on the (noisy) PG-C values for the productions.
;;;

(clearall)

(sgp :g 1.0 :era t :er t :egs .17 :v nil :pl 0.714 :ol t :ut nil)

(chunk-type press-button pressed "The type for the only goal")

(add-dm (goal
        "The goal is to press a button"
        isa press-button)
        )

(goal-focus goal)

(p choose-button-1
"
   IF the goal is to press a button
   THEN press button 1
"
   =goal>
      isa press-button
      pressed nil
==>
  !output! ("~%pressed: button 1  ~%")
  =goal>
     pressed one
  !eval! (setf *act-r-button-press* 0)
  !eval! (get-answer-myers-decay)
)

(p choose-button-2
"
   IF the goal is to press a button
   THEN press button 2
      and pop the goal
"
   =goal>
      isa press-button
      pressed nil
==>
   !output! ("~%pressed: button 2  ~%")
   =goal>
      pressed two
   !eval! (setf *act-r-button-press* 1)
   !eval! (get-answer-myers-decay)
)

(p chose-correctly
   =goal>
      isa press-button
      pressed =button

   !eval! (equal *answer* =button)
==>
   =goal>
      pressed nil
   !pop!
   !output! ("CORRECT")
)

(spp chose-correctly :success t)

(p chose-incorrectly
   =goal>
      isa press-button
      pressed =button
   !eval! (not (equal *answer* =button))
==>
   =goal>
      pressed nil
   !pop!
   !output! ("WRONG")
)

(spp chose-incorrectly :failure t)