From 9a94989b55870d3689ad1781d15d831307ee63dc Mon Sep 17 00:00:00 2001 From: Naoki-Hiraoka Date: Fri, 19 Jun 2020 22:39:48 +0900 Subject: [PATCH] [pddl_planner/demos/2013_fridge_demo] fix bug --- .../demos/2013_fridge_demo/solve-bring-can.l | 99 ++++++++++--------- pddl/pddl_planner/src/eus-pddl.l | 36 ++++--- 2 files changed, 75 insertions(+), 60 deletions(-) diff --git a/pddl/pddl_planner/demos/2013_fridge_demo/solve-bring-can.l b/pddl/pddl_planner/demos/2013_fridge_demo/solve-bring-can.l index f55c0014..134efa6e 100755 --- a/pddl/pddl_planner/demos/2013_fridge_demo/solve-bring-can.l +++ b/pddl/pddl_planner/demos/2013_fridge_demo/solve-bring-can.l @@ -53,30 +53,16 @@ (AT PREGRASP)) :effect '((ONHAND ?OBJ))) - (instance pddl-action :init - :name "grasp_f" - :parameters '((?OBJ object)) - :precondition '((NOT (ONHAND ?OBJ)) - (NOT (CLOSED)) - (AT PREGRASP)) - :effect '()) - (instance pddl-action :init :name "move-to" :parameters '((?FROM ?TO spot)) :precondition '((AT ?FROM) (NOT (= ?FROM SOMEWHERE)) - (NOT (= ?FROM ?TO))) - :effect '((AT ?TO) - (NOT (AT ?FROM)))) - (instance pddl-action :init - :name "move-to_f" - :parameters '((?FROM ?TO spot)) - :precondition '((AT ?FROM) (NOT (= ?TO SOMEWHERE)) (NOT (= ?FROM ?TO))) - :effect '((AT SOMEWHERE) + :effect '((AT ?TO) (NOT (AT ?FROM)))) + (instance pddl-action :init :name "move-recoverly" :parameters '() @@ -85,13 +71,6 @@ :effect '((AT FRONTFRIDGE) (NOT (AT SOMEWHERE)))) - (instance pddl-action :init - :name "move_rec_f" - :parameters '() - :precondition '((AT SOMEWHERE) - (CLOSED)) - :effect '()) - (instance pddl-action :init :name "open-door" :parameters '() @@ -100,14 +79,6 @@ (CLOSED)) :effect '((NOT (CLOSED)))) - (instance pddl-action :init - :name "open_f" - :parameters '() - :precondition '((AT FRONTFRIDGE) - (NOT (ONHAND CAN)) - (CLOSED)) - :effect '()) - (instance pddl-action :init :name "close-door" :parameters '() @@ -115,13 +86,6 @@ (AT PRECLOSE)) :effect '((CLOSED))) - (instance pddl-action :init - :name "close_f" - :parameters '() - :precondition '((NOT (CLOSED)) - (AT PRECLOSE)) - :effect '()) - (instance pddl-action :init :name "try-close" :parameters '() @@ -129,13 +93,6 @@ (AT SOMEWHERE)) :effect '((CLOSED))) - (instance pddl-action :init - :name "close_try_f" - :parameters '() - :precondition '((NOT (CLOSED)) - (AT SOMEWHERE)) - :effect '()) - )) ;;add action to domain (dolist (act *action-list*) @@ -144,7 +101,57 @@ ;; ;; solve planning ;; -(setq *failed-nodes* (list 'move-to)) +(setq *failed-nodes* + (list + (list 'move-to + (instance pddl-action :init + :name "move-to_f" + :parameters '((?FROM ?TO spot)) + :precondition '((AT ?FROM) + (NOT (= ?FROM SOMEWHERE)) + (NOT (= ?TO SOMEWHERE)) + (NOT (= ?FROM ?TO))) + :effect '((AT SOMEWHERE) + (NOT (AT ?FROM))))) + (list 'grasp-object + (instance pddl-action :init + :name "grasp_f" + :parameters '((?OBJ object)) + :precondition '((NOT (ONHAND ?OBJ)) + (NOT (CLOSED)) + (AT PREGRASP)) + :effect '())) + (list 'move-recoverly + (instance pddl-action :init + :name "move_rec_f" + :parameters '() + :precondition '((AT SOMEWHERE) + (CLOSED)) + :effect '())) + (list 'open-door + (instance pddl-action :init + :name "open_f" + :parameters '() + :precondition '((AT FRONTFRIDGE) + (NOT (ONHAND CAN)) + (CLOSED)) + :effect '())) + + (list 'close-door + (instance pddl-action :init + :name "close_f" + :parameters '() + :precondition '((NOT (CLOSED)) + (AT PRECLOSE)) + :effect '())) + (list 'try-close + (instance pddl-action :init + :name "close_try_f" + :parameters '() + :precondition '((NOT (CLOSED)) + (AT SOMEWHERE)) + :effect '())) + )) (setq *graph* (pddl-plan-to-graph nil :domain *domain* :problem *problem* :failed-nodes *failed-nodes* :debug t)) (pprint *result*) diff --git a/pddl/pddl_planner/src/eus-pddl.l b/pddl/pddl_planner/src/eus-pddl.l index f85101da..983e5284 100644 --- a/pddl/pddl_planner/src/eus-pddl.l +++ b/pddl/pddl_planner/src/eus-pddl.l @@ -594,13 +594,17 @@ )) (:check-condition (st act) - (let ((action (find-if #'(lambda (x) - (equal - (or - (and (send self :use-durative-action) - (caaddr act)) - (car act)) - (intern (string-upcase (send x :name))))) (send domain :action))) + (let ((action (if (and (not (atom (car act))) + (not (send self :use-durative-action)) + (derivedp (caar act) pddl-action)) + (caar act) + (find-if #'(lambda (x) + (equal + (or + (and (send self :use-durative-action) + (caaddr act)) + (car act)) + (intern (string-upcase (send x :name))))) (send domain :action)))) param pcond) (unless action (return-from :check-condition nil)) @@ -707,13 +711,17 @@ )) (:apply-action (st act) (if (send self :check-condition st act) - (let ((action (find-if #'(lambda (x) - (equal - (or - (and (send self :use-durative-action) - (caaddr act)) - (car act)) - (intern (string-upcase (send x :name))))) (send domain :action))) + (let ((action (if (and (not (atom (car act))) + (not (send self :use-durative-action)) + (derivedp (caar act) pddl-action)) + (caar act) + (find-if #'(lambda (x) + (equal + (or + (and (send self :use-durative-action) + (caaddr act)) + (car act)) + (intern (string-upcase (send x :name))))) (send domain :action)))) param effect (tmp-st st)) (unless action (return-from :apply-action nil))