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


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 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-decay n)
;;; where n is the number of runs of the model

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

;;; ACT-R parameters set by the interfaces

(defvar *egs*)
(defvar *v*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)

(defvar *runs*)

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

(defparameter *bst-decay-solve-stimuli*
  #3a((
(9  178  32  105)(4  210  40  126)(9  179  32  105)(4  210  40  126)
(9  179  32  105)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(4  210  40  126)(9  179  32  105)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(4  210  40  126)(9  179  32  105)(4  210  40  126)
(4  210  40  126)(4  210  40  126)(9  179  32  105)(4  210  40  126)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(4  210  40  126)
(9  179  32  105)(4  210  40  126)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(9  179  32  105)(4  210  40  126))
(
(9  178  32  105)(4  210  40  126)(9  179  32  105)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(9  179  32  105)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(9  179  32  105)(9  179  32  105)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(9  179  32  105)
(9  179  32  105)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(9  179  32  105)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(9  179  32  105)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(9  179  32  105)(4  210  40  126)(9  179  32  105)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(9  179  32  105)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(9  179  32  105)(4  210  40  126)(4  210  40  126)
(9  179  32  105)(9  179  32  105)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(9  179  32  105)(9  179  32  105)
(4  210  40  126)(4  210  40  126)(4  210  40  126)(9  179  32  105)
(4  210  40  126)(9  179  32  105)
)))

;;; 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)
(defvar *strategy-worked* nil)
(defvar *last-strategy* nil)

;;; the model's recorded strategy choices from the solved problems
;;; first index: condition 0=80% overshoot, 1=60% overshoot
;;; second index: problem number = [0 - 89]
(defvar *bst-model-data*)
(setf *bst-model-data* (make-array '(2 90) :initial-element 0))
(defvar *bst-model-agg*)
(setf *bst-model-agg* (make-array '(2 6) :initial-element 0))
(defvar *bst-cond-probs*)
(setf *bst-cond-probs* (make-array '(2 2 2) :initial-element 0))

;;; data from the experiment: choice prefs across 6 blocks and conditional probabilities
(defparameter *bst-decay-exper-data*
  #2a((.62 .78 .75 .83 .85 .86)(.55 .58 .60 .65 .54 .61)))
(defparameter *bst-decay-cp-exper-data*
  #3a(((.36 .64)(.17 .83))((.45 .55)(.40 .60))))


(setf *egs* 0.24)
(setf *v* nil)
(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 (with decay) Task" 2)
        (:table)

        (:table)
       "Expected Gain Noise (t): "     (:string :sy *egs*     0.24)   (:new-row)
        "Number of runs (1-10): "     (:string :sy *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-data-bst-decay *bst-decay-exper-data* *bst-decay-cp-exper-data* 1 nil)")

        (:new-para)

        (:button "Run model" "(if (and  (numberp *egs*)
                                       (numberp *runs*))
                                   (do-bst-decay (min 10 (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 2 minutes for 1 run of the model"
        (:new-line)
        "- The trace of 1 run is approximatly 350k (250 pages) in size"
        (:new-para)))

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

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

(defun set-bst-decay-params ()

  ;;; *egs* is set using t, so needs to be converted to an s value

  (sgp-fct (list :era t :egs (/ *egs* (sqrt 2)) :pl 0.714 :ol nil :ut nil :g 2.5 :ct t :v *v*))


  (spp-fct (list 'force-over
                 :creation-time -100.0
                 :successes (make-list 562 :initial-element -100.0)
                 :failures 0
                 :eventual-successes (make-list 281 :initial-element -100.0)
                 :eventual-failures (make-list 281 :initial-element -100.0)))
  (spp-fct (list 'force-under
                 :creation-time -100.0
                 :successes (make-list 562 :initial-element -100.0)
                 :failures 0
                 :eventual-successes (make-list 281 :initial-element -100.0)
                 :eventual-failures (make-list 281 :initial-element -100.0)))

)

;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; output-data-bst-decay prepares data in *bst-model-data* to be output by dividing
;;; by number of runs * 15 (bcs we're aggregating performance in 15-trial blocks)

(defun output-data-bst-decay (n)
    (dotimes (i 2)
      (dotimes (j 6)
        (dotimes (k 15)
          (incf (aref *bst-model-agg* i j) (aref *bst-model-data* i (+ (* j 15) k))))
        (setf (aref *bst-model-agg* i j) (/  (aref *bst-model-agg* i j)(* n 15.0)))))
    ;(display-bst-decay-results *bst-model-agg* t n)
    (dotimes (k 2)
      (dotimes (i 2)
        (dotimes (j 2)
          (setf (aref *bst-cond-probs* k i j) (/ (aref *bst-cond-probs* k i j) (* 1.0 n))))))
    ;(display-bst-decay-condprobs *bst-cond-probs* t)
    (display-data-bst-decay *bst-model-agg* *bst-cond-probs* n t)
)

;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; do-bst-decay takes one parameter n, and
;;; then runs n ACT-R simulations of the
;;; BST experiment (both conditions)
;;; and reports the percentage of times the
;;; more successful strategy was used for
;;; each block of 15 problems

(defun do-bst-decay (n)
  (setf *bst-model-data* (make-array '(2 90) :initial-element 0))
  (setf *bst-model-agg* (make-array '(2 6) :initial-element 0))
    (dotimes (count n)
      (dotimes (condition 2)
        (reset)
        (set-bst-decay-params)
          (setf *last-strategy* nil)
          (dotimes (trial 90)

            (setf *strategy* nil)
            (setf *strategy-worked* nil)
            (do-bst-decay-trial (aref *bst-decay-solve-stimuli* condition trial 0)
                          (aref *bst-decay-solve-stimuli* condition trial 1)
                          (aref *bst-decay-solve-stimuli* condition trial 2)
                          (aref *bst-decay-solve-stimuli* condition trial 3))
            (incf (aref *bst-model-data* condition trial) *strategy*)
            (when *last-strategy* (incf (aref *bst-cond-probs* condition *last-strategy* *strategy*) 1))
            (setf *last-strategy* (if (equal 'over *strategy-worked*) 1 0)))))
    (output-data-bst-decay n))

(defun display-bst-decay-results (data simulation runs)
  


    (format *standard-output* "~%~%~a percentage choice more successful strategy~%" (if simulation "Model's" "Observed"))
    (format *standard-output*   "             |           Block Number")
    (format *standard-output*   "~%Condition    |  1     2    3    4    5    6~%")
    (format *standard-output*     "-----------------------------------------------")
    (dotimes (i 2)
      (format *standard-output* "~%~a " (if (zerop i) "extreme      |" "less extreme |"))
      (dotimes (j 6)
          (format *standard-output* "~3,2f  " (aref data i j)))))

(defun display-bst-decay-condprobs (data simulation)
  (format *standard-output* "~%~%~%~a conditional probabilities~%" (if simulation "Model's" "Observed"))
  (format *standard-output*       "              P(MS|LS)   P(MS|MS) ")
  (format *standard-output*       "~%              -------------------")
  (dotimes (j 2)  
    (format *standard-output* "~%~a " (if (zerop j) "extreme     " "less extreme"))
    (dotimes (i 2)
      (format *standard-output* "   ~3,2f       " (/ (* 1.0 (aref data j i 1))
                                                     (+ (aref data j i 0)(aref data j i 1))))))
  (format *standard-output* "~%~%P(MS|LS) = P(more successful strategy chosen given less successful solved previous problem)")
  (format *standard-output*   "~%P(MS|MS) = P(more successful strategy chosen given more successful solved previous problem)~%~%")
)

(defun display-data-bst-decay (choice condprob runs sim)
  (when sim
    (format *standard-output* "~%~%Parameters for run: (~S ~S)~%"
            *egs* runs))

  (when *text*
    (display-bst-decay-results choice sim runs)
    
    (when (and sim *overlay*)
      (display-bst-decay-results *bst-decay-exper-data* nil 1))
    
    (display-bst-decay-condprobs condprob sim)
    
    (when (and sim *overlay*)
      (display-bst-decay-condprobs *bst-decay-cp-exper-data* nil))
    
    (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 = 500> 

        <PARAM name=\"title\" value=\"Data for Building Stick Task (decay model)\">
        <PARAM name=\"longestline\" value=\"6\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"7\">
        <PARAM name=\"ymax\" value=\"1.0\">
        <PARAM name=\"ymin\" value=\".2\">
        <PARAM name=\"numxlabels\" value=\"8\">
        <PARAM name=\"xlabels\" value=\"1;2;3;4;5;6;P(MS|LS);P(MS|MS);\">
        <PARAM name=\"widestxlabel\" value=\"WWWWWWWW\">
        <PARAM name=\"ydiv\" value=\".1\">
        <PARAM name=\"yspacing\" value=\".2\">
        <PARAM name=\"xval0\" value=\"0;1;2;3;4;5;\">
        <PARAM name=\"xval1\" value=\"0;1;2;3;4;5;\">
        <PARAM name=\"xval2\" value=\"6;7;\">
        <PARAM name=\"xval3\" value=\"6;7;\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lcolor1\" value=\"1\">
        <PARAM name=\"lcolor2\" value=\"0\">
        <PARAM name=\"lcolor3\" value=\"1\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"lstyle1\" value=\"~s\">
        <PARAM name=\"lstyle2\" value=\"~s\">
        <PARAM name=\"lstyle3\" value=\"~s\">
        <PARAM name=\"name0\" value=\"~a choice more successful (extreme)\">
        <PARAM name=\"name1\" value=\"~a choice more successful (less extreme)\">
        <PARAM name=\"xname\" value=\"Block number\">
        <PARAM name=\"yname\" value=\"Probability\">"
            (if (and sim *overlay*) 8 4)
            (if sim 2 6553)
            (if sim 2 6553)
            (if sim 2 6553)
            (if sim 2 6553)
            (if sim "Model's" "Observed")(if sim "Model's" "Observed"))



    (dotimes (i 2)
      (format *standard-output* "<PARAM name=\"yval~s\" value=\"" i)
      (dotimes (j 6)
        (format *standard-output* "~3,2f;" (aref choice i j)))
      (format *standard-output* "\">"))

    (format *standard-output* "
                 <PARAM name=\"yval2\" value=\"~4,2f;~4,2f;\">
                 <PARAM name=\"yval3\" value=\"~4,2f;~4,2f;\">"
                 (/ (* 1.0 (aref condprob 0 0 1)) (+ (aref condprob 0 0 0)(aref condprob 0 0 1)))
                 (/ (* 1.0 (aref condprob 0 1 1)) (+ (aref condprob 0 1 0)(aref condprob 0 1 1)))
                 (/ (* 1.0 (aref condprob 1 0 1)) (+ (aref condprob 1 0 0)(aref condprob 1 0 1)))
                 (/ (* 1.0 (aref condprob 1 1 1)) (+ (aref condprob 1 1 0)(aref condprob 1 1 1))))

    (when (and sim *overlay*)
      
      (format *standard-output*
       "<PARAM name=\"xval4\" value=\"0;1;2;3;4;5;\">
        <PARAM name=\"xval5\" value=\"0;1;2;3;4;5;\">
        <PARAM name=\"xval6\" value=\"6;7;\">
        <PARAM name=\"xval7\" value=\"6;7;\">
        <PARAM name=\"lcolor4\" value=\"0\">
        <PARAM name=\"lcolor5\" value=\"1\">
        <PARAM name=\"lcolor6\" value=\"0\">
        <PARAM name=\"lcolor7\" value=\"1\">
        <PARAM name=\"lstyle4\" value=\"6553\">
        <PARAM name=\"lstyle5\" value=\"6553\">
        <PARAM name=\"lstyle6\" value=\"6553\">
        <PARAM name=\"lstyle7\" value=\"6553\">
        <PARAM name=\"name4\" value=\"Observed choice more successful (extreme)\">
        <PARAM name=\"name5\" value=\"Observed choice more successful (less extreme)\">")
        
      (dotimes (i 2)
      (format *standard-output* "<PARAM name=\"yval~s\" value=\"" (+ i 4))
      (dotimes (j 6)
        (format *standard-output* "~3,2f;" (aref *bst-decay-exper-data* i j)))
      (format *standard-output* "\">"))

    (format *standard-output* "
                 <PARAM name=\"yval6\" value=\"~4,2f;~4,2f;\">
                 <PARAM name=\"yval7\" value=\"~4,2f;~4,2f;\">"
                 (/ (* 1.0 (aref *bst-decay-cp-exper-data* 0 0 1)) (+ (aref *bst-decay-cp-exper-data* 0 0 0)(aref *bst-decay-cp-exper-data* 0 0 1)))
                 (/ (* 1.0 (aref *bst-decay-cp-exper-data* 0 1 1)) (+ (aref *bst-decay-cp-exper-data* 0 1 0)(aref *bst-decay-cp-exper-data* 0 1 1)))
                 (/ (* 1.0 (aref *bst-decay-cp-exper-data* 1 0 1)) (+ (aref *bst-decay-cp-exper-data* 1 0 0)(aref *bst-decay-cp-exper-data* 1 0 1)))
                 (/ (* 1.0 (aref *bst-decay-cp-exper-data* 1 1 1)) (+ (aref *bst-decay-cp-exper-data* 1 1 0)(aref *bst-decay-cp-exper-data* 1 1 1)))))
      
        


    (format *standard-output* "
             <HR> Either your browser does not support JAVA or this graph has scrolled off the top of the display.~%
             </HR></applet>")))


;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; do-bst-decay-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-decay-trial (a b c g)
  (modwme-fct 'goal (list 'a a 'b b 'c c 'goal g 'current 0 'over nil 'under nil))
  (goal-focus goal)
  (run))

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The ACT-R model

(clearall)

; default parameters
; note: utility threshold is set to nil so that productions with PG-C<0 can fire
;       G value is 2.5 for the top level goal.  This value is reduced at the subgoal level where undershoot/overshoot compete.
;       optimized learning is turned off so that exact decay of production parameters can be calculated
(sgp :era t :egs 0.17 :pl 0.714 :ol nil :ut nil :g 2.5 :cst t :v nil)

(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 - t once the overshoot strategy has been tried
     under - t once the overshoot strategy has been tried
"
 a b c goal current over under)

(chunk-type try-strategy
"
 a chunk type to specify a goal of
 trying a particular strategy in solving a
 bst task
  slots:
     strategy - current strategy being attempted
     current - length of the stick being constructed
     over - t once the overshoot strategy has been tried
     under - t once the overshoot strategy has been tried
"
 strategy a b c goal current over under)

(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...
   THEN push a subgoal to try a strategy for the current problem
"
   =GOAL>
       isa WATERJUG
       a =A
       b =B
       c =C
       goal =G
       current 0
       under nil
       over nil
==>
   =NEWGOAL>
       isa TRY-STRATEGY
       a =A
       b =B
       c =C
       goal =G
       current 0
       current =NEWCURRENT
       over =NEWOVER
       under =NEWUNDER

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

   !push! =NEWGOAL)

(p TRY-AGAIN-OVER
"
   IF the goal is to solve a waterjug problem
      and a previous attempt has failed (current = nil)
      and undershoot has been tried
   THEN push a subgoal to try a strategy for the current problem
"
   =GOAL>
       isa WATERJUG
       a =A
       b =B
       c =C
       goal =G
       current nil
       under t
       over nil
==>
   =NEWGOAL>
       isa TRY-STRATEGY
       a =A
       b =B
       c =C
       goal =G
       current 0
       current =NEWCURRENT
       under t
       over nil
       over =NEWOVER
       under =NEWUNDER

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

   !push! =NEWGOAL)

(p TRY-AGAIN-UNDER
"
   IF the goal is to solve a waterjug problem
      and a previous attempt has failed (current = nil)
      and overshoot has been tried
   THEN push a subgoal to try a strategy for the current problem
"
   =GOAL>
       isa WATERJUG
       a =A
       b =B
       c =C
       goal =G
       current nil
       under nil
       over t
==>
   =NEWGOAL>
       isa TRY-STRATEGY
       a =A
       b =B
       c =C
       goal =G
       current 0
       current =NEWCURRENT
       under nil
       over t
       over =NEWOVER
       under =NEWUNDER

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

   !push! =NEWGOAL)


(p FORCE-OVER
"
   IF the goal is to try a strategy
      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
       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 =B1

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

(p FORCE-UNDER
"
   IF the goal is to try a strategy
      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
       under t
       current =C1

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

(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 0
       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 0
       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 0
       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 0
       goal =G
       c =C

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

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

(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
       goal =G

   !eval! (< =G =CUR)
==>
   =goal>
       current nil
    !pop!
)

(spp fail-under
: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 0
       goal =G

   !eval! (> =G =CUR)
==>
   =goal>
       current nil
   !pop!
)

(spp fail-over
:failure t)

(p SUCCEED-STRATEGY
"
   IF the goal is to try a strategy
     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 TRY-STRATEGY
       strategy =STRAT
       current =CUR
       goal =CUR
==>
   !eval! (when (null *strategy-worked*) (setf *strategy-worked* (get-wme-name =strat)))

   !pop!)

(spp succeed-strategy
:success t)

(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!)

(spp succeed-waterjug
:success t)

(p FAIL-WATERJUG
"
   IF the goal is to solve a waterjug problem...
   THEN push a subgoal to try a strategy for the current problem
"
   =GOAL>
       isa WATERJUG
       current nil
       under t
       over t
==>
   !pop!)

(spp fail-waterjug
:failure t)