;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;; ACT-R 4.0 model to solve the Tower of
;;; Hanoi task.

;;; to run the model call
;;; (solve-tower-time)
;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This section contains the LISP functions 
;;; implement the interface.
;;;
;;; The ACT-R Model starts further down
;;;


(defvar *v*)
(defvar *move-time*)
(defvar *encode-time*)
(defvar *data*)
(defvar *text*)
(defvar *graphic*)
(defvar *overlay*)
(defvar *last-time*)

(setf *move-time* 2.15)
(setf *encode-time* 0.56)
(setf *v* nil)
(setf *data* nil)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)

(defparameter *tower-exp* '(9.7 2.5 2.8 2.2 3.1 2 2.4 2 6.6 2.4 2.9 2.1 5.4 2.2 2))

(defvar *WWW-interface*)

(setf  *WWW-interface* 
      '((:heading "Tower of Hanoi Model for Anderson, Kushmerick, & Lebiere (1993)" 2)
        (:table)
        (:table)
       
        "Movement time (sec.):" (:string :sy *move-time*  2.15)  (:new-row)
        "Encoding time (sec.):"  (:string :sy *encode-time* .56)  
        
        (: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-tower-data *tower-exp* nil)")
        (:new-para)
        (:button "Run model" "(if (and (numberp *move-time*) (numberp *encode-time*))
                                  (solve-tower-time)
                                  (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 to run the model"
        (:new-line)
        "- The trace of 1 run is approximatly 7k (5 pages) in size"
        ))

(defun save-tower-times (instantiation)
  (when (or (equal 'move (production-name (instantiation-production instantiation)))
            (equal 'final-move (production-name (instantiation-production instantiation))))
    (setf *data* (cons  (- (actr-time) *last-time*) *data*))
    (setf *last-time* (actr-time))))

(defun solve-tower-time ()
  (setf *data* nil)
  (setf *last-time* 0)
  (reset)
  (setf *cycle-hook-fn* 'save-tower-times)
  (sgp-fct (list :ct t :lt t :ot t :v *v*))
  (parameters-fct 'move (list :effort *move-time*))
  (parameters-fct 'note-checkee (list :effort *encode-time*))
  (parameters-fct 'note-source-peg (list :effort *encode-time*))
  (parameters-fct 'note-target-peg (list :effort *encode-time*))
  (parameters-fct 'final-move (list :effort *move-time*))
  (parameters-fct 'done-finding (list :effort *encode-time*))
  (parameters-fct 'find-disk (list :effort *encode-time*))
  (run)
  (display-tower-data (reverse *data*) t))

;;;<blockquote>
(defun display-tower-data (data simulation)
  (when simulation 
    (format *standard-output* "~%~%Parameters for run: (~S ~S)~%" 
            *move-time* *encode-time*))
  
  (when *text*
    (format *standard-output* "~%~%~a move times:~%" (if simulation "Simulation" "Experimental"))
    (format *standard-output* "~%Move Number     Time (sec.)~%")
    (dotimes (i (length data))
      (format *standard-output* "~6d~14,2f~%" (+ i 1) (nth i data)))
    (format *standard-output* "~%")
    
    (when (and simulation *overlay*)
      (format *standard-output* "~%~%Experimental move times:~%")
      (format *standard-output* "~%Move Number     Time (sec.)~%")
      (dotimes (i (length data))
        (format *standard-output* "~6d~14,2f~%" (+ i 1) (nth i *tower-exp*)))
      (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 = 500 
        height = 400> 
        <PARAM name=\"title\" value=\"Data for Anderson, Kushmerick, Lebiere (1993)\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"16\">
        <PARAM name=\"ymax\" value=\"10\">
        <PARAM name=\"ymin\" value=\"0\">
        <PARAM name=\"longestline\" value=\"~S\">
        <PARAM name=\"numlines\" value=\"~S\">
        <PARAM name=\"xspacing\" value=\"1\">
        <PARAM name=\"ydiv\" value=\".5\">
        <PARAM name=\"yspacing\" value=\"1\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"~s\">
        <PARAM name=\"xval0\" value=\"" (if *overlay* (max (length data) (length *tower-exp*)) (length data)) 
            (if (and simulation *overlay*) 2 1)
            (if simulation 2 6553))

    (dotimes (i (length data))
      (format *standard-output* "~d;" (+ i 1)))

    (when (and simulation *overlay*)
      (format *standard-output* "\"><PARAM name=\"xval1\" value=\"")

      (dotimes (i (length data))
        (format *standard-output* "~d;" (+ i 1))))
    
    (format *standard-output* "\">
        <PARAM name=\"xname\" value=\"Move number\">
        <PARAM name=\"yname\" value=\"RT sec.\">
        <PARAM name=\"name0\" value=\"~a\">" (if simulation "Simulation Data" "Experiment Data"))
    
    (format *standard-output* "<PARAM name=\"yval0\" value=\"")
    
    (dolist (x data)
      (format *standard-output* "~3,2f;" x))
    
    (format *standard-output* "\">")
    
    (when (and *overlay* simulation)
      (format *standard-output* "
        <PARAM name=\"lcolor1\" value=\"0\">
        <PARAM name=\"lstyle1\" value=\"6553\">
        <PARAM name=\"yval1\" value=\"")
      (dolist (x *tower-exp*)
        (format *standard-output* "~S;" x))
      
      (format *standard-output* "\"> 
          <PARAM name=\"name1\" value=\"Experiment Data\">"))
    (format *standard-output* "
             <HR> Either your browser does not support JAVA or this graph has scrolled off the top of the display.~%
             </HR></applet>")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
;;;
;;; ACT-R model of solving Tower of Hanoi Problems
;;;

(clearall)

(chunk-type disk size peg state)
(chunk-type peg name)
(chunk-type tower-task largest current goal)
(chunk-type move-disk disk to from other test at)
(chunk-type countfact first then)
(chunk-type encode-configuration size state)

;;; add chunks to specify the initial conditions
;;; and the goal conditions for each disk

(add-dm
   (disk1c isa disk size 1 peg c state current)
   (disk2c isa disk size 2 peg a state current)
   (disk3c isa disk size 3 peg b state current)
   (disk4c isa disk size 4 peg b state current)
   (disk1g isa disk size 1 peg b state goal)
   (disk2g isa disk size 2 peg a state goal)
   (disk3g isa disk size 3 peg c state goal)
   (disk4g isa disk size 4 peg c state goal)
   (fact01 isa countfact first 0 then 1)
   (fact12 isa countfact first 1 then 2)
   (fact23 isa countfact first 2 then 3)
   (fact34 isa countfact first 3 then 4)
   (fact45 isa countfact first 4 then 5)
   (a isa peg name a)
   (b isa peg name b)
   (c isa peg name c)
   (goal isa tower-task largest 4)
   (current isa chunk))

(goal-focus goal)


(p start-tower
"
   IF the goal is to solve a tower task of size =size
      and =size is greater than 1
   THEN set a subgoal to move disk =size checking disk =new
      and change the goal to solve a tower task of size =new
"
   =goal>
      isa tower-task
      largest =size
    - largest 1
      current t
      goal t

   =fact>
      isa countfact
      first =new
      then =size
==>
   =goal>
      goal nil
      largest =new

   =newgoal>
      isa move-disk
      disk =size
      test =new

   !push! =newgoal

   !output! ("i am going to try to move the ~s disk" =size)
)


(p encode-current-configuration
"
   IF the goal is to solve a tower task of size =size
      and the current configuration has not recently been encoded
   THEN set a subgoal to encode disks less than or equal to =size in the 
      current configuration
"
   =goal>
      isa tower-task
      largest =size
    - largest 1
      current nil
==>
   =goal>
      current t

   =newgoal1>
      isa encode-configuration
      state current
      size =size

   !push! =newgoal1

   !output! ("i am going to encode the current state")
)


(p encode-target-configuration
"
   IF the goal is to solve a tower task of size =size
      and the goal configuration has not recently been encoded
   THEN set a subgoal to encode disks less than or equal to =size in the 
      goal configuration
"
   =goal>
      isa tower-task
      largest =size
    - largest 1
      goal nil
==>
   =goal>
      goal t

   =newgoal1>
      isa encode-configuration
      state goal
      size =size

   !push! =newgoal1

   !output! ("i am going to encode the goal configuration")
)


(p find-disk
"
   IF the goal is to encode disks less than or equal to =size in a 
      configuration
   THEN encode disk =szie in the configuration
      and transform the goal to encoding disks less than or equal to =new
"
   =goal>
      isa encode-configuration
      state =state
      size =size
    - size 1

   =countfact>
      isa countfact
      first =new
      then =size

   =disk>
      isa disk
      size =size
      peg =peg
      state =state
==>
   =goal>
      size =new

   !output! ("i am encoding that disk ~s is on peg ~s in ~s state" =size =peg =state)
)

(parameters-fct 'find-disk (list :effort *encode-time*))


(p done-finding
"
   IF the goal is to encode disks less than or equal to 1
   THEN encode disk 1
      and pop the goal
"
   =goal>
      isa encode-configuration
      state =state
      size 1

   =disk>
      isa disk
      size =size
      peg =peg
      state =state
==>
   !pop!

   !output! ("i am encoding that disk 1 is on peg ~s in ~s state" =peg =state)
)

(parameters-fct 'done-finding (list :effort *encode-time*))


(p final-move
"
   IF  the goal is to move a tower of size 1 to peg =gpeg
   THEN  move disk 1 to peg =gpeg 
       and pop the goal
"
   =goal>
      isa tower-task
      largest 1

   =gdisk>
      isa disk
      size 1
      peg =gpeg
      state goal

   =cdisk>
      isa disk
      size 1
      peg =cpeg
      state current
==>
   !pop!

   !output! ("i am moving disk 1 from peg ~s to peg ~s" =cpeg =gpeg)
)

(parameters-fct 'final-move (list :effort *move-time*))


(p note-source-peg
"
   IF the goal is to move a disk of size =size
      and the location of =size in the current configuration is not encoded
   THEN encode location of disk =size in the current configuration as source peg
"
   =goal>
      isa move-disk
      from nil
      disk =size

   =disk>
      isa disk
      size =size
      peg =peg
      state current
==>
   =goal>
      from =peg

   !output! ("disk ~s is currently on peg ~s" =size =peg)
)

(parameters-fct 'note-source-peg (list :effort *encode-time*))


(p note-target-peg
"
   IF the goal is to move a disk of size =size
      and the location of =size in the goal configuration is not encoded
   THEN encode disk =size in the goal configuration as the target peg
"
   =goal>
      isa move-disk
      to  nil
      disk =size

   =disk>
      isa disk
      size =size
      peg =peg
      state goal
==>
   =goal>
      to =peg

   !output! ("disk ~s should be on peg ~s" =size =peg)
)

(parameters-fct 'note-target-peg (list :effort *encode-time*))


(p spare-peg
"
   IF the goal is to move a disk 
      and there is source and target peg 
   THEN the remaining peg is the other peg
"
   =goal>
      isa move-disk
      to =g
      from =c
      disk =s
    - from =g
      other nil

   =peg>
      isa peg
    - name =g
    - name =c
==>
   =goal>
      other =peg

   !output! ("my goal is to move ~s from ~s to ~s" =s =c =g)
)


(p note-checkee
"
   IF the goal is to move a disk checking =new
      and the location of =new in the current configuration is not encoded
   THEN encode disk =new in the current configuration
"
   =goal>
      isa move-disk
      test =new
      at nil

   =disk>
      isa disk
      size =new
      state current
      peg =peg
==>
   =goal>
      at =peg

   !output! ("smaller disk ~s is on peg ~s" =new =peg)
)

(parameters-fct 'note-checkee (list :effort *encode-time*))


(p subgoal-blocker
"
   IF the goal is to move a disk checking =size
      and =peg is the other peg
      and =size is not at =peg
   THEN set a subgoal to move disk =size to =peg checking =new
      and change the goal to check =new
"
   =goal>
      isa move-disk
      test =size
      other =other
      from =from
      to =to
      at =start
    - at =other

   =fact>
      isa countfact
      first =new
      then =size

   =peg>
      isa peg
    - name =start
    - name =other
==>
   =goal>
      test =new
      at nil

   =newgoal>
      isa move-disk
      disk =size
      test =new
      from =start
      to =other
      other =peg

   !push! =newgoal

   !output! ("my goal is to move ~s from ~s to ~s" =size =start =other)
)

(p blocker-on-other-peg
"
   IF the goal is to move a disk checking =size
      and =other is the other peg
      and =size is at =other
   THEN change the goal to check =new
"
   =goal>
      isa move-disk
      test =size
      other =other
      from =from
      to =to
      at =other

   =fact>
      isa countfact
      first =new
      then =size
==>
   =goal>
      test =new
      at nil

   !output! ("disk ~s is at ~s" =size =other)
)


(p move
"
   IF the goal is move disk of size n to peg x
      and all smaller disks have been checked
   THEN move disk n to peg x
      and pop the goal
"
   =goal>
      isa move-disk
      test 0
      from =from
      to =to
      disk =size

   =disk>
      isa disk
      size =size
==>
   =disk>
      peg =to

   !pop!

   !output! ("i am moving disk ~s from ~s to ~s" =size =from =to)
)

(parameters-fct 'move (list :effort *move-time*))