;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;; 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 Friedman, Burke, Cole, Keller,
;;; Millward, and Estes (1964) button
;;; 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.

;;;
;;; A command line interface,
;;; and a WWW interface are included.
;;;
;;; To use the command line interface,
;;; set the parameters with setf, and then
;;; call (friedman-learn-rep-subjects n)
;;; to simulate n subjects
;;;
;;;
;;; 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 *egt*)
(defvar *v* nil)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)
(defvar *curr-prob*)
(defvar *answer*)
(defvar *button-press-runs*)
(defvar *pl*)
(defvar *f-learn-sim-data*)
(defvar *answer-list*)

(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)
(setf *choice-g* 1.9)
(setf *egt* .24)
(setf *v* nil)
(setf *pl* .714)


(defparameter *friedman-learn-outcomes* 
'#((2 2 2 2 1 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 1 2 2 2 2 2)
   (2 2 2 2 1 2 2 2 2 1 2 2 2 2 1 2 2 2 1 2 2 2 2 1 2 2 2 1 2 2 2 2 2 1 2 2 2 1 2 2 2 2 1 2 2 2 2 2)
   (2 1 2 2 1 2 2 2 1 2 2 1 2 2 1 2 2 2 1 2 2 1 2 1 2 2 2 1 2 2 1 2 2 1 2 2 1 2 2 1 2 2 1 2 2 1 2 2)
   (2 1 2 2 1 2 1 2 2 1 2 1 2 2 1 2 1 2 2 1 2 1 2 2 1 2 1 2 2 1 2 1 2 1 2 2 2 1 2 1 2 2 1 2 1 2 1 2)))

(defparameter *friedman-learn-data* '(.3 .22 .18 .16 .44 .23 .30 .30 .5 .45 .45 .40 .45 .48 .45 .45))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Friedman, Burke, Cole, Keller, Millward, and Estes (1964) Experiment Model" 2)
        (:table)

        (:table)
        "Decay parameter:" (:string :sy *pl* .714) (:new-row)
        "Expected Gain Noise (t): " (:string :sy *egt*            .24)  (:new-row)
         "Number simulated subjects (1 - 100): "  (: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)
        (:hidden :sy *choice-g*       1.9)
       
        (:new-para)
        (:button "Show Experiment Results" "(display-friedman-learn *friedman-learn-data* nil)")
        (:new-para)
        (:button "Run model" "
                              (if (and (numberp *pl*) (numberp *choice-g*) (numberp *egt*) (numberp *button-press-runs*))
                                  (friedman-learn-rep-subjects (min 100 (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 2 simulated subjects"
        (:new-line)
        "- The trace of 1 simulated subject is approximatly 35k (23 pages) in size"))

;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; distribution-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-fct-friedman-learn (production p n s)
  (spp-fct (list production
                 :creation-time (- (* n s))
                 :successes n
                 :failures 0
                 :eventual-successes (* p n)
                 :eventual-failures (* (- 1.0 p) n))))

;;; get-answer-friedman-learn modifies the chunk the-answer according to probability of current condition
(defun get-answer-friedman-learn ()
  (cond ((= (car *answer-list*) 1)(and (setf *answer* 'one)(if *v* (format t "ONE IS CORRECT~%"))))
        ((= (car *answer-list*) 2)(and (setf *answer* 'two)(if *v* (format t "TWO IS CORRECT~%")))))
  (setf *answer-list* (cdr *answer-list*)))
;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; button-press-friedman takes one parameter which specifies how many button presses to
;;; perform per condition of a simulation of the friedman et al experiment.
;;;  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
;;; press a button, and the button press is recorded.
;;; After all of the button presses have been done a summary of the experiment results
;;; is displayed.

(defun button-press-friedman-learn (n)
  (let ((result nil)
        (b1-pressed 0))

      (dolist (b1-p '(.1 .2 .3 .4))

        (setf *answer-list* (aref *friedman-learn-outcomes* (- (round (* 10 b1-p)) 1)))
        (when *v* (format *standard-output* "~%~%Probability of button1= ~S :~%~%" b1-p))

        (reset)

        (sgp-fct (list :ol nil
                       :era t
                       :er t
                       :mt nil
                       :lt nil
                       :ut nil
                       :g  *choice-g*
                       :egs (/ *egt* (sqrt 2))
                       :v *v*
                       :pl *pl*))
        (setf *curr-prob* b1-p)
        (distribution-fct-friedman-learn 'choose-button-1 0.5 432 1.0)
        (distribution-fct-friedman-learn 'choose-button-2 0.5 432 1.0)

        (dotimes (j 4)
          (setf b1-pressed 0)
          (dotimes (i n)
            (wmfocus goal)
            (run)
            (when (=  *act-r-button-press* 0 ) (incf b1-pressed)))
          (setf result (cons (/ b1-pressed n) result))))

      (setf *f-learn-sim-data* (reverse result))))

(defun friedman-learn-div-by-m (lis m)
  (do* ((oldlis lis (cdr oldlis))
        (res (/ (car oldlis) (* 1.0 m)) (/ (car oldlis) (* 1.0 m)))
        (newlis (list res) (cons res newlis))
        (counter 0 (+ 1 counter)))
       ((null (cdr oldlis))(reverse newlis))))

(defun friedman-learn-rep-subjects (m)
  (do* ((one-set nil *f-learn-sim-data*)
       (totals '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) (mapcar '+ totals one-set))
       (counter 0 (+ 1 counter)))
      ((= counter m)
       (display-friedman-learn (friedman-learn-div-by-m totals m) t))
    (button-press-friedman-learn 12)))

;;; display-friedman-learn 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-friedman-learn (data simulation)
  (format *standard-output* "~%~%Simulation parameters: (~S ~S ~S)~%" *pl* *egt* *button-press-runs*)

  (when *text*
    (format *standard-output* "~%~%~a data:~%" (if simulation "Simulation" "Experimental"))
    (format t "~%   p of Button 1      ---------button 1 chosen---------~%")
    (format t   "                      block1   block2   block3   block4~%")
    (do ((x data (cddddr x))
         (p '(.1  .2 .3 .4) (cdr p)))
        ((null x))
      (format *standard-output* "   ~7,1F        ~9,2F"   (car p) (car x))
      (format *standard-output* "~9,2F"   (nth 1 x))
      (format *standard-output* "~9,2F"   (nth 2 x))
      (format *standard-output* "~9,2F~%" (nth 3 x)))

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

    (when (and simulation *overlay*)
      (format *standard-output* "~%~%Experimental data:~%")
    (format t "~%   p of Button 1      ---------button 1 chosen---------~%")
    (format t   "                      block1   block2   block3   block4~%")
      (do ((x *friedman-learn-data* (cddddr x))
           (p '(.1 .2 .3 .4) (cdr p)))
          ((null x))
      (format *standard-output* "   ~7,1F        ~9,2F"   (car p) (car x))
      (format *standard-output* "~9,2F"   (nth 1 x))
      (format *standard-output* "~9,2F"   (nth 2 x))
      (format *standard-output* "~9,2F~%" (nth 3 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 = 500>

        <PARAM name=\"title\" value=\"Data for Friedman et al\">
        <PARAM name=\"longestline\" value=\"4\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"4\">
        <PARAM name=\"ymax\" value=\"1.0\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"ydiv\" value=\".1\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"yspacing\" value=\"0.2\">
        <PARAM name=\"xval0\" value=\"1;2;3;4;\">
        <PARAM name=\"xval1\" value=\"1;2;3;4;\">
        <PARAM name=\"xval2\" value=\"1;2;3;4;\">
        <PARAM name=\"xval3\" value=\"1;2;3;4;\">
        <PARAM name=\"xname\" value=\"sub-block\">
        <PARAM name=\"yname\" value=\"Button 1 chosen\">
        <PARAM name=\"name0\" value=\"~a(p = .1)\">
        <PARAM name=\"name1\" value=\"~a(p = .2)\">
        <PARAM name=\"name2\" value=\"~a(p = .3)\">
        <PARAM name=\"name3\" value=\"~a(p = .4)\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lcolor2\" value=\"2\">
        <PARAM name=\"lcolor3\" value=\"3\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"lstyle3\" value=\"~s\">

"
            (if (and simulation *overlay*) 8 4)
            (if simulation "Simulation Data " "Experiment Data ")
            (if simulation "Simulation Data " "Experiment Data ")
            (if simulation "Simulation Data " "Experiment Data ")
            (if simulation "Simulation Data " "Experiment Data ")
            (if simulation 2 6553)
            (if simulation 2 6553)
            (if simulation 2 6553)
            (if simulation 2 6553)
)

    (dotimes (i 4)
      (format *standard-output* "<PARAM name=\"yval~s\" value=\"" i)
      
      (dotimes (j 4)
        (format *standard-output* "~4,3f;" (nth (+ j (* i 4)) data)))
      
      (format *standard-output* "\">"))



    (when (and *overlay* simulation)
      (format *standard-output* "
        <PARAM name=\"xval4\" value=\"1;2;3;4;\">
        <PARAM name=\"xval5\" value=\"1;2;3;4;\">
        <PARAM name=\"xval6\" value=\"1;2;3;4;\">
        <PARAM name=\"xval7\" value=\"1;2;3;4;\">
        <PARAM name=\"name4\" value=\"Experiment Data (p = .1)\">
        <PARAM name=\"name5\" value=\"Experiment Data (p = .2)\">
        <PARAM name=\"name6\" value=\"Experiment Data (p = .3)\">
        <PARAM name=\"name7\" value=\"Experiment Data (p = .4)\">
        <PARAM name=\"lcolor4\" value=\"0\">
        <PARAM name=\"lcolor5\" value=\"1\">
        <PARAM name=\"lcolor6\" value=\"2\">
        <PARAM name=\"lcolor7\" value=\"3\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"lstyle6\" value=\"6553\">
        <PARAM name=\"lstyle7\" value=\"6553\">
        ")

      (dotimes (i 4)
      (format *standard-output* "<PARAM name=\"yval~s\" value=\"" (+ 4 i))
      
      (dotimes (j 4)
        (format *standard-output* "~4,3f;" (nth (+ j (* i 4)) *friedman-learn-data*)))
      
      (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">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The rest of the file contains the
;;; actual ACT-R model to guess the button to press.

(clearall)

(sgp :g 1.9 :era t :egs .17 :v nil :pl 0.714)

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

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

(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-friedman-learn)
)

(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-friedman-learn)
)

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

(spp chose-correctly :success t :effort 0.95)

(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 :effort 0.95)