;;;; ---- BLOCKS WORLD DOMAIN ----

(in-package "UMCP")
(setq *run-to-finish* t) ; automatic plan generation

(clear-domain) ; clear existing domain definitions

;;;; --------- Symbol declarations -----------
(constants a b c table) ; declare constant symbols

(predicates on clear) ; declare predicate symbols

(compound-tasks move) ; declare compound task symbols

(primitive-tasks unstack dostack restack) ; declare primitive task symbols

(variables x y z) ; declare variable symbols


;;;; -------- Effects specifications -----------
;; primitive task UNSTACK - move a block x on top of y to the table
(operator unstack(x y)
          :pre ((clear x)(on x y))
          :post ((~on x y)(on x table)(clear y)))

;; primitive task DOSTACK - move a block x on the table to the top of y
(operator dostack (x y)
          :pre ((clear x)(on x table)(clear y))
          :post ((~on x table)(on x y)(~clear y)))

;; primitive task RESTACK - move a block x on top of y to the top of 
;; another block z
(operator restack (x y z)
          :pre ((clear x)(on x y)(clear z))
          :post ((~on x y)(~clear z)(clear y)(on x z)))

;;;; --------  Methods descriptions ------------
;; compound task CLEAR 
(declare-method clear(x)
                :expansion ((n1 clear y)
                            (n2 unstack y x))
                :formula (and (not (veq x table))
                              (ord n1 n2)
                              (between (clear y) n1 n2)
                              (before (on y x) n1)))

(declare-method move(x y z)
                :expansion ((n restack x y z))
                :formula (and (not (veq y table))
                              (not (veq x table))
                              (not (veq z table))
                              (before (clear x) n)
                              (before (clear z) n)
                              (before (on x y) n)))

(declare-method move(x y z)
                :expansion ((n dostack x z))
                :formula (and (veq y table)
                              (before (clear x) n)
                              (before (on x y) n)))

(declare-method on(x y)
                :expansion ((n1 clear x)
                            (n2 clear y)
                            (n3 move 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 x z) n1)
                              (between (clear x) n1 n3)
                              (between (clear y) n2 n3)
                              (between (on x z) n1 n3)))

;;;; ---- Loading Possible Effects Table -----
(load-poss-effects-table)

;;;; ---- Problem definitions -----

;; To run this problem load this file and then
;; >(sussman-anomaly) 
;; >(search-for-plan goal :strategy :bestfs)

(defun sussman-anomaly()
  (clear-initial-state)
  (initially-true (on C A)(on B table)(on A table)
                  (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))))

(defun prob1 ()
  (clear-initial-state)
  (initially-true (on C A)(on B table)(on A table)
                  (clear C)(clear B))
  (setq goal (create-tn T (n on A B))))

(defun prob2 ()
  (clear-initial-state)
  (initially-true (on C A)(on B table)(on A table)
                  (clear C)(clear B))
  (setq goal (create-tn T (n on B C))))

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

Web Accessibility