###
### FILE : tower-of-hanoi7.soar
###

###
### AUTHOR(1) : Aladin.Akyurek [ Soar 6.1.0 ]
### AUTHOR(2) : Tim Chapman [ Soar 7.0.4 ]
###             tidied Frank Ritter 10 Dec 97

###
### CREATED(1) : Aug 15, 93
###

###
### MODIFIED(3) : May 27, 97 [ soar 7.0.4 ] Tim Chapman
### MODIFIED(2) : Feb 18, 94 [ soar 6.1.x ] Aladin.Akyurek
### MODIFIED(1) : Jan 11, 94 [ soar 6.1.x ] Aladin.Akyurek
###

### May 27, 97 : Added Blocksworld problem space for Tower
### Noticing Strategy.
### Feb 18, 94 : Added the Pop operator, removed the Infer space.
### Jan 11, 94 : Collapsed two problem spaces into one from
### the version which was presented at the 7th EuroSoar Workshop
### (Nov 93, Nottingham, UK).
###
### Copyright (C) Aladin Akyurek (NISCALE, Leiden, The Netherlands).

###
### TOP GOAL:
### TOWER-OF-HANOI
###

watch learning -print
watch -chunks -print
learn -on

sp {top-goal*elaborate*goal*toh
 "Create the top goal state"
  (state <s> ^superstate nil)
  -->
  (<s> ^name tower-of-hanoi)}

###
### TOWER-OF-HANOI PROBLEM SPACE:
### TOWER-OF-HANOI
###

sp {toh*propose*space*tower-of-hanoi
 "Propose the tower-of-hanoi problem space"
  (state <s> ^name tower-of-hanoi)
  -->
  (<s> ^problem-space <p>)
  (<p> ^name tower-of-hanoi)}

###
### TOWER-OF-HANOI PROBLEM SPACE:
### INITIAL-STATE AND DESIRED-STATE
###

#prob.5d.1
#A 5-disk problem for the tower-of-hanoi system.

#  1
#  2
#  3
#  4
#  5
# --- --- ---
#  A   B   C
#
# Initial State Desired State

# This can be modified to create larger or smaller towers
sp {toh*propose*state*initial-and-desired-states
 "A 5-Disk Tower of Hanoi Problem."
  (state <s> ^name tower-of-hanoi ^problem-space <p>)
  (<p> ^name tower-of-hanoi)
  -->
  (<s> ^taskstate <ts>)
  (<ts> ^disk <disk-1> + &,
              <disk-2> + &,
              <disk-3> + &,
              <disk-4> + &,
              <disk-5> + &
        ^peg <peg-a> + &,
             <peg-b> + &,
             <peg-c> + &
        ^holds <h1> + &,
               <h2> + &,
               <h3> + &,
               <h4> + &,
               <h5> + & )
  (<h1> ^disk <disk-1> ^above <disk-2> ^on <peg-a>)
  (<h2> ^disk <disk-2> ^above <disk-3> ^on <peg-a>)
  (<h3> ^disk <disk-3> ^above <disk-4> ^on <peg-a>)
  (<h4> ^disk <disk-4> ^above <disk-5> ^on <peg-a>)
  (<h5> ^disk <disk-5> ^above none ^on <peg-a>)
  (<disk-1> ^name 1 ^size 1)
  (<disk-2> ^name 2 ^size 2)
  (<disk-3> ^name 3 ^size 3)
  (<disk-4> ^name 4 ^size 4)
  (<disk-5> ^name 5 ^size 5)
  (<peg-a> ^name |A|)
  (<peg-b> ^name |B|)
  (<peg-c> ^name |C|)
  (<s> ^desired <d1> + &,
                <d2> + &,
                <d3> + &,
                <d4> + &,
                <d5> + & )
  (<d1> ^disk <disk-1> ^above <disk-2> ^on <peg-c>)
  (<d2> ^disk <disk-2> ^above <disk-3> ^on <peg-c>)
  (<d3> ^disk <disk-3> ^above <disk-4> ^on <peg-c>)
  (<d4> ^disk <disk-4> ^above <disk-5> ^on <peg-c>)
  (<d5> ^disk <disk-5> ^above none ^on <peg-c>)}


###
### TOWER-OF-HANOI PROBLEM SPACE:
### STATE ELABORATION/INFERENCES:
### LARGER, UPPER-DISK, AND
### CLEAR
###

sp {toh*object*disk*elaborate*state*larger
 "If size-of(i) > size-of(j), then larger(i,j)."
  (state <s> ^superstate nil
             ^problem-space.name tower-of-hanoi ^taskstate <ts>)
  (<ts> ^disk <i-disk> { <> <i-disk> <j-disk> })
  (<i-disk> ^size <i-size>)
  (<j-disk> ^size <j-size> > <i-size>)
 -->
  (<j-disk> ^larger <i-disk> + & )}

sp {toh*object*disk*elaborate*state*upper-disk
 "If not(above(x,disk)), then upper-disk(disk)."
  (state <s> ^problem-space.name tower-of-hanoi ^taskstate <ts>)
  (<ts> ^disk <disk>)
  -{ (<ts> ^holds <h>)
  (<h> ^above <disk>) }
  -->
  (<ts> ^upper-disk <disk> + & )}

sp {toh*object*peg*elaborate*state*clear
 "If not(on(x,peg)), then clear(peg)."
  (state <s> ^problem-space.name tower-of-hanoi ^taskstate <ts>)
  (<ts> ^peg <peg>)
  -{ (<ts> ^holds <h>)
  (<h> ^on <peg>) }
  -->
  (<ts> ^clear <peg> + & )}

###
### TOWER-OF-HANOI PROBLEM SPACE OPERATORS:
### SET-FOCUS AND MOVE-DISK
### For POP and GOAL-TEST, see below.
###

sp {toh*propose*operator*set-focus*disk-to-move
 "If no focus [i.e., no disk-to-move], then create one."
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name tower-of-hanoi)
  (<ts> -^disk-to-move)
  -->
  (<s> ^operator <o> + <, <o> = )
  (<o> ^name set-focus ^previous-focus none ^done? no)}

## -fer moveable?
sp {toh*propose*operator*set-focus*disk-to-move*alternative
 "If the disk in focus is not movable, change the focus."
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name tower-of-hanoi)
  (<ts> ^disk-to-move <m>)
  # (<m> ^disk <m-disk>)
  # (<m-disk> -^moveable yes)
  -->
  (<s> ^operator <o> + <, <o> = )
  (<o> ^name set-focus ^previous-focus <m> ^done? no)}

sp {toh*propose*operator*move-disk*disk-to-move*onto
 "Move disk when target peg is clear."
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name tower-of-hanoi)
  (<ts> ^disk-to-move <m> ^upper-disk <m-disk>
        ^peg <target-peg>
        ^clear <target-peg>
        ^holds <h>)
  (<m> ^disk <m-disk>
       ^from { <> <target-peg> <source-peg> }
       ^to <target-peg>)
  (<h> ^disk <m-disk> ^on <source-peg>)
  -->
  (<s> ^operator <o>)
  (<o> ^name move-disk ^disk <m-disk>
       ^from <source-peg>
       ^to <target-peg>
       ^done? no)}

sp {toh*propose*operator*move-disk*disk-to-move*above
 "Move disk where upper disk on the target peg is larger."
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name tower-of-hanoi)
  (<ts> ^disk-to-move <m>
        ^upper-disk <m-disk> <o-disk>
        ^peg <target-peg>
       -^clear <target-peg>
        ^holds <h> <i>)
  (<m> ^disk <m-disk>
       ^from { <> <target-peg> <source-peg> }
       ^to <target-peg>)
  (<h> ^disk <m-disk> ^on <source-peg>)
  (<i> ^disk <o-disk> ^on <target-peg>)
  (<o-disk> ^larger <m-disk>)
  -->
  (<s> ^operator <o>)
  (<o> ^name move-disk ^disk <m-disk>
       ^from <source-peg>
       ^to <target-peg>
       ^done? no)}

###
### TOWER-OF-HANOI PROBLEM SPACE:
### OPERATOR IMPLEMENTATION
###

sp {implement*move-disk*from-above*nodisk*target-peg*is-clear
 "Carry out the move when target peg is clear"
  (state <s> ^operator <o>)
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<o> ^name move-disk ^disk <m-disk>
       ^from <source-peg>
       ^to <target-peg>
       ^done? no)
  (<p> ^name <p-name>)
  (<ts> ^upper-disk <m-disk> ^clear <target-peg> ^disk-to-move <m>
        ^holds <h>)
  (<m> ^disk <m-disk> ^from <source-peg> ^to <peg>)
  (<h> ^disk <m-disk> ^above none ^on <source-peg>)
  -->
  (<h> ^on <target-peg> <source-peg> - )
  (<o> ^done? yes no - )}

sp {implement*move-disk*from-above*adisk*target-peg*is-clear
 "Carry out the move from above a disk when target is clear"
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>)
  (<o> ^name move-disk ^disk <m-disk> ^done? no
       ^from <source-peg> ^to <target-peg>)
  (<p> ^name <p-name>)
  (<ts> ^upper-disk <m-disk> ^clear <target-peg>
        ^disk-to-move <m> ^holds <h>)
  (<m> ^disk <m-disk> ^from <source-peg> ^to <target-peg>)
  (<h> ^disk <m-disk> ^above { <> none <adisk> } ^on <source-peg>)
  -->
  (<h> ^above none <adisk> - )
  (<h> ^on <target-peg> <source-peg> - )
  (<o> ^done? yes + no - )}

sp {implement*move-disk*from-above*adisk-or-nodisk*target-peg*is-not-clear
 "Carry out the move to a non-clear target peg"
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>)
  (<o> ^name move-disk ^disk <m-disk> ^done? no
       ^from <source-peg> ^to <target-peg>)
  (<p> ^name <p-name>)
  (<ts> ^upper-disk <m-disk> { <> <m-disk> <o-disk> }
        -^clear <target-peg>
        ^disk-to-move <m> ^holds <h> <i>)
  (<m> ^disk <m-disk> ^from <source-peg> ^to <target-peg>)
  (<h> ^disk <m-disk> ^above <adisk-or-nodisk> ^on <source-peg>)
  (<i> ^disk <o-disk> ^on <target-peg>)
  (<o-disk> ^larger <m-disk>)
  -->
  (<h> ^above <o-disk> <adisk-or-nodisk> - )
  (<h> ^on <target-peg> <source-peg> - )
  (<o> ^done? yes no - )}

###
### TOWER-OF-HANOI PROBLEM SPACE:
### OPERATOR TERMINATION
###

sp {terminate*set-focus
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>)
  (<o> ^name set-focus ^done? yes)
  (<p> ^name <p-name>)
  -->
  (<s> ^operator <o> @ )}

sp {terminate*move-disk
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>)
  (<o> ^name move-disk ^done? yes)
  (<p> ^name <p-name>)
  -->
  (<s> ^operator <o> @ )}

###
### TOWER-OF-HANOI PROBLEM SPACE: POP FOCUS
###

sp {toh*propose*operator*pop*object*disk-to-move
 "Propose pop operator to choose disk to focus on"
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name tower-of-hanoi)
  (<ts> ^holds <h> ^disk-to-move <m>)
  (<m> ^disk <disk> ^to <peg>)
  (<h> ^disk <disk> ^on <peg>)
  -->
  (<s> ^operator <o> + =, <o> < )
  (<o> ^name pop ^focus <m> ^done? no)
 (<m> ^pop? yes)}

sp {task-space*compare*pop*better
 "Check that pop is the best operator"
  (state <s> ^operator <op-1> + { <> <op-1> <op-2> } + )
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<op-1> ^name pop)
  (<op-2> -^name { << pop add del >> })
  (<p> ^name <p-name>)
  -->
  (<s> ^operator <op-1> > <op-2> )}

sp {implement*pop
 "Pop the focus to the most suitable disk"
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>)
  (<o> ^name pop ^focus <m> ^done? no)
  (<p> ^name <p-name>)
  (<ts> ^<f> <m>)
  (<m> ^pop? yes)
  -->
  (<ts> ^<f> <m> - )
  (<o> ^done? yes no - )}

sp {terminate*pop
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>)
  (<o> ^name pop ^done? yes)
  (<p> ^name <p-name>)
  -->
  (<s> ^operator <o> @ )}

###
### TOWER-OF-HANOI PROBLEM SPACE: GOAL-TEST
###

sp {toh*desired-of-disk*satisfied
 "Check if conditions are satisfied"
  (state <s> ^desired <d> ^problem-space <p> ^taskstate <ts>)
  (<d> ^disk <disk> ^above <x> ^on <peg>)
  (<p> ^name tower-of-hanoi)
  (<ts> ^holds <h>)
  (<h> ^disk <disk> ^above <x> ^on <peg>)
  -->
  (<s> ^satisfied <d> + & )}

sp {task-space*mark*state*pursue
 "Mark goals to pursue"
  (state <s> ^desired <d> -^satisfied <d> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name <p-name>)
  -->
  (<ts> ^pursue <d> + & )}

sp {task-space*propose*operator*goal-test*top-goal
  "Propose operator for if top-goal is reached"
  (state <s> ^superstate nil ^problem-space <p> ^taskstate <ts>)
  (<p> ^name <p-name>)
  (<ts> -^pursue -^success)
  -->
  (<s> ^operator <q> =, <q> + )
  (<q> ^name goal-test ^result-type success)}

sp {task-space*select*operator*goal-test*better
 "Check if goal test is best operator"
  (state <s> ^operator <op-1> + { <> <op-1> <op-2> } + )
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<op-1> ^name goal-test)
  (<op-2> -^name << pop add del >>)
  (<p> ^name <p-name>)
  (<ts> -^pursue)
  -->
  (<s> ^operator <op-1> > <op-2> )}

sp {implement*goal-test*top-goal
 "Implement the goal reached operator"
  (state <s> ^operator <q> ^problem-space <p> ^taskstate <ts>
             ^desired <d> ^satisfied <d> ^superstate nil)
  (<q> ^name goal-test ^result-type <r-type>)
  (<ts> -^pursue -^<r-type> <d>)
  -->
  (write (crlf) | ********** Goal State Achieved ********* | )
  (<ts> ^<r-type> <d> + & )
  (<s> ^<r-type> <d> + & )
  (halt)}

sp {terminate*goal-test
  (state <s> ^operator <q> ^problem-space <p> ^taskstate <ts>)
  (<q> ^name goal-test)
  (<p> ^name <p-name>)
  -->
  (<s> ^operator <q> @ )}

###
### TOWER-OF-HANOI PROBLEM-SPACE SUBGOAL:
### PROBLEM SPACE = SET-FOCUS
### INITIAL STATE = SUPERSTATE
###

sp {toh*operator-no-change*create*goal-context*set-focus
 "Propose the set-focus problem space on impasse"
  (state <s*> ^superstate.operator <op> ^impasse no-change
              ^attribute operator ^superstate <g1>)
  (<op> ^name set-focus)
  (<g1> ^problem-space <p1> ^taskstate <ts1>)
  -->
  (<s*> ^problem-space <p*>)
  (<p*> ^name set-focus)
  (<s*> ^taskstate <ts1>)}

###
### SET-FOCUS PROBLEM SPACE:
### STATE ELABORATION:
### IS-BLOCKED-BY AND
### LARGEST-BLOCKING-DISK
###

sp {set-focus*elaborate*state*disk-to-move*blocking-disks*source
 "Record blocking disks on source peg"
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name set-focus)
  (<ts> ^disk-to-move <m> ^holds <h> <i>)
  (<m> ^disk <m-disk> ^from <source-peg> ^to <target-peg>)
  (<h> ^disk <m-disk> ^on <source-peg>)
  (<i> ^disk <b-disk> ^on <source-peg>)
  (<m-disk> ^larger <b-disk>)
  -->
  (<m> ^is-blocked-by <b-disk> + & )}

sp {set-focus*elaborate*state*disk-to-move*blocking-disks*target
 "Record blocking disks on target peg"
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name set-focus)
  (<ts> ^disk-to-move <m> ^holds <h> <i>)
  (<m> ^disk <m-disk> ^from <source-peg>
                      ^to { <> <source-peg> <target-peg> })
  (<h> ^disk <m-disk> ^on <source-peg>)
  (<i> ^disk <b-disk> ^on <target-peg>)
  (<m-disk> ^larger <b-disk>)
  -->
  (<m> ^is-blocked-by <b-disk> + & )}

sp {set-focus*elaborate*state*disk-to-move*largest-blocking-disk
 "Record the largest blocking disk"
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name set-focus)
  (<ts> ^disk-to-move <m>)
  (<m> ^is-blocked-by <x>)
  -{ (<ts> ^disk-to-move <m>)
  (<m> ^is-blocked-by <z>)
  (<z> ^larger <x>) }
  -->
  (<m> ^largest-blocking-disk <x>)}

###
### SET-FOCUS PROBLEM SPACE OPERATORS:
### CREATE-FOCUS AND CHANGE-FOCUS
###

sp {set-focus*propose*operator*create-focus
 "Propose to create a focus if none exists"
  (state <s> ^problem-space <p> ^taskstate <ts>
            ^superoperator <s-operator>)
  (<p> ^name set-focus)
  (<s-operator> ^previous-focus none)
  -->
  (<s> ^operator <o> + = )
  (<o> ^name create-focus ^previous-focus none)}

sp {set-focus*propose*operator*change-focus
 "Propose to change existing focus"
  (state <s> ^problem-space <p> ^taskstate <ts>
             ^superoperator <s-operator>)
  (<p> ^name set-focus)
  (<s-operator> ^previous-focus { <> none <f> })
  -->
  (<s> ^operator <o> + = )
  (<o> ^name change-focus ^previous-focus <f>)}

###
### SET-FOCUS PROBLEM SPACE:
### OPERATOR IMPLEMENTATION
###

sp {implement*create-focus*disk-to-move*largest
 "Set focus to largest blocking disk"
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>
             ^superoperator <s-operator>)
  (<p> ^name <p-name>)
  (<o> ^name create-focus)
  (<ts> ^holds <h> ^pursue <i>)
  (<h> ^disk <x> ^on <current-peg>)
  (<i> ^disk <x> ^on <desired-peg>)
  -{ (<ts> ^pursue <j>)
  (<j> ^disk <z>)
  (<z> ^larger <x>) }
  -->
  (<ts> ^disk-to-move <m> + & )
  (<m> ^disk <x> ^from <current-peg> ^to <desired-peg>)
  (<s-operator> ^done? yes no - )}

sp {implement*change-focus*disk-to-move*largest-blocker
 "Set focus to largest blocking disk"
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>
             ^superoperator <s-operator>)
  (<p> ^name <p-name>)
  (<o> ^name change-focus ^previous-focus <f>)
  (<ts> ^peg <other-peg> ^holds <h> ^disk-to-move <f>)
  (<f> ^disk <f-disk> ^largest-blocking-disk <b-disk>
       ^from { <> <other-peg> <source-peg> }
       ^to { <> <other-peg> <target-peg> })
  (<h> ^disk <b-disk> ^on { <> <other-peg> <peg> })
  (<f-disk> ^larger <b-disk>)
  -->
  (<ts> ^disk-to-move <m> + &, <f> - )
  (<m> ^disk <b-disk> ^from <peg> ^to <other-peg>)
  (<s-operator> ^done? yes no - )}

###
### SET-FOCUS PROBLEM SPACE:
### OPERATOR TERMINATION
###

sp {terminate*create-focus
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name <p-name>)
  (<o> ^name create-focus)
  -->
  (<s> ^operator <o> @ )}

sp {terminate*change-focus
  (state <s> ^operator <o> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name <p-name>)
  (<o> ^name change-focus)
  -->
  (<s> ^operator <o> @ )}

###
### TOWER-OF-HANOI PROBLEM SPACE:
### MONITOR STATE AND OPERATORS
### Various productions to provide informative output to user

sp {toh*monitor*state*holds*above*disk
  (state <s> ^superstate nil ^taskstate <ts>)
  (<ts> ^holds <h>)
  (<h> ^disk <u-disk> ^above <w-disk> ^on <peg>)
  (<u-disk> ^size <u-size>)
  (<w-disk> ^size <w-size>)
  (<peg> ^name <peg-name>)
  -->
  (write (crlf) | On(| <u-size> |,| <peg-name> |),Above(| <u-size>
                |,| <w-size> |).|)}

sp {toh*monitor*state*holds*above*none
  (state <s> ^superstate nil ^taskstate <ts>)
  (<ts> ^holds <h>)
  (<h> ^disk <disk> ^above none ^on <peg>)
  (<disk> ^size <size>)
  (<peg> ^name <peg-name>)
  -->
  (write (crlf) | On(| <size> |,| <peg-name> |),Above(| <size> |,-).|)}

sp {toh*monitor*state*upper-disk
  (state <s> ^superstate nil ^taskstate <ts>)
  (<ts> ^upper-disk <disk>)
  (<disk> ^size <size>)
  -->
  (write (crlf) | Upper-Disk(| <size> |).|)}

sp {toh*monitor*state*clear
  (state <s> ^superstate nil ^taskstate <ts>)
  (<ts> ^clear <peg>)
  (<peg> ^name <name>)
  -->
  (write (crlf) | Clear(Peg(| <name> |)).|)}

sp {toh*monitor*state*disk-to-move
  (state <s> ^superstate nil ^taskstate <ts>)
  (<ts> ^disk-to-move <m>)
  (<m> ^disk <disk>)
  (<disk> ^size <size>)
  -->
  (write (crlf) | Focus(Disk(| <size> |)).|)}

sp {toh*desired-state*above*disk
  (state <s> ^desired <d> ^superstate nil)
  (<d> ^disk <u-disk> ^above <w-disk> ^on <peg>)
  (<u-disk> ^size <u-size>)
  (<w-disk> ^size <w-size>)
  (<peg> ^name <peg-name>)
  -->
  (write (crlf) | Desired[On(| <u-size> |,| <peg-name> |),Above(| <u-size>
                |,| <w-size> |)].|)}

sp {toh*desired-state*above*none
  (state <s> ^desired <d> ^superstate nil)
  (<d> ^disk <disk> ^above none ^on <peg>)
  (<disk> ^size <size>)
  (<peg> ^name <peg-name>)
  -->
  (write (crlf) | Desired[On(| <size> |,| <peg-name> |),Above(| <size>
                |,-)].|)}

sp {toh*monitor*operator-execution*move-disk
  (state <s> ^operator <o> ^taskstate <ts>)
  (<o> ^name move-disk ^disk <disk> ^done? yes
       ^from <from-peg> ^to <to-peg>)
  (<ts> ^holds <h>)
  (<h> ^disk <disk> ^on <to-peg>)
  (<disk> ^size <size>)
  (<from-peg> ^name <from-name>)
  (<to-peg> ^name <to-name>)
  -->
  (write (crlf) | Executing(Move-Disk(| <size> |,| <from-name>
                |,| <to-name> |)).|)}

### NEW PRODUCTION ******************************************
### Give an output on state of the world when it changes
### by Tim Chapman May 1997

sp {toh*display*operator-execution*move-disk
  (state <s> ^operator <o> ^taskstate <ts>)
  (<o> ^name move-disk ^disk <disk> ^done? yes
       ^from <from-peg> ^to <to-peg>)
  (<ts> ^holds <h1> ^holds <h2> ^holds <h3> ^holds <h4> ^holds <h5>)
  (<h1> ^disk.size 1 ^on <peg1>)
  (<h2> ^disk.size 2 ^on <peg2>)
  (<h3> ^disk.size 3 ^on <peg3>)
  (<h4> ^disk.size 4 ^on <peg4>)
  (<h5> ^disk.size 5 ^on <peg5>)
  (<peg1> ^name <pegname1>)
  (<peg2> ^name <pegname2>)
  (<peg3> ^name <pegname3>)
  (<peg4> ^name <pegname4>)
  (<peg5> ^name <pegname5>)
  -->
  (write (crlf) | Disk 1 on | <pegname1>
                |, Disk 2 on | <pegname2>
                |, Disk 3 on | <pegname3>
                |, Disk 4 on | <pegname4>
                |, Disk 5 on | <pegname5>)}


### TOWER NOTICING PRODUCTIONS ****************************
### by Tim Chapman
### A set of rules to notice towers of size 2 to 4

sp {toh*notice*stack-size-two
  (state <s> ^taskstate <ts>)
  (<ts> ^holds <h1> <h2>)
  (<h1> ^above none ^disk <d2> ^on <peg>)
  (<d2> ^size 2)
  (<h2> ^above <d2> ^disk <d1> ^on <peg>)
  (<d1> ^size 1)
  (<peg> ^name <pegname>)
  -->
  (<d2> ^tower yes ^moveable yes)
  (write (crlf) | *** NOTICED TOWER SIZE TWO ON PEG (| <pegname> |).|)}

sp {toh*notice*stack-size-three
  (state <s> ^taskstate <ts>)
  (<ts> ^holds <h1> <h2> <h3>)
  (<h1> ^above none ^disk <d3> ^on <peg>)
  (<d3> ^size 3)
  (<h2> ^above <d3> ^disk <d2> ^on <peg>)
  (<d2> ^size 2)
  (<h3> ^above <d2> ^disk <d1> ^on <peg>)
  (<d1> ^size 1)
  (<peg> ^name <pegname>)
  -->
  (<d3> ^tower yes ^moveable yes)
  (write (crlf) | *** NOTICED TOWER SIZE THREE ON PEG (| <pegname> |).|)}

sp {toh*notice*stack-size-four
  (state <s> ^taskstate <ts>)
  (<ts> ^holds <h1> <h2> <h3> <h4>)
  (<h1> ^above none ^disk <d4> ^on <peg>)
  (<d4> ^size 4)
  (<h2> ^above <d4> ^disk <d3> ^on <peg>)
  (<d3> ^size 3)
  (<h3> ^above <d3> ^disk <d2> ^on <peg>)
  (<d2> ^size 2)
  (<h4> ^above <d2> ^disk <d1> ^on <peg>)
  (<d1> ^size 1)
  (<peg> ^name <pegname>)
  -->
  (<d4> ^tower yes ^moveable yes)
  (write (crlf) | NOTICED TOWER SIZE FOUR ON PEG (| <pegname> |).|)}


###
### DEFAULT PRODUCTION
###

#New Default Production For The Operator-No-Change Impasse

sp {default*operator-no-change*elaborate*goal*superoperator
    :default
  (state <s*> ^impasse no-change ^attribute operator ^superstate <s1>)
  (state <s1> ^operator <o1> ^problem-space <p1> ^taskstate <ts1>)
  -->
  (<s*> ^superoperator <o1>)}

### eof of tower-of-hanoi.s

### NEW RULES FOR TOWER NOTICING **********************************
### by Tim Chapman May 1997

# Propose to move disks in towers disk rules:

sp {toh*propose*operator*move-tower-disk*onto
 "Move where target peg is clear."
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name tower-of-hanoi)
  (<ts> ^disk-to-move <m> ^peg <target-peg> ^clear <target-peg> ^holds <h>)
  (<m> ^disk <m-disk> ^from { <> <target-peg> <source-peg> }
                      ^to <target-peg>)
  (<m-disk> ^moveable yes)
  (<h> ^disk <m-disk> ^on <source-peg>)
  -->
  (<s> ^operator <o> + >)
  (<o> ^name move-disk ^disk <m-disk> ^done? no
       ^from <source-peg> ^to <target-peg>)}

sp {toh*propose*operator*move-tower-disk*above
 "Move where upper disk on the target peg is larger."
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name tower-of-hanoi)
  (<ts> ^disk-to-move <m> ^upper-disk <o-disk>
        ^peg <target-peg> -^clear <target-peg>
        ^holds <h> <i>)
  (<m> ^disk <m-disk> ^from { <> <target-peg> <source-peg> }
                      ^to <target-peg>)
  (<m-disk> ^moveable yes)
  (<h> ^disk <m-disk> ^on <source-peg>)
  (<i> ^disk <o-disk> ^on <target-peg>)
  (<o-disk> ^larger <m-disk>)
  -->
  (<s> ^operator <o> + >)
  (<o> ^name move-disk ^disk <m-disk> ^done? no
       ^from <source-peg> ^to <target-peg>)}


### TOWER-OF-HANOI PROBLEM-SPACE SUBGOAL:
### PROBLEM SPACE = BLOCKSWORLD
### INITIAL STATE = SUPERSTATE or BLOCKSWORLD
###

sp {toh*operator-no-change*create*goal-context*blocksworld
 "Create blocksworld state on impasse"
  (state <s*> ^superstate.operator <op> ^impasse no-change
              ^attribute operator ^superstate <g1>)
  (<op> ^name move-disk ^done? no)
  (<g1> ^problem-space <p1> ^taskstate <ts1>)
  -->
  (<s*> ^problem-space <p*>)
  (<p*> ^name blocksworld)
  (<s*> ^taskstate <ts1>)}

sp {blocksworld*elaborate*state*disk-to-move*blocking-disks*source
 "Elaborate the blocksworld state to mark blocking disk"
  (state <s> ^problem-space <p> ^taskstate <ts> ^superstate.operator <op>)
  (<p> ^name blocksworld)
  (<ts> ^holds <h> <i>)
  (<op> ^name move-disk ^disk <m-disk> ^from <source-peg> ^to <target-peg>)
  (<h> ^disk <m-disk> ^on <source-peg>)
  (<i> ^disk <b-disk> ^on <source-peg>)
  (<m-disk> ^larger <b-disk>)
  -->
  (<s> ^disk-blocked-by <b-disk> + & )}

sp {blocksworld*elaborate*state*disk-to-move*blocking-disks*target
 "Elaborate the blocksworld state to mark blocking disk"
  (state <s> ^problem-space <p> ^taskstate <ts> ^superstate.operator <op>)
  (<p> ^name blocksworld)
  (<ts> ^holds <h> <i>)
  (<op> ^name move-disk ^disk <m-disk>
        ^from <source-peg> ^to { <> <source-peg> <target-peg> })
  (<h> ^disk <m-disk> ^on <source-peg>)
  (<i> ^disk <b-disk> ^on <target-peg>)
  (<m-disk> ^larger <b-disk>)
  -->
  (<s> ^disk-blocked-by <b-disk> + & )}

sp {blocksworld*elaborate*state*disk-to-move*largest-blocking-disk
 "Select largest blocking disk"
  (state <s> ^problem-space <p> ^taskstate <ts>)
  (<p> ^name blocksworld)
  (<s> ^disk-blocked-by <x>)
  -{ (<s> ^disk-blocked-by <z>)
  (<z> ^larger <x>) }
  -->
  (<s> ^largest-blocking-disk <x>)}

sp {blocksworld*elaborate*state*disk-to-move*mark-other-peg
 "Select the peg that moves the blocking disk out of the way"
  (state <s> ^problem-space.name blocksworld ^superstate.operator <op>
             ^taskstate <ts>)
  (<ts> ^peg <other-peg>)
  (<op> ^name move-disk ^disk <f-disk>
        ^from { <> <other-peg> <source-peg> }
        ^to { <> <other-peg> <target-peg> })
  -->
  (<s> ^other-peg <other-peg>)}


# propose an operator to move blocking disk.

sp {blocksworld*propose*operator*try-to-clear
 "Propose move-disk operator for blocking disk"
  (state <s> ^problem-space.name blocksworld
             ^superstate.operator <op> ^taskstate <ts>)
  (<ts> ^holds <h> ^peg <peg>)
  (<op> ^disk <m-disk>)
  (<s> ^largest-blocking-disk <blocker> ^other-peg <b-dest>)
  (<h> ^disk <blocker> ^on { <> <b-dest> <peg> })
  (<m-disk> ^larger <blocker>)
  -->
  (<s> ^operator <o> + = )
  (<o> ^name move-disk ^disk <blocker> ^done? no
       ^from <peg> ^to <b-dest>)}

# implement move disk op.

sp {blocksworld*implement*operator*try-to-clear*from-nodisk-to-clear
 "Implement the move-disk operator on the blocking disk"
  (state <s> ^operator <o> ^problem-space.name blocksworld ^taskstate <ts>)
  (<o> ^name move-disk ^disk <blocker> ^done? no
       ^from <b-source> ^to <b-dest>)
  (<ts> ^upper-disk <blocker> ^clear <b-dest> ^holds <h>)
  (<h> ^disk <blocker> ^above none ^on <b-source>)
  -->
  (<h> ^on <b-dest> <b-source> - )
  (<o> ^done? yes no - )}


sp {blocksworld*implement*operator*try-to-clear*from-adisk-to-clear
 "Implement the move-disk operator on the blocking disk"
  (state <s> ^operator <o> ^problem-space.name blocksworld ^taskstate <ts>)
  (<o> ^name move-disk ^disk <blocker> ^done? no
       ^from <b-source> ^to <b-dest>)
  (<ts> ^upper-disk <blocker> ^clear <b-dest> ^holds <h>)
  (<h> ^disk <blocker> ^above { <> none <adisk>} ^on <b-source>)
  -->
  (<h> ^above none <adisk> - )
  (<h> ^on <b-dest> <b-source> - )
  (<o> ^done? yes no - )}

sp {blocksworld*implement*operator*try-to-clear*from-any-to-not-clear
 "Implement the move-disk operator on the blocking disk"
  (state <s> ^operator <o> ^problem-space.name blocksworld ^taskstate <ts>)
  (<o> ^name move-disk ^disk <blocker> ^done? no
       ^from <b-source> ^to <b-dest>)
  (<ts> ^upper-disk <blocker> { <> <blocker> <o-disk> }
        -^clear <b-dest> ^holds <h> <i>)
  (<h> ^disk <blocker> ^above <adisk-or-nodisk> ^on <b-source>)
  (<i> ^disk <o-disk> ^on <b-dest>)
  (<o-disk> ^larger <blocker>)
  -->
  (<h> ^above <o-disk> <adisk-or-nodisk> - )
  (<h> ^on <b-dest> <b-source> - )
  (<o> ^done? yes no - )}

# terminate move-disk operator.

sp {terminate*try-to-clear
  (state <s> ^operator <o> ^problem-space.name blocksworld ^taskstate <ts>)
  (<o> ^name move-disk ^done? yes)
  -->
  (<s> ^operator <o> @ ) }

### eof: Tower of Hanoi