;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; Initial ACT-R Production System for Stick Building Task
;;;;;                Marsha Lovett 2/10/93
;;;;;
;;;;; Note: the production rules in this model were designed
;;;;;   to be used under ACT-R 2.0.  The main feature of 2.0
;;;;;   (that is not present in the latest version of ACT-R)
;;;;;   that is used here is the built-in distance function
;;;;;   for estimating probability of success and cost.  The
;;;;;   model here thus chooses the production instantiation 
;;;;;   with the highest PG-C.  An instantiation's PG-C is
;;;;;   computed by the estimate_P and estimate_C functions
;;;;;   that are monotonic functions of the production rule's 
;;;;;   history of success (its r*) and the instantiation's 
;;;;;   distance to the goal.  
;;;;;    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ClearAll)
(setf *previousinstantiations* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;  global parameters
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;For now, Strength Learning is kept off.
(setq *CycleTrace* t
      *EnableRationalAnalysis* t
      *ConflictResolutionTrace* t
      *EnableIndirectMatches* t
;;      *StrengthLearning* .8
      *ParametersLearning* t
)

(SetG 20)


;;CostScale and EffortScale set to 1/2 of average path length.
;;DistanceScale set to 1/2 of length of goal stick, see below.
(setf *CostScale* 2.5
      *EffortScale* 2.5)

;;v set to 2 => effort so far has greater impact on r (hopelessness) 
(SetEst :v 2)

(defvar *acuity* 0)
(setq *acuity* 0)

;;These variables hold a list of the future-distances (computed for each move)
;;  for the moves actually taken. *pfuturedist* is for moves in the previous step
;;  sequence and *cfuturedist* is for moves in the current step sequence
;;These variables used for record keeping and to simulate memory for recently
;;  encountered problem states in current problem.
(defvar *pfuturedist* nil)
(setq *pfuturedist* nil)
(defvar *cfuturedist* nil)
(setq *cfuturedist* nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;  LISP functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;Notlesswithin checks if x is not less than y within *acuity*.
(defun notlesswithin (x y)
  (> (+ x *acuity* 1) y))

;;Notgreaterwithin checks if x is not greater than y within *acuity*.
(defun notgreaterwithin (x y)
  (< (- x *acuity* 1) y))


;;Repeatcost checks if future-distance prevfd has been previously encountered
;;  by a step in the previous step sequence *?* and returns 5*prevfd, 1* o.w.
(defun repeatcost (prevfd)
  (cond ((and (< prevfd 0)(member prevfd *pfuturedist*)) (* -5 prevfd))
        ((member prevfd *pfuturedist*) (* 5 prevfd))
        ((< prevfd 0) (* -1 prevfd))
        (t prevfd)))

;;Nextprob takes a number in the word form and gives the word form
;;  for the next greater number
(defun nextprob (num)
  (case num
     ((problem0) 'problem1)
     ((problem1) 'problem2)
     ((problem2) 'problem3)
     ((problem3) 'problem4)
     ((problem4) 'problem5)
     ((problem5) 'problem6)
     ((problem6) 'problem7)
     ((problem7) 'problem8)
     ((problem8) 'problem9)
     ((problem9) 'problem10)
     ((problem10) 'problem11)
     ((problem11) 'problem12)
     ((problem12) 'problem13)
     ((problem13) 'problem14)
     ((problem14) 'problem15)
     ((problem15) 'problem16)))

;;Get-params used for diagnostic purposes, not in productions
(defun get-params (pname)
   (list (GetStrength pname)
      (Prod-a (Production->Structure pname))
      (Prod-b* (Production->Structure pname))
      (Prod-q (Production->Structure pname))
      (Prod-r* (Production->Structure pname))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;  working memory type definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;Top-level goal is to solve problems.  PROBNUM is the number
;;  of the problem currently being solved.  Problem sequence solved.
(WMEType topgoal
         PROBNUM)

;;Just below top-level goal is the goal to solve stickproblem OBJECT
(WMEType stickproblem 
         NUMBER
         OBJECT)

;;Problem description: Build a stick of length DESIRED by
;;  adding and subtracting stick lengths in the list STICKS.
;;  Length of stick as it is built, CURRENT, is initialized to 0.
;;  Number of steps taken in solution since last reset is STEPCOUNT.
(WMEType probdef 
         DESIRED
         CURRENT
         STICKS
         STEPCOUNT)

;;Subgoal to shorten the stick being built in PROBLEM by AMOUNT.
(WMEType shorten 
         PROBLEM
         AMOUNT)

;;Subgoal to lengthen the stick being built in PROBLEM by AMOUNT.
(WMEType lengthen 
         PROBLEM
         AMOUNT)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;  production rules
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;START-PROBLEM sets up the goal of solving the problem 
;;  =currprobnum.  Then it updates the probnum for the next problem.
(p start-problem
   =top>
     isa topgoal
     probnum =currprobnum
   =currprobnum>
     isa stickproblem
     object =theprob
   =theprob>
     isa probdef
     desired =goallength
   !bind! =nextprobnum (!eval! (nextprob =currprobnum))
==>
   =top>
     probnum =nextprobnum
   !eval! (setq *pfuturedist* nil)
   !eval! (setq *cfuturedist* nil)
   !eval! (setf *DistanceScale* (/ =goallength 2))
   !output! ("Now starting ~S. ~%" =currprobnum)
   !push! =currprobnum)

 (parameters start-problem
:Strength 1.0
:q-alpha 1.0
:q-beta 0.0
:r-alpha 100.0
:r-beta 0.0
:a-b 100.0
:a-v 100.0
:b-b 500.0
:b-v 500.0
:b (EstimateC 0 0)
:r (EstimateP 0 0 :s (compute-r* (PRoduction->Structure
'start-problem))))


;;ADD-TO-UNDERSHOOT selects a stick =astickl from STICKS which
;;  when added to =currl will still be less than the goal =desirel
;;  (within acuity range +/- *acuity*). only when it is the first step
(p add-to-undershoot
   =goal>
     isa stickproblem
     object =prob
   =prob>
     isa probdef
     desired =desirel
     current =currl
     sticks ($ =astickl $)
     stepcount =steps
   !eval! (= =steps 0)
   !eval! (< =currl =desirel)
   !eval! (notgreaterwithin =astickl (- =desirel =currl))
   !bind! =stepsplusone (!eval! (+ 1 =steps))
   !bind! =future-distance (!eval! (- =desirel (+ =currl =astickl)))
   !bind! =cost-distance (!eval! (repeatcost =future-distance))
==>
    =prob>
      stepcount =stepsplusone
    =subgoal>
      isa lengthen
      problem =prob
      amount =astickl
    !eval! (push =future-distance *cfuturedist*)
    !output! ("Adding ~S to ~S, still less than or = desired stick ~S. ~%~%"
              =astickl =currl =desirel)
    !push! =subgoal)


(parameters add-to-undershoot
   :Strength 1.0
   :q-alpha 1.0
   :q-beta 0.0
   :a-b 100.0
   :a-v 100.0
   :r-alpha 20.0
   :r-beta  14.0
   :b-b 60.0
   :b-v 20.0
   :b (EstimateC =steps =cost-distance)
   :r (EstimateP =steps =cost-distance :s (compute-r* (Production->Structure 
'add-to-undershoot))))



;;ADD-NOT-BEYOND selects a stick =astickl from STICKS which
;;  when added to =currl will still be less than the goal =desirel
;;  (within acuity range +/- *acuity*). and when it is not the first step
(p add-not-beyond
   =goal>
     isa stickproblem
     object =prob
   =prob>
     isa probdef
     desired =desirel
     current =currl
     sticks ($ =astickl $)
     stepcount =steps
   !eval! (> =steps 0)
   !eval! (< =currl =desirel)
   !eval! (notgreaterwithin =astickl (- =desirel =currl))
   !bind! =stepsplusone (!eval! (+ 1 =steps))
   !bind! =future-distance (!eval! (- =desirel (+ =currl =astickl)))
   !bind! =cost-distance (!eval! (repeatcost =future-distance))
==>
    =prob>
      stepcount =stepsplusone
    =subgoal>
      isa lengthen
      problem =prob
      amount =astickl
    !eval! (push =future-distance *cfuturedist*)
    !output! ("Adding ~S to ~S, still less than or = desired stick ~S. ~%~%"
              =astickl =currl =desirel)
    !push! =subgoal)


(parameters add-not-beyond
   :Strength 1.0
   :q-alpha 1.0
   :q-beta 0.0
   :a-b 100.0
   :a-v 100.0
   :r-alpha 10.0
   :r-beta  10.0
   :b-b 40.0
   :b-v 20.0
   :b (EstimateC =steps =cost-distance)
   :r (EstimateP =steps =cost-distance :s (compute-r* (Production->Structure 
'add-to-undershoot))))


;;ADD-TO-OVERSHOOT selects a stick =astickl from STICKS which
;;  when added to =currl will be greater than the goal =desirel
;;  (within acuity range +/- *acuity*).
(p add-to-overshoot
   =goal>
     isa stickproblem
     object =prob
   =prob>
     isa probdef
     desired =desirel
     current =currl
     sticks ($ =astickl $)
     stepcount =steps
   !eval! (= =steps 0)
   !eval! (< =currl =desirel)
   !eval! (notlesswithin =astickl (- =desirel =currl))
   !bind! =stepsplusone (!eval! (+ 1 =steps))
   !bind! =future-distance (!eval! (- (+ =currl =astickl) =desirel))
   !bind! =cost-distance (!eval! (repeatcost (* -1 =future-distance)))
==>
    =prob>
      stepcount =stepsplusone
    =subgoal>
      isa lengthen
      problem =prob
      amount =astickl
    !eval! (push (* -1 =future-distance) *cfuturedist*)
    !output! ("Adding ~S to ~S, greater than or = desired stick ~S. ~%~%"
              =astickl =currl =desirel)
    !push! =subgoal)


(parameters add-to-overshoot
   :Strength 1.0
   :q-alpha 1.0
   :q-beta 0.0
   :a-b 100.0
   :a-v 100.0
   :r-alpha 2.0
   :r-beta  2.0
   :b-b 60.0
   :b-v 20.0
   :b (EstimateC =steps =cost-distance)
   :r (EstimateP =steps =cost-distance :s (compute-r* (Production->Structure 
'add-to-overshoot))))

;;SUBTRACT-NOT-BEYOND subtracts =astickl from =currl, so =currl 
;;  gets closer to (but stay > or = to) =desirel
(p subtract-not-beyond
   =goal>
     isa stickproblem
     object =prob
   =prob>
     isa probdef
     desired =desirel
     current =currl
     sticks ($ =astickl $)
     stepcount =steps
   !eval! (< =steps 6)
   !eval! (> =currl =desirel)
   !eval! (notgreaterwithin =astickl (- =currl =desirel))
   !bind! =stepsplusone (!eval! (+ 1 =steps))
   !bind! =future-distance (!eval! (- (- =currl =astickl) =desirel))
   !bind! =cost-distance (!eval! (repeatcost (* -1 =future-distance)))
==>
    =prob>
      stepcount =stepsplusone
    =subgoal>
      isa shorten
      problem =prob
      amount =astickl
    !eval! (push (* -1 =future-distance) *cfuturedist*)
    !output! ("Subtracting ~S from ~S, still greater than or = desired stick ~S. ~%~%"
              =astickl =currl =desirel)
    !push! =subgoal)

(parameters subtract-not-beyond
   :Strength 1.0
   :q-alpha 1.0
   :q-beta 0.0
   :a-b 100.0
   :a-v 100.0
   :r-alpha 10.0
   :r-beta 10.0
   :b-b 40.0
   :b-v 20.0
   :b (EstimateC =steps =cost-distance)
   :r (EstimateP =steps =cost-distance :s (compute-r* (Production->Structure
'subtract-not-beyond))))

;;For completeness, there would be another production rule which
;;  subtracts off more than is needed, making current stick go from
;;  being > desired to being < desired, but I sisnce subjects didn't
;;  do that, it's not included... 

;;ADD-TO-STICK actually does the adding, updating =prob's CURRENT
;;  slot to be =sum, the new value after adding =addl
(p add-to-stick
   =goal>
     isa lengthen
     amount =addl
     problem =prob
   =prob>
     isa probdef
     current =currl
   !bind! =sum (!eval! (+ =addl =currl))
==>
    =prob>
     current =sum
  !output! ("Doing the adding; current is now ~S.~%~%"
            =sum)
  !pop!)

;;SUBTRACT-FROM-STICK actually does the subtracting, updating =prob's CURRENT
;;  slot to be =difference, the new value after subtracting =subtractl
(p subtract-from-stick
   =goal>
     isa shorten
     amount =subtractl
     problem =prob
   =prob>
     isa probdef
     current =currl
   !bind! =difference (!eval! (- =currl =subtractl))
==>
    =prob>
     current =difference
  !output! ("Doing the subtracting; current is now ~S.~%~%"
            =difference)
  !pop!)

;;DONE-WITH-PROB checks if the goal is achieved, =currl = =desirel
;; Later, this production may be associated with assigning success
;; to productions that contributed (incrementing their m's).
(p done-with-prob
   =goal>
     isa stickproblem
     object =prob
   =prob>
     isa probdef
     desired =desirel
     current =currl
   !eval! (equal =currl =desirel)
==>
    !output! ("Problem solved. ~%~%")
    !pop!)

(Parameters done-with-prob
   :Success (values t))

;;RESET-PROB checks if =steps >= 5 and the goal is still not achieved.
;; Later, this production may be associated with assigning failure
;; to productions that contributed (incrementing their n's).
(p reset-prob
   =goal>
     isa stickproblem
     object =prob
   =prob>
     isa probdef
     desired =desirel
     current =currl
     stepcount =steps
   !eval! (not (= =desirel =currl))
   !eval! (not (< =steps 5))
==>
    !output! ("Reset.")
    !eval! (setq *pfuturedist* (append *pfuturedist* *cfuturedist*))
    !eval! (setq *cfuturedist* nil)
    =prob>
       stepcount 0
       current 0)

(parameters reset-prob
   :r-alpha 100.0
   :r-beta 0.0
   :failure (values t))

;;RESET-TWO 
;; this production will reset if no good moves left (e.g. ...)
;; even when the stepcount is less than 5
(p reset-two
   =goal>
     isa stickproblem
     object =prob
   =prob>
     isa probdef
     desired =desirel
     current =currl
     sticks (=smallest $others)
     stepcount =steps
   !eval! (< (abs (- =desirel =currl)) =smallest)
   !eval! (not (= =desirel =currl))
   !eval! (< =steps 5)
==>
    !output! ("Reset.")
    !eval! (setq *pfuturedist* (append *pfuturedist* *cfuturedist*))
    !eval! (setq *cfuturedist* nil)
    =prob>
       stepcount 0
       current 0)

(parameters reset-two
   :r-alpha 100.0
   :r-beta 0.0
   :failure (values t))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;  starting up
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(SetWM 
  (letssolve
    isa topgoal
    probnum problem0)
  (problem0
   isa stickproblem
   number zero
   object goal0)
  (goal0
   isa probdef
   sticks (15 250 55)
   desired 125
   current 0
   stepcount 0)
  (problem1
   isa stickproblem
   number one
   object goal1)
  (goal1
   isa probdef
   sticks (10 155 22)
   desired 101
   current 0
   stepcount 0)
  (problem2
   isa stickproblem
   number two
   object goal2)
  (goal2
   isa probdef
   sticks (14 200 37)
   desired 112
   current 0
   stepcount 0)
  (problem3
   isa stickproblem
   number three
   object goal3)
  (goal3
   isa probdef
   sticks (22 200 32)
   desired 114
   current 0
   stepcount 0)
  (problem4
   isa stickproblem
   number four
   object goal4)
  (goal4
   isa probdef
   sticks (10 243 37)
   desired 159
   current 0
   stepcount 0)
 (problem5
   isa stickproblem
   number five
   object goal5)
 (problem6
   isa stickproblem
   number six
   object goal6)
 (problem7
   isa stickproblem
   number seven
   object goal7)
 (problem8
   isa stickproblem
   number eight
   object goal8)
 (problem9
   isa stickproblem
   number nine
   object goal9)
 (problem10
   isa stickproblem
   number ten
   object goal10)
 (problem11
   isa stickproblem
   number eleven
   object goal11)
 (problem12
   isa stickproblem
   number twelve
   object goal12)
 (problem13
   isa stickproblem
   number thirteen
   object goal13)
 (problem14
   isa stickproblem
   number fourteen
   object goal14)
(goal5
   isa probdef
   sticks (22 175 40)
   desired 73
   current 0
   stepcount 0)
(goal6
   isa probdef
   sticks (15 250 49)
   desired 137
   current 0
   stepcount 0)
(goal7
   isa probdef
   sticks (10 179 32)
   desired 105
   current 0
   stepcount 0)
(goal8
   isa probdef
   sticks (20 32 42)
   desired 104
   current 0
   stepcount 0)
(goal9
   isa probdef
   sticks (14 39 51)
   desired 116
   current 0
   stepcount 0)
(goal10
   isa probdef
   sticks (12 23 30)
   desired 72
   current 0
   stepcount 0)
(goal11
   isa probdef
   sticks (14 237 51)
   desired 121
   current 0
   stepcount 0)
(goal12
   isa probdef
   sticks (22 200 32)
   desired 114
   current 0
   stepcount 0)
(goal13
   isa probdef
   sticks (14 200 37)
   desired 112
   current 0
   stepcount 0)
(goal14
   isa probdef
   sticks (15 250 55)
   desired 125
   current 0
   stepcount 0)
)

(wmfocus letssolve)


;; problems above model U condition of experiment 1, where variable problems
;; could only be solved by undershoot (and overshoot could not be attempted).