;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ACT-R Button Press Model
;;; works with ACT-R 4.0 (2/6/97 or newer)
;;;
;;; coded by: Dan Bothell
;;; 
;;; This file contains an ACT-R model
;;; of button choice, which can be used to
;;; simulate many different types of 
;;; choice experiemnts.
;;;
;;; 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-exp 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)
(defvar *correct-button*)         ;; the current correct button (0 for button 1, 1 for button 2)

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

(defvar *button-1-p* .5)
(defvar *choice-g* 1)
(defvar *egn* .69)
(defvar *v* nil)
(defvar *button-1-r* .5)
(defvar *button-2-r* .5)
(defvar *button-1-q* 1)
(defvar *button-2-q* 1)
(defvar *button-1-a* .05)
(defvar *button-2-a* .05)
(defvar *button-1-b* 0)
(defvar *button-2-b* 0)
(defvar *button-press-runs* 1)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Probability Learning Experiments Model" 2)
        (:table)
        
        (:table)
        "Probabilitiy button 1 correct: "       (:string :sy *button-1-p*   0.5)  (:new-row) (:new-row)
        "q choose-button-1 production:"         (:string :sy *button-1-q*   1)    (:new-row)
        "r choose-button-1 production:"         (:string :sy *button-1-r*   0.5)  (:new-row)
        "a choose-button-1 production:"         (:string :sy *button-1-a*    .05)  (:new-row)
        "b choose-button-1 production:"         (:string :sy *button-1-b*   0)    (:new-row) (:new-row)
        "q choose-button-2 production:"         (:string :sy *button-2-q*   1)    (:new-row)
        "r choose-button-2 production:"         (:string :sy *button-2-r*   0.5)  (:new-row)
        "a choose-button-2 production:"         (:string :sy *button-2-a*    .05)  (:new-row)
        "b choose-button-2 production:"         (:string :sy *button-2-b*   0)    (:new-row) (:new-row)
        "Noise variance (sigma squared): "              (:string :sy *egn*          .69)  (:new-row)
        "G: "                                   (:string :sy *choice-g*            1)    (:new-row)
        "Number of presses (max 10000): "       (:string :sy *button-press-runs* 1)
        (:table-end)
        
        (:table)
        
        (:checkbox "Trace"            :sy *v*  nil)   (:new-row)
        
        (:table-end)
        (:table-end)
        
        (:new-para)
        (:button "Run model" "(if (and (numberp *button-1-p*) (numberp *button-1-r*) (numberp *button-1-a*) 
                                       (numberp *button-1-b*) (numberp *button-1-q*) (numberp *button-2-r*) 
                                       (numberp *button-2-a*) (numberp *button-2-b*) (numberp *button-2-q*) 
                                       (numberp *choice-g*) (numberp *egn*) (numberp *button-press-runs*))
                                  (button-press-exp (min 10000 (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 less than 1 minute for a run of 1000 presses"
        (:new-line)
        "- The trace of 1 run of 1000 presses is approximatly 150k (100 pages) in size"))



;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; button-press-exp takes one parameter which specifies how many button presses to 
;;; perform.  First, the ACT-R parameters are set according to the values given in
;;; the global variables (as set by the interface). Then, the correct button is chosen (based 
;;; on the probability set by the *button-1-p* global variable), and
;;; the model is called to guess (it sets whether it was a success or
;;; failure).  
;;; After all of the button presses have been done a summary table of the 
;;; correct buttons and guesses is printed out.

(defun button-press-exp (n)
  (let ((count (make-array '(2 2) :initial-element 0))) ;; an array to record presses and guesses
    
    (reset)
    
    (sgp-fct (list :ol t
                   :era t
                   :er t
                   :g  *choice-g*
                   :egn *egn*
                   :v *v*))
    
    (parameters-fct 'choose-button-1 
                    (list
                     :r *button-1-r* 
                     :q *button-1-q* 
                     :a *button-1-a* 
                     :b *button-1-b*))
    
    (parameters-fct 'choose-button-2 
                    (list
                     :r *button-2-r* 
                     :q *button-2-q* 
                     :a *button-2-a* 
                     :b *button-2-b*))
    
    (dotimes (i n)
      (setf *correct-button* (correct-button-press))
      
      (wmfocus goal)
      (run)
      
      (incf (aref count *correct-button* *act-r-button-press*)))
    
    (format *standard-output* "~%~%Simulation parameters: (~S ~S ~S ~S ~S ~S ~S ~S ~S ~S ~S ~S )"
            *button-1-p* *button-1-q* *button-1-r* *button-1-a* *button-1-b* *button-2-q* 
            *button-2-r* *button-2-a* *button-2-b* *egn* *choice-g* *button-press-runs*)


    (format *standard-output* "~%~%                Button Pressed~%")
    (format *standard-output* "                   1      2~%")
    (format *standard-output* "Correct Button~%")
    (format *standard-output* "       1         ~4d   ~4d   ~4d~%" 
            (aref count 0 0) (aref count 0 1) (+ (aref count 0 0) (aref count 0 1)))
    
    (format *standard-output* "       2         ~4d   ~4d   ~4d~%" 
            (aref count 1 0) (aref count 1 1) (+ (aref count 1 0) (aref count 1 1)))
    
    (format *standard-output* "                 ~4d   ~4d ~%" 
            (+ (aref count 0 0) (aref count 1 0)) (+ (aref count 0 1) (aref count 1 1)))))

;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; correct-button-press returns a value representing the correct button with 
;;; probability of button 1 being correct equal to *button-1-p*.  A 0 represents
;;; button 1, and a 1 represents button 2.

(defun correct-button-press ()
  (if (< (random 1.0) *button-1-p*)
    0
    1))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; 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 :egn .5 :v nil :pl nil)

(chunk-type press-button "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
      and pop the goal
"
   =goal>
      isa press-button
==>
  !output! ("~%pressed: button 1  correct button: ~S~%" (if (zerop *correct-button*) 'button-1 'button-2))

  !eval! (setf *act-r-button-press* 0)

  !pop!
)

(parameters choose-button-1 :r .5 :q 1.0 :a .2 :b 0)


(p choose-button-2
" 
   IF the goal is to press a button
   THEN press button 2
      and pop the goal
"
   =goal>
      isa press-button
==>
   !output! ("~%pressed: button 2  correct button: ~S~%" (if (zerop *correct-button*) 'button-1 'button-2))

   !eval! (setf *act-r-button-press* 1)

   !pop!
)

(parameters choose-button-2 :r .5 :q 1.0 :a .2 :b 0)