;;;; Another Blocks World Domain definition.
;;;;
;;;; This domain description is more efficient than the one in bw.lisp

(in-package "UMCP")
(setq *run-to-finish* t)

;;;; This domain contains recursive tasks -- the depth-first search may never 
;;;; terminate. Use the best-first search. 
;;;;   (search-for-plan goal :strategy :bestfs)


(clear-domain)

(constants a b c d e)

(predicates on clear on-table)

(primitive-tasks unstack dostack restack)

(variables x y z)

(operator unstack(x y)
	  :pre ((clear x)(on x y))
	  :post ((~on x y)(on-table x)(clear y)))

(operator dostack (x y)
	  :pre ((clear x)(on-table x)(clear y))
	  :post ((~on-table x)(on x y)(~clear y)))

(operator restack (x y z)
	  :pre ((clear x)(on x y)(clear z))
	  :post ((~on x y)(~clear z)(clear y)(on x z)))

;;; put a blcok on top to the table to clear the block 
(declare-method clear(x)
		:expansion ((n1 clear y)
			    (n2 unstack y x))
		:formula (and (ord n1 n2)
			      (between (clear y) n1 n2)
			      (before (on y x) n1)))

;;; x in on another block
(declare-method on(x y)
  		:expansion ((n1 clear x)
			    (n2 clear y)
			    (n3 restack x z y))
		:formula (and (ord n1 n3)(ord n2 n3)
			      (not (veq x y))
			      (not (veq y z))
			      (not (veq x z))
			      (before (~on x y) (first n1 n2))
			      (before (~on-table x) n1)
			      (before (on x z) n1)
			      (between (clear x) n1 n3)
			      (between (clear y) n2 n3)
			      (between (on x z) n1 n3)
			      (after (on x y) n3)))
;;; x in on the table 
(declare-method on(x y)
		:expansion ((n1 clear x)
			    (n2 clear y)
			    (n3 dostack x y))
		:formula (and (ord n1 n3)(ord n2 n3)
			      (not (veq x y))
			      (before (on-table x) n1)
			      (between (clear x) n1 n3)
			      (between (clear y) n2 n3)
			      (after (on x y) n3)))

(load-poss-effects-table)

(defun sussman-anomaly()
  (clear-initial-state)
  (initially-true (on C A)(on-table B)(on-table A)
		  (clear C)(clear B))
  (setq goal (create-tn (and (after (on A B) (last n1 n2))
			     (after (on B C) (last n1 n2)))
			(n1 on B C)(n2 on A B))))

(defun sussman-anomaly-reverse()
  "same problem, but the goal tasks are specified in reverse order"
  (clear-initial-state)
  (initially-true (on C A)(on-table B)(on-table A)
		  (clear C)(clear B))
  (setq goal (create-tn (and (after (on A B) (last n1 n2))
			     (after (on B C) (last n1 n2)))
			(n1 on A B)(n2 on B C))))

;;; The tower invert problems are taken from ucpop sample problems. 
(defun tower-invert3()
  (clear-initial-state)
  (initially-true (on A B) (on B C) (on-table C)
            (clear A))
  (setq goal (create-tn (and (after (on B C)(last n1 n2))
			     (after (on C A) (last n1 n2)))
			(n1 on B C)(n2 on C A))))

(defun tower-invert3-reverse()
  "same problem, but the goal tasks are specified in reverse order"
  (clear-initial-state)
  (initially-true (on A B) (on B C) (on-table C)
		  (clear A))
  (setq goal (create-tn (and (after (on B C)(last n1 n2))
			     (after (on C A) (last n1 n2)))
			(n1 on C A)(n2 on B C))))


(defun tower-invert4()
  (clear-initial-state)
  (initially-true (on A B) (on B C) (on C D) (on-table D)
		  (clear A))
  (setq goal (create-tn (and (after (on B C)(last n1 n2 n3))
			     (after (on C D) (last n1 n2 n3))
			     (after (on D A) (last n1 n2 n3)))
			(n3 on B C) (n2 on C D) (n1 on D A))))

(defun tower-invert4-reverse()
  "same problem, but the goal tasks are specified in reverse order"
  (clear-initial-state)
  (initially-true (on A B) (on B C) (on C D) (on-table D)
		  (clear A))
  (setq goal (create-tn (and (after (on B C)(last n1 n2 n3))
			     (after (on C D) (last n1 n2 n3))
			     (after (on D A) (last n1 n2 n3)))
			(n1 on D A) (n2 on C D)(n3 on B C))))