;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<pre><xmp>
;;;
;;; ACT-R 4.0 model to solve the Tower of
;;; Hanoi task using the strategy taught to
;;; subjects by Ruiz
;;;
;;; (1) The overall goal of solving a n-pyramid problem is 
;;;     decomposed into the subgoals of getting the n disk 
;;;     to its peg and then a n-1 pyramid into its location.
;;;
;;; (2) To get the n disk to a peg, one tries to get the 
;;; largest disk blocking its move out of the way.  

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

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

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

(setf *v* nil)
(setf *move-time* 1.12) ;; 1.12040993
(setf *subgoal-time* 0.69) ;; 0.68912651
(setf *data* nil)
(setf *text* t)
(setf *graphic* nil)
(setf *overlay* nil)

(defparameter *towerruiz-exp* '(3.9 2.1 2 1.1 3.2 1 1.3 1.7 3.5 1.4 
                               2.2 1.1 2.1 1.3 1.2 1 3.1 1.4 2.2 1 
                               2.9 1.1 1 0.9 2.5 1.2 1.8 0.9 1.3 0.8 0.7))


(defvar *WWW-interface*)

(setf  *WWW-interface* 
      '((:heading "Tower of Hanoi Model for Ruiz (1987)" 2)
        (:table)
        
        (:table)
        "Movement time (sec.):" (:string :sy *move-time*  1.12)  (:new-row)
        "Subgoal time (sec.):"  (:string :sy *subgoal-time* .69)  
        
        (: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-ruiz-data *towerruiz-exp* nil)")
        (:new-para)
        (:button "Run model" "(if (and (numberp *move-time*) (numberp *subgoal-time*))
                                  (solve-tower-ruiz-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 10k (6 pages) in size"))


(defun save-ruiz-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-ruiz-time ()
  (setf *data* nil)
  (setf *last-time* 0)
  (reset)
  (setf *cycle-hook-fn* 'save-ruiz-times)
  (sgp-fct (list :ct t :lt t :ot t :v *v*))
  (parameters-fct 'final-move (list :effort *move-time*))
  (parameters-fct 'subgoal-blocker (list :effort *subgoal-time*)) 
  (parameters-fct 'move (list :effort *move-time*)) 
  (run)
  (display-ruiz-data (reverse *data*) t))

(defun display-ruiz-data (data simulation)
  (when simulation 
    (format *standard-output* "~%~%Parameters for run: (~S ~S)~%" 
            *move-time* *subgoal-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 *towerruiz-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 = 700 
        height = 400> 
        <PARAM name=\"title\" value=\"Data for Ruiz (1987)\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"32\">
        <PARAM name=\"ymax\" value=\"6\">
        <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 *towerruiz-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 *towerruiz-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 from to)
(chunk-type move-disk disk to from other test)
(chunk-type countfact first then)

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

(add-dm
   (disk1c ISA disk size 1 peg a state current)
   (disk2c ISA disk size 2 peg a state current)
   (disk3c ISA disk size 3 peg a state current)
   (disk4c ISA disk size 4 peg a state current)
   (disk5c ISA disk size 5 peg a state current)
   (disk1g ISA disk size 1 peg c state goal)
   (disk2g ISA disk size 2 peg c state goal)
   (disk3g ISA disk size 3 peg c state goal)
   (disk4g ISA disk size 4 peg c state goal)
   (disk5g ISA disk size 5 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)
   (fact56 ISA countfact first 5 then 6)
   (a ISA peg name a)
   (b ISA peg name b)
   (c ISA peg name c)
   (current isa chunk)
   (goal ISA tower-task largest 5 from a to c))

(goal-focus goal)
        


(p start-tower
"
   IF the goal is to move a pyramid of size =size to peg =end
      and =size is greater than 1
   THEN set a subgoal to move the disk of size =size to peg =end
      and change the goal to move a pyramid of six =size - 1 to peg =end
"
   =goal>
      isa tower-task
      largest =size
    - largest 1
      from =start
      to =end

   =other>
      isa peg
    - name =start
    - name =end

   =countfact>
      isa countfact
      first =new
      then =size
==>
   =goal>
      largest =new
      from =other

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

   !push! =newgoal

   !output! ("i am going to solve a ~s tower problem" =size)
)


(p final-move
"
   IF the goal is to move a tower of size 1 to peg x
   THEN move disk 1 to peg x 
      and pop the goal
"
   =goal>
      isa tower-task
      largest =size
      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 ~s from peg ~s to peg ~s" =size =gpeg =cpeg)
)

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


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

   =disk>
      isa disk
      size =size
      state current
      peg =start

   =fact>
      isa countfact
      first =new
      then =size

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

   =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)
)

(parameters-fct 'subgoal-blocker (list :effort *subgoal-time*)) 


(p move
"
   IF the goal is to move a disk of size =size to peg =to
      and there are no blocking disks
   THEN move disk =disk to peg =to
      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*))