;;;<pre><xmp>
;;;
(defvar *goal*)
(setf *goal* '((1 c) (2 c) (3 c) (4 c) (5 c)))
(defvar *problem*)
(setf *problem* '((1 a) (2 a) (3 a) (4 a) (5 c)))
(defvar *remember*)
(setf *remember* 0)
(defvar *action*)
(setf *action* 2.5)
(defvar *encode*)
(setf *encode* 2.0)
(defvar *results*)
(setf *results* nil)
(defvar *lf*)
(setf *lf* 1.0)
(defvar *v* nil)
(setf *v* nil)
(defvar *text* t)
(defvar *graphic* nil)

(defvar *WWW-interface*)

(setf  *WWW-interface* 
      '((:heading "Tower of Hanoi Model Predictions" 2)
        (:table)
        (:table)
       
        "Latency Factor" (:string :sy *lf* 1.0) (:new-row)
        "Action time (sec.):" (:string :sy *action*  2.5)  (:new-row)
        "Encoding time (sec.):"  (:string :sy *encode* 2.0)  
        
        (:table-end)
        
        (:table)
        (:checkbox "Trace" :sy *v*  nil) (:new-row)
        (:checkbox "Text output" :sy *text*  t) (:new-row)
        (:checkbox "Graphic output" :sy *graphic*  nil) 
  
        (:table-end)
        (:table-end)
        
        (:new-para)
        (:button "Run model" "(if (and (numberp *lf*) (numberp *action*) (numberp *encode*))
                                  (solve-new-toh)
                                  (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 (7 pages) in size"
        ))

(defun solve-new-toh ()
  (setf *goal* '((1 c) (2 c) (3 c) (4 c) (5 c)))
  (setf *problem* '((1 a) (2 a) (3 a) (4 a) (5 c)))
  (setf *remember* 0)
  (setf *results* nil)
  (reset)
  (sgp-fct (list :lf *lf* :v *v*))
  (spp-fct (list 'Move :effort *action*))
  (spp-fct (list 'Blocked-Destination :effort *action*))
  (spp-fct (list 'Blocked-Source :effort *action*))
  (spp-fct (list 'Start-Up :effort *encode*))
  (run)
  (when *text*
    (format *standard-output* "~%Action  Disk  Peg     Time~%")
    (dolist (x (reverse *results*))
      (format *standard-output* "~7s  ~3s   ~2s    ~6,3f~%" (first x) (second x) (third x) (fourth x)))
    (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=\"Tower of Hanoi Predictions\">
        <PARAM name=\"xmin\" value=\"0\">
        <PARAM name=\"xmax\" value=\"22\">
        <PARAM name=\"ymax\" value=\"5.0\">
        <PARAM name=\"ymin\" value=\"2.5\">
        <PARAM name=\"longestline\" value=\"22\">
        <PARAM name=\"numlines\" value=\"1\">
        <PARAM name=\"numxlabels\" value=\"23\">
        <PARAM name=\"xlabels\" value=\" ;P;P;P;M;M;M;M;P;M;M;M;M;P;P;M;M;M;M;P;M;M;M;\">
        <PARAM name=\"widestxlabel\" value=\"W\">
        <PARAM name=\"ydiv\" value=\".5\">
        <PARAM name=\"yspacing\" value=\"1\">
        <PARAM name=\"lcolor0\" value=\"0\">
        <PARAM name=\"lstyle0\" value=\"0\">
        <PARAM name=\"xval0\" value=\""  
            
            )

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

    
    
    (format *standard-output* "\">
        <PARAM name=\"xname\" value=\"Moves\">
        <PARAM name=\"yname\" value=\"RT sec.\">
        <PARAM name=\"name0\" value=\"Prediction\">" )
    
    (format *standard-output* "<PARAM name=\"yval0\" value=\"")
    
    (dolist (x (reverse *results*))
      (format *standard-output* "~3,2f;" (fourth x)))
    
    (format *standard-output* "\">")
    
    
    (format *standard-output* "
             <HR> Either your browser does not support JAVA or this graph has scrolled off the top of the display.~%
             </HR></applet>")))
    
      
  
  
 
(defun encode-goal-new-toh (x)
  (cadr (assoc x *goal*)))

(defun encode-problem-new-toh (x)
  (cadr (assoc x *problem*)))

(defun other-disk-new-toh (x y)
  (car (remove x (remove y '(a b c)))))

(defun update-problem-new-toh (d p)
  (let ((pair (assoc d *problem*)))
    (setf *problem* (subst (list d p) pair *problem* :test 'equal))))

(defun report-time-new-toh ()
  (let  ((answer (- (+ *action* *time*) *remember*)))
    (setf *remember* (+ *action* *time*)) answer))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</xmp><pre><a name="model">
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</a>
(clearall)

(sgp-fct (list :er t :era t :v *v* :bll .5 :lf *lf* :ga 0 :blc 1.25))

(chunk-type do-tower p-disk p-from p-to check spare check-loc parent success)

(add-dm (goal isa do-tower)
        (1 isa chunk) (2 isa chunk) (3 isa chunk) (4 isa chunk) (5 isa chunk)
        (a isa chunk) (b isa chunk) (c isa chunk) (0 isa chunk) (failure isa chunk))

(goal-focus goal)

(p Start-Up 
   =goal>
       isa do-tower
       p-disk nil
==>
   =goal>
       p-disk 5)

(spp-fct (list 'Start-Up :effort *encode*))

(p Note-Target-Peg
   =goal>
       isa do-tower
       p-disk =size
       p-to nil
==>
   =goal>
       p-to (!eval! (encode-goal-new-toh =size)))


(p Note-Source-Peg
   =goal>
       isa do-tower
       p-disk =size
       p-from nil
==>
   =goal>
       p-from (!eval! (encode-problem-new-toh =size)))

(p Disk-There
   =goal>
      isa do-tower
      p-disk =size
    - p-disk 1
      p-to =target
      p-from =target
      success nil
==>
   =goal>
      success t
   =newgoal>
      isa do-tower
      p-disk (!eval! (1- =size))
      p-to nil
      p-from nil
!focus-on! =newgoal)

(p Note-Check
   =goal>
      isa do-tower
      p-disk =size
    - p-disk 1
      p-to =target
    - p-from =target
      p-from =source
      check nil
==>
   =goal>
      check (!eval! (1- =size)))

(p Spare-Peg
   =goal>
      isa do-tower
      p-disk =size
    - p-disk 1
      p-to =target
    - p-from =target
      p-from =source
      spare nil
==>
   =goal>
      spare (!eval! (other-disk-new-toh =target =source)))

(p Note-Checkee
    =goal>
      isa do-tower
      check =disk
    - check 0
      check-loc nil
==>
    =goal>
      check-loc (!eval! (encode-problem-new-toh =disk)))

(p Blocked-Source
     =goal>
       isa do-tower
       p-disk =disk
       p-from =peg
       p-to =p
       check-loc =peg
       success nil
       spare =spare
==>
     =goal>
       success failure
!eval! (push (list 'subgoal =disk =p (report-time-new-toh)) *results*))

(spp-fct (list 'Blocked-Source :effort *action*))

(p Blocked-Destination
     =goal>
       isa do-tower
       p-disk =disk
       p-to =peg
       check-loc =peg
       success nil
       spare =spare
==>
     =goal>
       success failure
!eval! (push (list 'subgoal =disk =peg (report-time-new-toh)) *results*))

(spp-fct (list 'Blocked-Destination :effort *action*))

(p Subgoal-Blocker
    =goal>
       isa do-tower
       check-loc =loc1
       spare =loc2
       check =size
     - check 0
       success failure
==>
   =goal>
       check (!eval! (1- =size))
       check-loc nil
    =newgoal>
       isa do-tower
       p-disk =size
       p-from =loc1
       p-to =loc2
       parent =goal
!focus-on! =newgoal)

(p Move
    =goal>
       isa do-tower
       p-disk =d
       p-from =x
       p-to =p
       check 0
     - success t
==>
    =goal>
       success t
!eval! (push (list 'move =d =p (report-time-new-toh)) *results*)
!eval! (update-problem-new-toh =d =p))

(spp-fct (list 'Move :effort *action*))

(p Reset-Top
    =goal>
       isa do-tower
       p-disk =d
    -  p-disk 1
       p-to =p
       parent nil
       success t
==>
     =newgoal>
        isa do-tower
        p-disk (!eval! (1- =d))
        p-to nil
        p-from nil
        check nil
        spare nil
!focus-on! =newgoal)

(p Move-One
    =goal>
       isa do-tower
       p-disk 1
       p-to =p
       p-from =x
       check nil
     - success t
==>
    =goal>
       check 0)

(spp Move-One :effort .15)

(p Retrieve-Parent
    =goal>
       isa do-tower
       success t
       parent =parent
    =parent>
       isa do-tower
==>
!focus-on! =parent)

(p Success
    =goal>
       isa do-tower
       success t
       p-disk 1
       parent nil
==>
!pop!)