;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ACT-R model of the Building Sticks Task
;;;
;;; ACT-R version 4 required
;;; This model requires a patch that allows
;;; productions with PG-C < 0 to compete and fire.
;;; 
;;; A WWW interface and a command line interface
;;; are provided.  
;;; To run the command line version, call
;;; (do-bst-nodecay n)
;;; where n is the number of runs of the model

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Global variables

;;; ACT-R parameters set by the interfaces

(defvar *r-alpha-choose*)
(defvar *r-beta-choose*)
(defvar *r-alpha-force*)
(defvar *r-beta-force*)
(defvar *bst-g*)
(defvar *egs*)
(defvar *v*)
(defvar *s-per*) ;; s parameter for the noise in
                 ;; determination of stick length
(defvar *runs*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)

;;; the stimuli used in the experiment
;;; represented as (stick-a stick-b stick-c goal-stick)

(defparameter *bst-nodecay-test-stimuli* #2a((14  238  51  125)(20  202  42  102)
                             (15  210  49  117)(16  210  35  110)
                             (10  210  40  127)(10  179  32  105)
                             (15  185  22  115)(10  155  22  101)
                             (10  177  25  120)(17  171  31  128)))

(defparameter *bst-nodecay-solve-stimuli* 
  #3a(((20 213 42 104)(10 173 40 123)(18 205 52 101)
     (13 260 57 127)(15 156 29 112)(19 260 57 127)
     (15 239 51 117)(10 149 34 105)(21 228 39 111)
     (13 269 40 133)(19 174 28 118)(18 217 51 115)
     (12 229 33 111)(12 154 30 112)(23 238 47 121)
     (20 213 42 104)(10 173 40 123)(18 205 52 101)
     (13 260 57 127)(15 156 29 112)(19 260 57 127)
     (15 239 51 117)(10 149 34 105)(21 228 39 111)
     (13 269 40 133)(19 174 28 118)(18 217 51 115)
     (12 229 33 111)(12 154 30 112)(23 238 47 121))
    ((13 261 42 135)(10 173 40 123)(18 205 52 101)
     (13 260 57 127)(15 156 29 112)(19 260 57 127)
     (15 239 51 117)(10 149 34 105)(21 228 39 111)
     (19 213 43 108)(19 174 28 118)(18 217 51 115)
     (12 229 33 111)(12 154 30 112)(23 238 47 121)
     (13 261 42 135)(10 173 40 123)(18 205 52 101)
     (13 260 57 127)(15 156 29 112)(19 260 57 127)
     (15 239 51 117)(10 149 34 105)(21 228 39 111)
     (19 213 43 108)(19 174 28 118)(18 217 51 115)
     (12 229 33 111)(12 154 30 112)(23 238 47 121))))

#| Problems for U-biased and U-extreme-biased conditions
problems(5,1):= 12,148,35,117
problems(8,1):= 18,165,28,112
problems(11,1):= 25,140,43,111
problems(14,1):= 23,171,44,132
problems(17,1):= 20,162,33,119
problems(20,1):= 12,148,35,117
problems(23,1):= 18,165,28,112
problems(26,1):= 25,140,43,111
problems(29,1):= 23,171,44,132
problems(32,1):= 20,162,33,119

problems(4,1):= 28,136,37,102
problems(13,1):= 19,151,30,109
problems(19,1):= 28,136,37,102
problems(28,1):= 19,151,30,109
|#


;;; the strategy chosen by the model to use first
;;; on a given trial (set by the model)
;;; 0 for undershoot, 1 for overshoot

(defvar *strategy* nil)

;;; the model's recorded strategy choices from the test problems
;;; first index: condition 0=biased, 1=extreme-biased
;;; second index: test number 0=pre-experiment 1=after 30 problems 2=after 60 3=after 90
;;; third index: test problem type 0=strong bias against more successful strategy to 
;;;              4 = strong bias toward more successful strategy 
(defvar *bst-model-data*)


;;; data from the experiment
(defconstant *bst-nodecay-exper-data* 
  #3a(((18 13 43 77 70)(30 34 60 85 90)(33 38 75 90 85)(40 45 70 85 93))
      ((16  9 39 90 87)(50 37 63 89 94)(48 41 72 94 94)(57 61 78 94 80))))



(setf *r-alpha-choose* 10.68)  ;;11.36
(setf *r-beta-choose* .5)
(setf *r-alpha-force* .5)
(setf *r-beta-force* .5)
(setf *bst-g* 20.0)
(setf *egs* 8.17)
(setf *v* nil)
(setf *s-per* 2.5) ;; s parameter for the noise in
                    ;; determination of stick length
(setf *runs* 5)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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 "Building Sticks Task (no decay)" 2)
        (:table)

        (:table)
        "Perceptual Noise (s): " (:string :sy *s-per*          2.5)   (:new-row)
        "R-alpha choose: "     (:string :sy *r-alpha-choose* 10.68)  (:new-row)
        "R-beta choose: "      (:string :sy *r-beta-choose*  .5)     (:new-row)
        "R-alpha force: "      (:string :sy *r-alpha-force*  .5)     (:new-row)
        "R-beta force: "       (:string :sy *r-beta-force*   .5)     (:new-row)
        "Expected Gain Noise (t): "     (:string :sy *egs*     8.17)   (:new-row)
        "Number of runs (1-50): "     (:string :sy *runs*           20)
        (: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 *bst-g* 20)
        (:new-para)

        (:button "Show Experiment Results" "(display-bst-nodecay-results *bst-nodecay-exper-data* nil 1)")

        (:new-para)

        (:button "Run model" "(if (and (numberp *s-per*) (numberp *r-alpha-choose*)
                                       (numberp *r-beta-choose*) (numberp *r-alpha-force*)
                                       (numberp *r-beta-force*) (numberp *egs*)
                                       (numberp *runs*))
                                   (do-bst-nodecay (min 50 (max 1 *runs*)))
                                   (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 20 runs of the model"
        (:new-line)
        "- The trace of 1 run is approximatly 380k (240 pages) in size"
        (:new-para)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Functions to run the simulation

;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; bst-nodecay-noise-per takes one parameter q, the length of a stick
;;; and returns a value representing the lenght of the stick
;;; with the addition of noise, where the noise is a
;;; logistic distribution with s defined by *s-per*

(defun bst-nodecay-noise-per (q)
  (let* ((p (random 1.0))
         (r (- 1.0 p)))
    (if (or (zerop p) (zerop r))
      (bst-nodecay-noise-per q)
      (+ q (* *s-per* (log (/ p r)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; permute-bst-nodecay returns an array of size size that permutes
;;; the integers 0 through (size - 1).  This is used to
;;; create a random permutation of the solved problems.

(defun permute-bst-nodecay (size)
  (do ((ctr 0 ctr)
       (r (random size) r)
       (res (make-array (list size) :initial-element NIL)))
      ((equal ctr size) res)
    (if (null (aref res r)) (and (setf (aref res r) ctr)(incf ctr))
        (setq r (random size)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; set-bst-nodecay-params sets the parameters for the
;;; ACT-R model based on the values of the
;;; global variables

(defun set-bst-nodecay-params ()

  (sgp-fct (list :pl t
                 :era t
                 :cst t
                 :ct t
                 :g *bst-g*
                 :ut nil
                 :dat 0.0
                 :egs (/ *egs* (sqrt 2))  ;; value is set with a t value, and needs to be converted to an s
                 :v *v*))

  (parameters-fct 'decide-over
                  (list
                   :r-alpha *r-alpha-choose*
                   :r-beta *r-beta-choose*
                   :eventual-efforts 0.0))
  (parameters-fct 'decide-under
                  (list
                   :r-alpha *r-alpha-choose*
                   :r-beta *r-beta-choose*
                   :eventual-efforts 0.0))
  (parameters-fct 'force-over
                  (list
                   :r-alpha *r-alpha-force*
                   :r-beta *r-beta-force*
                   :eventual-efforts 0.0))
  (parameters-fct 'force-under
                  (list
                   :r-alpha *r-alpha-force*
                   :r-beta *r-beta-force*
                   :eventual-efforts 0.0)))

;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; bst-nodecay-exp-permute comes up with a permutation of 
;;; the trials similar to the way it was done for
;;; subjects in E3 of Lovett & Anderson (96).
;;; Every 3 problems are randomly permuted.

(defun bst-nodecay-exp-permute ()
  (let ((res))
    (setq res (permute-bst-nodecay 3))
    (do ((triple 1 (+ 1 triple)))
        ((equal triple 10) res)
      (setq res (concatenate 'vector res 
                             (mapcar (lambda (x) (+ x (* 3 triple))) (coerce (permute-bst-nodecay 3) 'list)))))))

;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; do-test-nodecay runs the model through the 10 test problem
;;; and puts the strategy-choice data in the global variable
;;; *bst-model-data* according to conditions cnd and block blk

(defun do-test-nodecay (cnd blk)
  (dotimes (testtrial 5)
    (dotimes (tprob 2)
      (setf *strategy* nil)
      (do-bst-nodecay-trial (aref *bst-nodecay-test-stimuli* (+ (* testtrial 2) tprob) 0)
                    (aref *bst-nodecay-test-stimuli* (+ (* testtrial 2) tprob) 1)
                    (aref *bst-nodecay-test-stimuli* (+ (* testtrial 2) tprob) 2)
                    (aref *bst-nodecay-test-stimuli* (+ (* testtrial 2) tprob) 3)
                    'test)
      (incf (aref *bst-model-data* cnd blk testtrial) *strategy*))))

;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; output-data-bst-nodecay prepares data in *bst-model-data* to be output by dividing
;;; by number of runs * 2 (bcs two test problems per entry in array)

(defun output-data-bst-nodecay (n)
    (dotimes (i 2)
      (dotimes (j 4)
        (dotimes (k 5)
          (setf (aref *bst-model-data* i j k) (* 100 (/ (aref *bst-model-data* i j k) (* 2.0 n)))))))
    (display-bst-nodecay-results *bst-model-data* t n)
    
)

;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; do-bst-nodecay takes one parameter n, and
;;; then runs n ACT-R simulations of the
;;; BST experiment (both conditions)
;;; and reports the number of times the
;;; more successful strategy was used for five
;;; categories of test stimuli

(defun do-bst-nodecay (n)
  (let ((prob nil)(prob-order nil))
    (setf *bst-model-data* (make-array '(2 4 5) :initial-element 0))
    (dotimes (condition 2)
      (dotimes (count n)
        (reset)
        (set-bst-nodecay-params)
        (do-test-nodecay condition 0)   
        (dotimes (block 3)
          (setq prob-order (bst-nodecay-exp-permute))
          (dotimes (trial 30)
            (setq prob (aref prob-order trial))
            (do-bst-nodecay-trial (aref *bst-nodecay-solve-stimuli* condition prob 0) 
                          (aref *bst-nodecay-solve-stimuli* condition prob 1)
                          (aref *bst-nodecay-solve-stimuli* condition prob 2)
                          (aref *bst-nodecay-solve-stimuli* condition prob 3)
                          'solve))
          (do-test-nodecay condition (+ 1 block)))))
    (output-data-bst-nodecay n)))
           

(defun display-bst-nodecay-results (data simulation runs)
  (when simulation
    (format *standard-output* "~%~%Parameters for run: (~S ~S ~S ~S ~S ~S ~S)~%"
            *s-per* *r-alpha-choose* *r-beta-choose* *r-alpha-force* *r-beta-force* *egs* runs))
  
  (when *text*
    (format *standard-output* "~%~%~a percentage choice more successful strategy~%" (if simulation "Model's" "Observed"))
    (format *standard-output*   "~%           |         |      Test problem types")
    (format *standard-output*   "~%Condition  |  Test   |   1     2     3     4     5~%")
    (format *standard-output*     "----------------------------------------------------~%")
    (dotimes (i 2)
      (format *standard-output* "~a " (if (zerop i) "biased     |" "ext-biased |"))
      (dotimes (j 4)
        (format *standard-output*  "~a" (if (zerop j) "  " "           |   "))
        (format *standard-output* "  ~3s  | " j)
        (dotimes (k 5)
          (format *standard-output* "~3,1f  " (aref data i j k)))
        (format *standard-output* "~%")))
    (format *standard-output* "~%")

    (when (and *overlay* simulation)
      (format *standard-output* "~%~%Observed percentage choice more successful strategy~%")
      (format *standard-output*   "~%           |         |      Test problem types")
      (format *standard-output*   "~%Condition  |  Test   |   1     2     3     4     5~%")
      (format *standard-output*     "----------------------------------------------------~%")
      (dotimes (i 2)
        (format *standard-output* "~a " (if (zerop i) "biased     |" "ext-biased |"))
        (dotimes (j 4)
          (format *standard-output*  "~a" (if (zerop j) "  " "           |   "))
          (format *standard-output* "  ~3s  | " j)
          (dotimes (k 5)
            (format *standard-output* "~3,1f  " (aref *bst-nodecay-exper-data* i j k)))
          (format *standard-output* "~%")))
      (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 = 600
        height = 600>

        <PARAM name=\"title\" value=\"Biased\">
        <PARAM name=\"longestline\" value=\"5\">
        <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=\"yspacing\" value=\"0.2\">
        <PARAM name=\"numxlabels\" value=\"5\">
        <PARAM name=\"xlabels\" value=\"High Against;Low Against;Neutral;Low Toward;High Toward;\">
        <PARAM name=\"widestxlabel\" value=\"WWWWWWWWWWWW\">
       
        <PARAM name=\"xval0\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval1\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval2\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xname\" value=\"Test problem bias\">
        <PARAM name=\"yname\" value=\"p choose more successful\">
        <PARAM name=\"name0\" value=\"~a before training problems\">
        <PARAM name=\"name1\" value=\"~a after 30 training problems\">
        <PARAM name=\"name2\" value=\"~a after 90 training problems\">
        <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\">
     "
            (if (and simulation *overlay*) 6 3)
            (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))

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

    (dotimes (i 5)
      (format *standard-output* "~5,3f;" (/ (aref data 0 0 i) 100)))

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

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

    (dotimes (i 5)
      (format *standard-output* "~5,3f;" (/ (aref data 0 1 i) 100)))

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

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

    (dotimes (i 5)
      (format *standard-output* "~5,3f;" (/ (aref data 0 3 i) 100)))

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

    

    (when (and *overlay* simulation)
      (format *standard-output* "
        <PARAM name=\"xval3\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval4\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval5\" value=\"0;1;2;3;4;\">
        <PARAM name=\"name3\" value=\"Experiment Data before training problems\">
        <PARAM name=\"name4\" value=\"Experiment Data after 30 training problems\">
        <PARAM name=\"name5\" value=\"Experiment Data after 90 training problems\">
        <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=\"yval3\" value=\"")
      
      (dotimes (i 5)
        (format *standard-output* "~5,3f;" (/ (aref *bst-nodecay-exper-data* 0 0 i) 100)))
      
      (format *standard-output* "\">")

      (format *standard-output* "<PARAM name=\"yval4\" value=\"")
      
      (dotimes (i 5)
        (format *standard-output* "~5,3f;" (/ (aref *bst-nodecay-exper-data* 0 1 i) 100)))
      
      (format *standard-output* "\">")
      
      (format *standard-output* "<PARAM name=\"yval5\" value=\"")
      
      (dotimes (i 5)
        (format *standard-output* "~5,3f;" (/ (aref *bst-nodecay-exper-data* 0 3 i) 100)))
      
      (format *standard-output* "\">"))



    (format *standard-output* "
        </applet>
        <applet
        code = \"DansGraphs.class\"
        width = 600
        height = 600>

        <PARAM name=\"title\" value=\"Extreme-Biased\">
        <PARAM name=\"longestline\" value=\"5\">
        <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=\"yspacing\" value=\"0.2\">
        <PARAM name=\"numxlabels\" value=\"5\">
        <PARAM name=\"xlabels\" value=\"High Against;Low Against;Neutral;Low Toward;High Toward;\">
        <PARAM name=\"widestxlabel\" value=\"WWWWWWWWWWWW\">
       
        <PARAM name=\"xval0\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval1\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval2\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xname\" value=\"Test problem bias\">
        <PARAM name=\"yname\" value=\"p choose more successful\">
        <PARAM name=\"name0\" value=\"~a before training problems\">
        <PARAM name=\"name1\" value=\"~a after 30 training problems\">
        <PARAM name=\"name2\" value=\"~a after 90 training problems\">
        <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\">

     "
            (if (and simulation *overlay*) 6 3)
            (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))

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

    (dotimes (i 5)
      (format *standard-output* "~5,3f;" (/ (aref data 1 0 i) 100)))

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

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

    (dotimes (i 5)
      (format *standard-output* "~5,3f;" (/ (aref data 1 1 i) 100)))

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

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

    (dotimes (i 5)
      (format *standard-output* "~5,3f;" (/ (aref data 1 3 i) 100)))

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

    

    (when (and *overlay* simulation)
      (format *standard-output* "
        <PARAM name=\"xval3\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval4\" value=\"0;1;2;3;4;\">
        <PARAM name=\"xval5\" value=\"0;1;2;3;4;\">
        <PARAM name=\"name3\" value=\"Experiment Data before training problems\">
        <PARAM name=\"name4\" value=\"Experiment Data after 30 training problems\">
        <PARAM name=\"name5\" value=\"Experiment Data after 90 training problems\">
        <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=\"yval3\" value=\"")
      
      (dotimes (i 5)
        (format *standard-output* "~5,3f;" (/ (aref *bst-nodecay-exper-data* 1 0 i) 100)))
      
      (format *standard-output* "\">")

      (format *standard-output* "<PARAM name=\"yval4\" value=\"")
      
      (dotimes (i 5)
        (format *standard-output* "~5,3f;" (/ (aref *bst-nodecay-exper-data* 1 1 i) 100)))
      
      (format *standard-output* "\">")
      
      (format *standard-output* "<PARAM name=\"yval5\" value=\"")
      
      (dotimes (i 5)
        (format *standard-output* "~5,3f;" (/ (aref *bst-nodecay-exper-data* 1 3 i) 100)))
      
      (format *standard-output* "\">"))




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


)

;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; do-bst-nodecay-trial takes 4 parameters a,b,c, and g
;;; it sets the goal of the model to solve a
;;; BST problem with sticks of length a, b, and c
;;; and a goal length of g, and runs the model

(defun do-bst-nodecay-trial (a b c g tst)
  (modwme-fct 'goal (list 'a a 'b b 'c c 'goal g 'current 0 'over nil 'under nil 'test tst))
  (goal-focus goal)
  (run))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;;
;;; The ACT-R model

(clearall)

; default parameters

(sgp :era t  :egs 5.78 :pl t :ut nil :v nil :g 20.0 :dat 0.0 :cst t )

(chunk-type waterjug
"
 a chunk type to specify a goal to
 solve a waterjug type problem (the bst)
  slots:
     a,b,c,goal - lengths of the sticks
     current - length of the stick being constructed
     over - holds the estimated length difference between
            the longest stick and the goal or
            t once the overshoot strategy has been tried
     under - holds the estimated length difference between
            the longest stick shorter than the goal and the goal or
            t once the overshoot strategy has been tried
     test - t if test problem (there will be no success/failure)
"
 a b c goal current over under test)

(chunk-type try-strategy
"
 a chunk type to specify a goal of
 trying a particular strategy in solving a
 bst task
  slots:
     strategy - contains the strategy being used (OVER or UNDER)
     current - length of the stick being constructed
     over - holds the estimated length difference between
            the longest stick and the goal or
            t once the overshoot strategy has been tried
     under - holds the estimated length difference between
            the longest stick shorter than the goal and the goal or
            t once the overshoot strategy has been tried
"
 strategy a b c goal current over under test)

(set-dm (goal isa waterjug a 15 b 250 c 55 goal 125 current 0))

(goal-focus goal)

(p ENCODE
"
   IF the goal is to solve a waterjug problem and the distances to the
      goal have not been determined
   THEN estimate the distances to the goal
      and push a subgoal to try a strategy for the current problem
      configuration
"
   =GOAL>
       isa WATERJUG
       a =A
       b =B
       c =C
       goal =G
       under nil
       over nil
       test =test
==>
   =NEWGOAL>
       isa TRY-STRATEGY
       strategy nil
       a =A
       b =B
       c =C
       goal =G
       current 0
       under (!eval! (bst-nodecay-noise-per (- =g =c)))
       over (!eval! (bst-nodecay-noise-per (- =b =g)))
       current =NEWCURRENT
       over =NEWOVER
       under =NEWUNDER
       test =test

   =GOAL>
       current =NEWCURRENT
       over =NEWOVER
       under =NEWUNDER

   !push! =NEWGOAL)

(parameters encode  :r-alpha 900 :r-beta 100 :eventual-efforts 0.0)

(p FORCE-OVER
"
   IF the goal is to try a strategy
      and no strategy has been chosen
      and the over shoot strategy has not been chosen before
   THEN mark the current strategy as over shoot in the goal
"
   =GOAL>
       isa TRY-STRATEGY
       strategy nil
       a =A1
       b =B1
       c =C1
       goal =G1
       current 0
     - over t
==>
   !eval! (when (null *strategy*) (setf *strategy* 1))

    =GOAL>
       strategy OVER
       over t
       current nil

    !output! ("~%force over~%"))


(p FORCE-UNDER
"
   IF the goal is to try a strategy
      and no strategy has been chosen
      and the under shoot strategy has not been chosen before
   THEN mark the current strategy as under shoot in the goal
"
   =GOAL>
       isa TRY-STRATEGY
       a =A1
       b =B1
       c =C1
       goal =G1
       current 0
     - under t
==>
   !eval! (when (null *strategy*) (setf *strategy* 0))

   =GOAL>
       strategy UNDER
       current nil
       under t

   !output! ("~%force under~%"))


(p DECIDE-UNDER
"
   IF the goal is to try a strategy
      and no strategy has been chosen before
      and the under shoot strategy gets closer to the goal
   THEN mark the current strategy as under shoot in the goal
"
   =GOAL>
       isa TRY-STRATEGY
       a =A1
       b =B1
       c =C1
       goal =G1
       current 0
     - under t
     - over t
       over =O
       under =U

   !eval! (>= =O =U)
==>
   !eval! (when (null *strategy*) (setf *strategy* 0))

   =GOAL>
       strategy UNDER
       current nil
       under t

       !output! ("~%decide under~%"))


(p DECIDE-OVER
"
   IF the goal is to try a strategy
      and no strategy has been chosen before
      and the over shoot strategy gets closer to the goal
   THEN mark the current strategy as over shoot in the goal
"
   =GOAL>
       isa TRY-STRATEGY
       a =A1
       b =B1
       c =C1
       goal =G1
       current 0
     - over t
     - under t
       under =U
       over =O

   !eval! (>= =U =O)
==>
   !eval! (when (null *strategy*) (setf *strategy* 1))

   =GOAL>
       strategy OVER
       current nil
       over t

   !output! ("~%decide over~%"))


(p encode-OVER
"
   IF the goal is to try a strategy
      and the current strategy is over shoot
   THEN mark the starting stick length as the longest stick
"
   =GOAL>
       isa TRY-STRATEGY
       strategy OVER
       current nil
       b =B
       test solve
==>
   =GOAL>
       current =B)

(parameters encode-over  :r-alpha 900 :r-beta 100 :eventual-efforts 0.0)

(p encode-UNDER
"
   IF the goal is to try a strategy
      and the current strategy is under shoot
   THEN mark the starting stick length as the longest stick
        shorter than the goal
"
   =GOAL>
       isa TRY-STRATEGY
       strategy UNDER
       current nil
       c =C
       test solve
==>
   =GOAL>
       current =C)

(parameters encode-under  :r-alpha 900 :r-beta 100 :eventual-efforts 0.0)

(p SUBTRACT-A
"
  IF the goal is to try a strategy
      and the strategy is over shoot
      and the current stick length is greater than the goal
      and stick c takes away too much
  THEN subtract stick a from the current stick
"
   =GOAL>
       isa TRY-STRATEGY
       strategy OVER
       current =CUR
     - current nil
       goal =G
       a =A
       c =C

   !eval! (> =C (- =CUR =G))

   !eval! (< =G =CUR)
==>
   =GOAL>
       current (!eval! (- =CUR =A)))


(p SUBTRACT-C
"
  IF the goal is to try a strategy
      and the strategy is over shoot
      and the current stick length is greater than the goal
      and stick c is less than or equal to the difference
  THEN subtract stick c from the current stick
"
   =GOAL>
       isa TRY-STRATEGY
       strategy OVER
       current =CUR
     - current nil
       goal =G
       c =C

   !eval! (<= =C (- =CUR =G))

   !eval! (< =G =CUR)
==>
   =GOAL>
       current (!eval! (- =CUR =C)))


(p ADD-A
"
  IF the goal is to try a strategy
      and the strategy is under shoot
      and the current stick length is less than the goal
      and stick c adds too much
  THEN add stick a to the current stick
"
   =GOAL>
       isa TRY-STRATEGY
       strategy UNDER
       current =CUR
     - current nil
       goal =G
       a =A
       c =C

   !eval! (> =C (- =G =CUR))

   !eval! (> =G =CUR)
==>
     =GOAL>
         current (!eval! (+ =CUR =A)))


(p ADD-C
"
  IF the goal is to try a strategy
      and the strategy is under shoot
      and the current stick length is less than the goal
      and stick c is less than or equal to the difference
  THEN add stick c to the current stick
"
   =GOAL>
       isa TRY-STRATEGY
       strategy UNDER
       current =CUR
     - current nil
       goal =G
       c =C

   !eval! (<= =C (- =G =CUR))

   !eval! (> =G =CUR)
==>
   =GOAL>
       current (!eval! (+ =CUR =C)))

(spp (subtract-a subtract-c add-a add-c) :r-alpha 900 :r-beta 100  :eventual-efforts 0.0)

(p FAIL-UNDER
"
   IF the goal is to try a strategy
      and the strategy is under shoot
      and the current stick is larger than the goal
   THEN mark the current length as nil to signify failure
      and pop the current goal
"
   =GOAL>
       isa TRY-STRATEGY
       strategy UNDER
       current =CUR
     - current nil
       goal =G

   !eval! (< =G =CUR)
==>
   =GOAL>
       current nil

   !pop!)

(spp fail-under :r-alpha 900 :r-beta 100  :eventual-efforts 0.0 :failure t)

(p FAIL-OVER
"
   IF the goal is to try a strategy
      and the strategy is over shoot
      and the current stick is shorter than the goal
   THEN mark the current length as nil to signify failure
      and pop the current goal
"
   =GOAL>
       isa TRY-STRATEGY
       strategy OVER
       current =CUR
     - current nil
       goal =G

   !eval! (> =G =CUR)
==>
   =GOAL>
       current nil

   !pop!)

(spp fail-over  :r-alpha 900 :r-beta 100 :eventual-efforts 0.0 :failure t)

(p SUCCEED
"
   IF the goal is to try a strategy
     and the current stick is the same length as the goal
   THEN pop the current goal to signify the end of
     this strategy
"
   =GOAL>
       isa TRY-STRATEGY
       current =CUR
       strategy =S
     - current nil
       goal =G

   !eval! (equal =G =CUR)
==>
   !pop!)

(parameters succeed  :r-alpha 900 :r-beta 100 :eventual-efforts 0.0 :success t)


(p TRY-AGAIN
"
   IF the current goal is to solve a waterjug problem
      and there is no current length
      and the distances to the goal have been measured
   THEN create and push a subgoal to try a strategy
      using the current set of sticks, and goal
      distance calculations
"
   =GOAL>
       isa WATERJUG
       a =A
       b =B
       c =C
       goal =G
       under =U
       over =O
       current nil
       test solve
==>
   =NEWGOAL>
       isa TRY-STRATEGY
       strategy nil
       a =A
       b =B
       c =C
       goal =G
       current 0
       under =U
       over =O
       current =NEWCURRENT
       test solve
   =GOAL>
       current =NEWCURRENT

  !push! =NEWGOAL)

(parameters try-again :failure t  :r-alpha 900 :r-beta 0 :eventual-efforts 0.0)

(p SUCCEED-WATERJUG
"
   IF the goal is to solve a waterjug problem
     and the current stick is the same length as the goal stick
   THEN pop the goal to signify the end of this problem
"
   =GOAL>
       isa WATERJUG
       current =CUR
       goal =CUR
==>
   !pop!)

(parameters succeed-waterjug  :r-alpha 900 :r-beta 0 :eventual-efforts 0.0)

(p FAIL-WATERJUG
"
   IF the goal is to solve a waterjug problem
     and the current stick is not the same length as the goal stick
     and both under shoot and over shoot have been tried
   THEN pop the goal to signify the end of this problem
"
   =GOAL>
       isa WATERJUG
       current =CUR
     - current nil
     - goal =CUR
       over t
       under t
==>
  !pop!)

(parameters fail-waterjug  :r-alpha 900 :r-beta 100 :eventual-efforts 0.0)

(spp :chance 1.0)


(p CLEAR-TEST
"
   IF the current problem is a test problem and the first move has
      been decided
   THEN pop the goal (without any s/f info)
        (bcs the interface has taken the problem away)
"
   =GOAL>
      isa TRY-STRATEGY
      strategy =STRATEGY
      current nil
      test test
==>
   !pop!)
(spp clear-test :success t :failure t
     :references 100
     :successes 100
     :failures 0
     :eventual-successes 100
     :eventual-failures 0
     :efforts 0.0
     :eventual-efforts 0.0)

(p CLEAR-TEST-TOP
"
   IF the current problem is a test problem and the first move has
      been decided
   THEN pop the goal (without any s/f info)
        (bcs the interface has taken the problem away)
"
   =GOAL>
      isa WATERJUG
    - current 0
      over =over
      under =under
      test test
==>
   !pop!)
(spp clear-test-top :success t :failure t
     :references 100
     :successes 100
     :failures 0
     :eventual-successes 100
     :eventual-failures 0
     :efforts 0.0
     :eventual-efforts 0.0)

(spp (clear-test clear-test-top)  :r-alpha 900 :r-beta 100 :eventual-efforts 0.0)