;;; -*- Mode: LISP; Syntax: Common-lisp; Package: sipe-cl; Base: 10; -*-

(in-package :sipe)

;This domain encodes the standard tower of hanoi problem.
;SIPE solves both the 3 disk and 4 disk problems with this file.
; 3 disk takes 14 planning levels and 1.3 seconds, 217 pnodes
; 4 disks takes 26 planning levels and 10.8 seconds, 795 pnodes
; (times on Sun Ultra 1)

(setq *DEFAULT-DEPTH-LIMIT* 29)
(setq RECHECK-PHAN-DEDUCE nil)
(setq *CHECK-PRECONDS-IN-INTERP* nil)
(setq *RESOURCE-FREQUENCY* 0) (setq *CBG-FREQUENCY* 0)
(setq REMOVE-REDUNDANT-ACTIONS-FREQUENCY 0)
(setq ADD-PROTECT-UNTILS nil)
(setq *ALL-EFFECTS-NEW* t)


(DEFINE.DOMAIN)

CLASS PEG
 INSTANCES:  A,B,C;
END CLASS

CLASS DISK
 INSTANCES:  DA,DB,DC,DD,ABASE,BBASE,CBASE;
END CLASS
;have ABASE be top of A when no disks on it, all disks smaller than bases
;this makes oprs like move-to-ok-peg work for empty pegs

STOP

(DEFINE.DOMAIN)

NO-CHANGE-PREDICATES:
(SMALLER)

PREDICATES:

(SMALLER DA DB)(SMALLER DB DC)(SMALLER DC DD)
(SMALLER DD ABASE)(SMALLER DD BBASE)(SMALLER DD CBASE)

(ON DA DB)
(ON DB DC)
(ON DC Dd)
(ON DD ABASE)

(CLEAR DA) (CLEAR BBASE) (CLEAR CBASE)

(top da a) (top BBASE B) (top CBASE C)

(ONPEG DA A) (ONPEG DB A) (ONPEG DC A) (ONPEG DD A)
(ONPEG ABASE A) (ONPEG BBASE B) (ONPEG CBASE C)

END PREDICATES

STOP

(DEFINE.DOMAIN)

;General idea is that we must get SIPE to plan things in the right order so it will know
;what the world looks like.

;Predicate PUTON-PEG is an intention to move a disk to a peg, even though the disk
;may be at the bottom of a stack.  It deduces a DELAY predicate that is used to keep
;later actions from planning movements of smaller disks (since their location will change
;during solution of the PUTON-PEG goal).
;Will not translate from an ON DISK DISK goal to a PUTON-PEG DISK PEG goal when a DELAY is true for either disk


;(CLEAR-MOVE disk1 peg2 peg1) goal will wait until disk1 is clear, then it will
;begin clearing destination peg1 of smaller disks so as to move disk1 from peg2 to peg1

;;;;================================================== Oprs to clear disk to be moved


OPERATOR: Move-unclear-disk
ARGUMENTS: disk1, peg1, peg2 is not peg1, disk2, peg3 is not peg1 is not peg2;
PURPOSE: (PUTON-PEG DISK1 peg1);
PRECONDITION: (ONPEG DISK1 peg2), (on disk2 DISK1);
PLOT:
 GOAL: (puton-peg disk2 peg3);
 GOAL: (clear-move disk1 peg2 peg1);
END PLOT END OPERATOR
;this starts move of blocking disc 


OPERATOR: Move-clear-disk
ARGUMENTS: disk1, peg1, peg2 is not peg1;
PURPOSE: (PUTON-PEG DISK1 peg1);
PRECONDITION: (ONPEG DISK1 peg2), (clear DISK1);
PLOT:
 GOAL: (clear-move disk1 peg2 peg1) ;
END PLOT END OPERATOR



;================================= Process delays thru (on disk disk) goals

OPERATOR: wait
ARGUMENTS: disk1,disk2;
PURPOSE: (on disk1 disk2);
PRECONDITION: (or (delay disk1) (delay disk2));
PLOT: copy
END PLOT END OPERATOR

;stack disks is used only when delay not applicable
; assume that disk1 always smaller than disk2
OPERATOR: stack-disks
ARGUMENTS: disk1,disk2,peg1;
PURPOSE: (on disk1 disk2);
PRECONDITION: (onpeg disk2 peg1), -(delay DISK1), -(delay DISK2);
PLOT:
  GOAL: (puton-peg disk1 peg1);
END PLOT END OPERATOR



;   ====================== Clear-move oprs to clear destination peg 

OPERATOR: wait-for-clear-disk
ARGUMENTS: disk1,peg2,peg1,disk2,peg3 is not peg1 is not peg2 ;
PURPOSE: (clear-move disk1 peg2 peg1) ;
PRECONDITION: (on disk2 disk1), (puton-peg disk2 peg3) ;
PLOT:  COPY
END PLOT END OPERATOR
;wait until disk1 is clear


OPERATOR: clear-flotsam
ARGUMENTS: disk1,peg2,peg1,disk2,peg3 is not peg1 is not peg2 ;
PURPOSE: (clear-move disk1 peg2 peg1) ;
PRECONDITION: (on disk2 disk1), (puton-peg disk2 peg2);
PLOT:
 GOAL: (puton-peg disk2 peg3);
 GOAL: (clear-move disk1 peg2 peg1);
END PLOT END OPERATOR
;this removes flotsam left over from a previous clear attempt 
;  (ie (puton-peg disk2 peg2) indicates disk2 put on top purposefully)
;(eg if ABC where on disk1 and you moved C to get disk1 clear, you may be left with A on disk1)


OPERATOR: move-to-ok-peg
ARGUMENTS: disk1,peg2,peg1,disk2,disk3 class universal;
PURPOSE: (clear-move disk1 peg2 peg1) ;
PRECONDITION: (clear disk1), (top disk2 peg1), (smaller disk1 disk2);
PLOT:
  PROCESS
        ACTION: MOVEDISK;
	ARGUMENTS: Disk1,peg1;
	EFFECTS: (ONPEG DISK1 peg1);
END PLOT END OPERATOR


OPERATOR: wait-for-clear-of-blocked-peg
ARGUMENTS: disk1,peg2,peg1,disk2,disk3,peg3 is not peg1 is not peg2;
PURPOSE: (clear-move disk1 peg2 peg1) ;
PRECONDITION: (clear disk1), (onpeg disk2 peg1), (on disk2 disk3), (smaller disk2 disk1),
    (smaller disk1 disk3), (puton-peg disk2 peg3);
PLOT:  COPY
END PLOT END OPERATOR
;wait for a clearing that's alredy in progress (ie (puton-peg disk2 peg3))


OPERATOR: move-to-blocked-peg
ARGUMENTS: disk1,peg2,peg1,disk2,disk3,peg3 is not peg1 is not peg2;
PURPOSE: (clear-move disk1 peg2 peg1) ;
PRECONDITION: (clear disk1), (onpeg disk2 peg1), (on disk2 disk3), (smaller disk2 disk1),
    (smaller disk1 disk3), -(puton-peg disk2 peg3) ;
PLOT:
  GOAL: (puton-peg disk2 peg3);
  GOAL: (clear-move disk1 peg2 peg1);
END PLOT END OPERATOR
;find largest of disks smaller than disk1 and move it off peg1, then recurse



;=============================================== Deductive operators

INIT.OPERATOR: SMALLER-TRANSITIVE
ARGUMENTS: DISK1,DISK2,DISK3 IS NOT DISK2;
TRIGGER: (SMALLER DISK1 DISK2);
PRECONDITION: (SMALLER DISK2 DISK3);
EFFECTS: (SMALLER DISK1 DISK3);
END INIT.OPERATOR


CAUSAL-RULE: deduce-from-onpeg
ARGUMENTS: DISK1,PEG1,DISK2,DISK3 IS NOT DISK2,PEG2 IS NOT PEG1;
TRIGGER: (ONPEG DISK1 PEG1);
PRECONDITION: (ON DISK1 DISK3),(TOP DISK2 PEG1),(ONPEG DISK1 PEG2);
EFFECTS: (CLEAR DISK3), -(CLEAR disk2),
(ON DISK1 disk2),-(ON DISK1 DISK3),-(ONPEG DISK1 PEG2),
-(TOP DISK1 PEG2), (top DISK3 PEG2), (top DISK1 PEG1), -(top disk2 PEG1);
END CAUSAL-RULE
;should these also be deduce from clear-move? No probably copied down.


STATE-RULE: delay-smaller
ARGUMENTS: DISK1,peg1,DISK2 class universal;
TRIGGER: (puton-peg disk1 peg1);
CONDITION: (smaller DISK2 DISK1);
EFFECTS: (delay DISK2);
END STATE-RULE


STATE-RULE: undelay
ARGUMENTS: DISK1,peg1,DISK2 class universal ;
TRIGGER: (onpeg disk1 peg1);
CONDITION: (smaller DISK2 DISK1);
EFFECTS: -(delay DISK2);
END STATE-RULE
;when move finally made, must undo all the DELAY predicates


;the following two rules keep previous moves from phantomizing later move goals
STATE-RULE: only-one-puton
ARGUMENTS: DISK1,PEG1,PEG2 CLASS UNIVERSAL IS NOT PEG1;
TRIGGER: (puton-peg DISK1 PEG1);
EFFECTS: (NOT (puton-peg DISK1 PEG2));
END STATE-RULE
;anything that has just changed pegs is not going to any other peg
 
STATE-RULE: only-one-clear-move
ARGUMENTS: DISK1,PEG1,PEG2, peg3 CLASS UNIVERSAL IS NOT PEG1,peg4 CLASS UNIVERSAL IS NOT PEG2;
TRIGGER: (clear-move disk1 peg1 peg2) ;
EFFECTS: -(clear-move disk1 peg3 peg4);
END STATE-RULE

STOP


(INIT.DEDUCE)

(DEFINE.PROBLEM)


PROBLEM: four-disks
  GOAL: (ON DD CBASE);
  GOAL: (ON DC DD);
  GOAL: (ON DB DC);
  GOAL: (ON DA DB);
END PROBLEM

PROBLEM: three-disks
  GOAL: (ON DC CBASE);
  GOAL: (ON DB DC);
  GOAL: (ON DA DB);
END PROBLEM

STOP





;simpler version of clear-flotsam, but takes an extra planning level for each application
;OPERATOR: clear-flotsam
;ARGUMENTS: disk1,peg2,peg1,disk2;
;PURPOSE: (clear-move disk1 peg2 peg1) ;
;PRECONDITION: (on disk2 disk1), (puton-peg disk2 peg2);
;PLOT:
;  GOAL: (puton-peg disk1 peg1);
;END PLOT END OPERATOR
;this removes flotsam left over from a previous clear attempt
;(eg if ABC where on disk1 and you moved C to get disk1 clear, you may be left with A on disk1)