From 0408d7057af1b0326df905b050d4659e31e1dafd Mon Sep 17 00:00:00 2001 From: Mike Pelican Date: Mon, 11 Sep 2023 13:04:30 -0500 Subject: [PATCH 01/11] Add plan-num-limit arg to find-plans New plan-num-limit arg modifies number of plans returned by search when :which is set to :first or :random when set to non-default value (default is 1). NOTE: only applies to "classic" (not explicit stack) find-plans. * shop3/shop3.lisp - Add arg to find-plans. - Update doc string. * shop3/decls.lisp - Declare *plan-num-limit*. * shop3/planning-engine/search.lisp - Check *plan-num-limit* in when-done macro. --- README.md | 2 +- shop3/decls.lisp | 1 + shop3/planning-engine/search.lisp | 3 ++- shop3/shop3.lisp | 15 ++++++++++----- 4 files changed, 14 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 5702eb68..ac70dd8f 100644 --- a/README.md +++ b/README.md @@ -119,7 +119,7 @@ you may clone with the `--recurse-submodules` option), and then: 3. Tell ASDF where to find SHOP3: ``` (asdf:initialize-source-registry - '(:source-registry (:tree SHOP3-DIRECTORY) :inherit-configuration) + '(:source-registry (:tree SHOP3-DIRECTORY) :inherit-configuration)) ``` Fill in the name of the directory of your cloned repository for `SHOP3-DIRECTORY`. 4. Enter `(asdf:load-system "shop3")` into the CL REPL. diff --git a/shop3/decls.lisp b/shop3/decls.lisp index 76c9b14c..eb62324c 100644 --- a/shop3/decls.lisp +++ b/shop3/decls.lisp @@ -95,6 +95,7 @@ (defparameter *depth-cutoff* nil) ; maximum allowable depth for SEEK-PLANS (defparameter *verbose* 1) ; default value for VERBOSE in FIND-PLANS (defparameter *which* :first) ; default value for WHICH in FIND-PLANS +(defparameter *plan-num-limit* 1) ; default value for PLAN-NUM-LIMIT in FIND-PLANS (defparameter *gc* t) ; whether to call GC each time we call SEEK-PLANS (defparameter *pp* t) ; what value to use for *PRINT-PRETTY* (defparameter *tasklist* nil) ; initial task list set to nil diff --git a/shop3/planning-engine/search.lisp b/shop3/planning-engine/search.lisp index 121516b4..e32d7cda 100644 --- a/shop3/planning-engine/search.lisp +++ b/shop3/planning-engine/search.lisp @@ -63,7 +63,8 @@ (defmacro when-done (&body body) `(when (and *plans-found* (case which-plans - ((:first :random :mcts) t) + ((:mcts) t) + ((:first :random) (>= (list-length *plans-found*) *plan-num-limit*)) (otherwise nil)) (not (optimize-continue-p which-plans))) ,@body)) diff --git a/shop3/shop3.lisp b/shop3/shop3.lisp index b9014c18..f718357e 100644 --- a/shop3/shop3.lisp +++ b/shop3/shop3.lisp @@ -104,6 +104,7 @@ MPL/GPL/LGPL triple license. For details, see the software source file.") (state-type nil state-type-supplied-p) hand-steer leashed (out-stream t) + (plan-num-limit 1) &allow-other-keys) "FIND-PLANS looks for solutions to the planning PROBLEM. PROBLEM should be a problem-designator (a PROBLEM or a symbol naming one). @@ -111,7 +112,8 @@ MPL/GPL/LGPL triple license. For details, see the software source file.") :WHICH tells what kind of search to do. Its possible values are: - :FIRST - depth-first search, returning the first plan found. + :FIRST - depth-first search, returning the first plan(s) found + (up to *plan-num-limit*). :ALL - depth-first search for *all* plans. :SHALLOWEST - depth-first search for the shallowest plan in the search space (this usually is also the shortest plan). @@ -119,9 +121,10 @@ MPL/GPL/LGPL triple license. For details, see the software source file.") :ALL-SHALLOWEST - depth-first search for all shallowest plans. :ID-FIRST - iterative deepening search, returning the first plan. :ID-ALL - iterative deepening search for all shallowest plans. - :RANDOM - Randomized search. Used by Monroe. Not for normal - SHOP3 domains, since normal SHOP3 domains have order- - dependent semantics. + :RANDOM - Randomized search. Returns plan(s) found by random + selection (subject to *plan-num-limit*). + Used by Monroe. Not for normal SHOP3 domains, since + normal SHOP3 domains have order-dependent semantics. :VERBOSE says how much information to print about the plans SHOP3 finds. Its values can be any of the following: @@ -136,6 +139,8 @@ MPL/GPL/LGPL triple license. For details, see the software source file.") :COLLECT-STATE indicates whether or not to return final state(s). For backward- compatibility, states are also returned whenever :PLAN-TREE is true. This should probably eventually change. + :PLAN-NUM-LIMIT is an int greater than or equal to 1 (its default value) + specifying a limit on the number of plans to generate. RETURN VALUES: PLANS FOUND --- a list of plans. Each plan is a list that alternates a between instantiated operators and costs @@ -210,6 +215,7 @@ MPL/GPL/LGPL triple license. For details, see the software source file.") (*hand-steer* hand-steer) (*leashed* leashed) (*domain* domain) + (*plan-num-limit* plan-num-limit) ) (apply 'find-plans-1 domain state tasks which problem :out-stream out-stream (alexandria:remove-from-plist options @@ -223,7 +229,6 @@ MPL/GPL/LGPL triple license. For details, see the software source file.") (total-run-time 0) (total-real-time 0) top-tasks) - ;; we need to be sure that the pieces of the input tasks are ;; properly recognized as being/not being variables, etc. This ;; used to be done in make-problem, but now that From c7ae6574195167842ccc853b554c43e0cba02a09 Mon Sep 17 00:00:00 2001 From: Mike Pelican Date: Tue, 12 Sep 2023 09:01:20 -0500 Subject: [PATCH 02/11] Add plan-num-limit tests Add plan-num-limit-tests test suite. --- shop3/shop3.asd | 4 +- shop3/tests/plan-num-limit-tests.lisp | 144 ++++++++++++++++++++++++++ 2 files changed, 147 insertions(+), 1 deletion(-) create mode 100644 shop3/tests/plan-num-limit-tests.lisp diff --git a/shop3/shop3.asd b/shop3/shop3.asd index 8d9923ab..0829c500 100644 --- a/shop3/shop3.asd +++ b/shop3/shop3.asd @@ -257,8 +257,9 @@ shop3." (analogical-replay-tests . :analogical-replay-tests) ; 24 (plan-tree-tests . :plan-tree-tests) ; 40 (search-tests . :search-tests) ; 9 + (plan-num-limit-tests . :plan-num-limit-tests) ; 21 ) - :num-checks 1053 + :num-checks 1074 :depends-on ((:version "shop3" (:read-file-form "shop-version.lisp-expr")) "shop3/openstacks" "shop3/pddl-helpers" @@ -302,6 +303,7 @@ shop3." (:file "sort-by-tests") ; 7 checks (:file "plan-tree-tests") ; 40 checks (:file "search-tests") ; 9 checks + (:file "plan-num-limit-tests") ; 21 checks )) ;;; FIXME: put these tests in a separate package, instead of in SHOP3-USER [2012/09/05:rpg] (:module "shop-umt" diff --git a/shop3/tests/plan-num-limit-tests.lisp b/shop3/tests/plan-num-limit-tests.lisp new file mode 100644 index 00000000..d21a398b --- /dev/null +++ b/shop3/tests/plan-num-limit-tests.lisp @@ -0,0 +1,144 @@ +;;; [mpelican:20230911.1026CDT] Derived from search-tests and uses same domain and problem. +;;; Poss this should be a suite within search-tests? + +(defpackage :plan-num-limit-tests + (:shadow #:fail) + (:import-from :alexandria #:set-equal #:setp) + (:use :shop3 :common-lisp :fiveam)) + +(in-package :plan-num-limit-tests) + +(def-suite* plan-num-limit-tests) + +(def-fixture sort-by-domain () + (let ((shop:*define-silently* t)) + (defdomain sort-by + ((:method (sorting) + (:sort-by ?v + (alt ?x ?v)) + (!choose-alt ?x)) + + (:op (!choose-alt ?x) + :add ((chosen ?x)))))) + (&body)) + +(def-fixture simple-sort-by-problem () + (let ((shop:*define-silently* t)) + ;; for some reason the following isn't quashing the warnings [2022/11/01:rpg] + (#+allegro excl:without-redefinition-warnings + #-allegro progn + (defproblem (simple-sort-by :redefine-ok t) + ((alt a 1) + (alt b 2) + (alt c 3)) + (sorting)))) + (&body)) + +;;; :all returns three, in order. +(test sort-all + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans 'simple-sort-by + :domain 'sort-by + :which :all + :verbose 0))))) + (is-true plans) + (is (= 3 (length plans))) + (is (equalp '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) + (mapcar #'shorter-plan plans))))) + +;;; :first returns one, in order. +(test sort-first-default + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans 'simple-sort-by + :domain 'sort-by + :which :first + :verbose 0))))) + (is-true plans) + (is (= 1 (length plans))) + (is (equalp '((!choose-alt a)) + (shorter-plan (first plans)))))) + +;;; :random returns one, any of three possible. +(test sort-random-default + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans 'simple-sort-by + :domain 'sort-by + :which :random + :verbose 0))))) + (is-true plans) + (is (= 1 (length plans))) + (is (member (shorter-plan (first plans)) + '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) + :test #'equalp)))) + +;;; With :plan-num-limit 2, :first returns 2, in order. +(test sort-first-limit-2 + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans 'simple-sort-by + :domain 'sort-by + :which :first + :plan-num-limit 2 + :verbose 0))))) + (is-true plans) + (is (= 2 (length plans))) + (is (equalp '(((!choose-alt a)) ((!choose-alt b))) + (mapcar #'shorter-plan plans))))) + +;;; With :plan-num-limit 2, :random returns 2, any two (different) of three possible. +(test sort-random-limit-2 + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans 'simple-sort-by + :domain 'sort-by + :which :random + :plan-num-limit 2 + :verbose 0))))) + (is-true plans) + (is (= 2 (length plans))) + (let ((shorter-plans (mapcar #'shorter-plan plans))) + (setp shorter-plans :test #'equalp) + (is (subsetp shorter-plans + '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) + :test #'equalp))))) + +;;; With :plan-num-limit 5, :first returns 3, in order. +(test sort-first-limit-5 + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans 'simple-sort-by + :domain 'sort-by + :which :first + :plan-num-limit 5 + :verbose 0))))) + (is-true plans) + (is (= 3 (length plans))) + (is (equalp '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) + (mapcar #'shorter-plan plans))))) + +;;; With :plan-num-limit 5, :random returns 3, in any order. +(test sort-random-limit-5 + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans 'simple-sort-by + :domain 'sort-by + :which :random + :plan-num-limit 5 + :verbose 0))))) + (is-true plans) + (is (= 3 (length plans))) + (let ((shorter-plans (mapcar #'shorter-plan plans))) + (setp shorter-plans :test #'equalp) + (is (set-equal shorter-plans + '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) + :test 'equalp))))) From 9a25331fd76a77991272a811b600ba5827bc46aa Mon Sep 17 00:00:00 2001 From: rpgoldman Date: Wed, 13 Sep 2023 16:18:01 -0500 Subject: [PATCH 03/11] Update shop-version.lisp-expr Bump the minor version for addition of new feature. --- shop3/shop-version.lisp-expr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shop3/shop-version.lisp-expr b/shop3/shop-version.lisp-expr index c677c356..53c86a00 100644 --- a/shop3/shop-version.lisp-expr +++ b/shop3/shop-version.lisp-expr @@ -1 +1 @@ -"3.9.1" +"3.10.0" ; 3.10 introduces :plan-num-limit From 28f9d6f15bf62e50ac3260ba08b072da5a5573b9 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Wed, 13 Sep 2023 16:42:25 -0500 Subject: [PATCH 04/11] Add :PLAN-NUM-LIMIT to ESS (FIND-PLANS-STACK). Also update the copyright on shop3.lisp. --- .../explicit-search.lisp | 28 +++++-- shop3/shop3.lisp | 4 +- shop3/tests/plan-num-limit-tests.lisp | 74 ++++++++++++++++--- 3 files changed, 87 insertions(+), 19 deletions(-) diff --git a/shop3/explicit-stack-search/explicit-search.lisp b/shop3/explicit-stack-search/explicit-search.lisp index 89207927..2c830fda 100644 --- a/shop3/explicit-stack-search/explicit-search.lisp +++ b/shop3/explicit-stack-search/explicit-search.lisp @@ -40,6 +40,7 @@ (state-type :mixed state-type-supplied-p) (out-stream t) (which :first) + (plan-num-limit 1) analogical-replay (unpack-returns t) make-analogy-table) @@ -63,6 +64,8 @@ Keyword arguments: * out-stream : where should output be printed. Default: `t` (standard output). * which : What/how many plans should be returned? Supports only `:first` (the default) and `:all`. +* plan-num-limit: an int greater than or equal to 1 (its default value) + specifying a limit on the number of plans to generate. * analogical-replay : Do search informed by the contents of the `*analogical-replay-table*`. Default: `nil`. * make-analogy-table : Populate `*analogical-replay-table*` while planning. @@ -168,6 +171,7 @@ objects." (seek-plans-stack search-state domain :unpack-returns unpack-returns :which which + :plan-num-limit plan-num-limit :repairable repairable) (setq total-run-time (- (get-internal-run-time) start-run-time) total-real-time (- (get-internal-real-time) @@ -192,7 +196,8 @@ objects." (defun seek-plans-stack (state domain &key (which :first) repairable - (unpack-returns t)) + (unpack-returns t) + plan-num-limit) "Workhorse function for FIND-PLANS-STACK. Executes the SHOP3 search virtual machine, cycling through different virtual instructions depending on the value of the MODE slot of STATE. @@ -327,18 +332,25 @@ List of analogical-replay tables -- optional ;; handle *PLANS-FOUND* based on the value of WHICH (ecase which (:first - (if plan-return - (return-from seek-plans-stack - (plan-returns *plans-found* unpack-returns)) - (return-from seek-plans-stack nil))) + (cond ((and plan-return (>= (length *plans-found*) plan-num-limit)) + (return-from seek-plans-stack + (plan-returns (reverse *plans-found*) unpack-returns))) + ;; we've found one plan, but there are possibly more plans to find... + (plan-return (stack-backtrack state)) + (t + (return-from seek-plans-stack nil)))) ;; if we want all the plans, just keep searching until we fail, ;; and then return any plans we have found. (:all (stack-backtrack state))))))) (search-failed () (case which + (:first + ;; no plans this time -- are there other plans to return? + (when *plans-found* + (plan-returns (reverse *plans-found*) unpack-returns))) (:all (when *plans-found* - (plan-returns *plans-found* unpack-returns))) + (plan-returns (reverse *plans-found*) unpack-returns))) (otherwise nil))))) @@ -508,7 +520,7 @@ of PLAN-RETURN objects." t))) (defun CHOOSE-METHOD-STATE (state domain) - "Try to apply the first of the methods in the current set of + "Try to apply the first of the methods in the current set of alternatives to the search-state STATE, using DOMAIN. Return is boolean, true if the expansion is successful, otherwise NIL to trigger backtracking." @@ -531,7 +543,7 @@ trigger backtracking." (when *enhanced-plan-tree* (let ((task-node (plan-tree:find-task-in-tree current-task plan-tree-lookup))) - + (push (record-node-expansion task-node task-expansion plan-tree-lookup :chosen-method (method-name domain method)) backtrack-stack))) diff --git a/shop3/shop3.lisp b/shop3/shop3.lisp index f718357e..be48cd3d 100644 --- a/shop3/shop3.lisp +++ b/shop3/shop3.lisp @@ -5,7 +5,7 @@ ;;(defparameter *version* "SHOP2 version 2.0 alpha") (defconstant +shopyright+ -"Copyright (C) 2004-2021 SIFT, LLC. +"Copyright (C) 2004-2023 SIFT, LLC. Original SHOP2 code Copyright (C) 2002 University of Maryland. @@ -123,7 +123,7 @@ MPL/GPL/LGPL triple license. For details, see the software source file.") :ID-ALL - iterative deepening search for all shallowest plans. :RANDOM - Randomized search. Returns plan(s) found by random selection (subject to *plan-num-limit*). - Used by Monroe. Not for normal SHOP3 domains, since + Used by Monroe. Not for normal SHOP3 domains, since normal SHOP3 domains have order-dependent semantics. :VERBOSE says how much information to print about the plans SHOP3 diff --git a/shop3/tests/plan-num-limit-tests.lisp b/shop3/tests/plan-num-limit-tests.lisp index d21a398b..6a8db0c9 100644 --- a/shop3/tests/plan-num-limit-tests.lisp +++ b/shop3/tests/plan-num-limit-tests.lisp @@ -48,28 +48,56 @@ (is (equalp '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) (mapcar #'shorter-plan plans))))) -;;; :first returns one, in order. -(test sort-first-default +(test sort-all-ess (let ((plans (with-fixture sort-by-domain () (with-fixture simple-sort-by-problem () - (find-plans 'simple-sort-by + (find-plans-stack 'simple-sort-by :domain 'sort-by - :which :first + :which :all :verbose 0))))) (is-true plans) - (is (= 1 (length plans))) - (is (equalp '((!choose-alt a)) - (shorter-plan (first plans)))))) + (is (= 3 (length plans))) + (is (equalp '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) + (mapcar #'shorter-plan plans))))) + +;;; :first returns one, in order. +(test sort-first-default + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans 'simple-sort-by + :domain 'sort-by + :which :first + :verbose 0))))) + (is-true plans) + (is (= 1 (length plans))) + (is (equalp '((!choose-alt a)) + (shorter-plan (first plans)))))) + + +(test sort-first-default-ess + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans-stack 'simple-sort-by + :domain 'sort-by + :which :first + :verbose 0))))) + (is-true plans) + (is (= 1 (length plans))) + (is (equalp '((!choose-alt a)) + (shorter-plan (first plans)))))) ;;; :random returns one, any of three possible. +;;; NOTE: :random is not yet implemented in ESS (test sort-random-default (let ((plans (with-fixture sort-by-domain () (with-fixture simple-sort-by-problem () (find-plans 'simple-sort-by :domain 'sort-by - :which :random + :which :random :verbose 0))))) (is-true plans) (is (= 1 (length plans))) @@ -92,6 +120,20 @@ (is (equalp '(((!choose-alt a)) ((!choose-alt b))) (mapcar #'shorter-plan plans))))) +(test sort-first-limit-2-ess + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans-stack 'simple-sort-by + :domain 'sort-by + :which :first + :plan-num-limit 2 + :verbose 0))))) + (is-true plans) + (is (= 2 (length plans))) + (is (equalp '(((!choose-alt a)) ((!choose-alt b))) + (mapcar #'shorter-plan plans))))) + ;;; With :plan-num-limit 2, :random returns 2, any two (different) of three possible. (test sort-random-limit-2 (let ((plans @@ -125,6 +167,20 @@ (is (equalp '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) (mapcar #'shorter-plan plans))))) +(test sort-first-limit-5-ess + (let ((plans + (with-fixture sort-by-domain () + (with-fixture simple-sort-by-problem () + (find-plans-stack 'simple-sort-by + :domain 'sort-by + :which :first + :plan-num-limit 5 + :verbose 0))))) + (is-true plans) + (is (= 3 (length plans))) + (is (equalp '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) + (mapcar #'shorter-plan plans))))) + ;;; With :plan-num-limit 5, :random returns 3, in any order. (test sort-random-limit-5 (let ((plans @@ -141,4 +197,4 @@ (setp shorter-plans :test #'equalp) (is (set-equal shorter-plans '(((!choose-alt a)) ((!choose-alt b)) ((!choose-alt c))) - :test 'equalp))))) + :test 'equalp))))) From a961f80727bd534ac5802ca1bbfcdd3924a0707a Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Wed, 13 Sep 2023 16:47:35 -0500 Subject: [PATCH 05/11] Update test count. --- shop3/shop3.asd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/shop3/shop3.asd b/shop3/shop3.asd index 0829c500..1552f037 100644 --- a/shop3/shop3.asd +++ b/shop3/shop3.asd @@ -257,9 +257,9 @@ shop3." (analogical-replay-tests . :analogical-replay-tests) ; 24 (plan-tree-tests . :plan-tree-tests) ; 40 (search-tests . :search-tests) ; 9 - (plan-num-limit-tests . :plan-num-limit-tests) ; 21 + (plan-num-limit-tests . :plan-num-limit-tests) ; 25 ) - :num-checks 1074 + :num-checks 1079 :depends-on ((:version "shop3" (:read-file-form "shop-version.lisp-expr")) "shop3/openstacks" "shop3/pddl-helpers" From e8f391c6b3b36e1cadba68b1dfc1ab8810159f73 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Wed, 13 Sep 2023 17:55:16 -0500 Subject: [PATCH 06/11] Fix type specifier bug. --- shop3/explicit-stack-search/explicit-search.lisp | 1 + 1 file changed, 1 insertion(+) diff --git a/shop3/explicit-stack-search/explicit-search.lisp b/shop3/explicit-stack-search/explicit-search.lisp index 2c830fda..958eaf37 100644 --- a/shop3/explicit-stack-search/explicit-search.lisp +++ b/shop3/explicit-stack-search/explicit-search.lisp @@ -28,6 +28,7 @@ (:state-type symbol) (:out-stream (or t stream)) (:which (member :first :all)) + (:plan-num-limit (and (integer 0) fixnum)) (:analogical-replay t) (:unpack-returns t) (:make-analogy-table t)) From cec6143b0339abd6ff9209898abcf463f16cb1db Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Thu, 14 Sep 2023 10:06:39 -0500 Subject: [PATCH 07/11] Fix missing argument. --- shop3/explicit-stack-search/plan-repair.lisp | 6 +++--- shop3/tests/replan-tests.lisp | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/shop3/explicit-stack-search/plan-repair.lisp b/shop3/explicit-stack-search/plan-repair.lisp index c41f8676..c9d6463d 100644 --- a/shop3/explicit-stack-search/plan-repair.lisp +++ b/shop3/explicit-stack-search/plan-repair.lisp @@ -123,7 +123,7 @@ BEFORE the insertion of FAILED into the plan tree.") (error "Unable to find a stack entry for failed node ~A" failed))))) -(defun replan-from-failure (domain failed-tree-node search-state &key (verbose 0)) +(defun replan-from-failure (domain failed-tree-node search-state &key (verbose 0) (plan-num-limit 1)) (let ((*verbose* verbose) (*domain* domain)) (when (>= *verbose* 2) @@ -144,7 +144,7 @@ BEFORE the insertion of FAILED into the plan tree.") ;; for solving this task, not find a different task. (setf (mode search-state) 'expand-task) ;; must be "repairable" so that we don't strip NOPs. - (seek-plans-stack search-state domain :repairable t)))) + (seek-plans-stack search-state domain :plan-num-limit plan-num-limit :repairable t)))) ;;; This is a very messy function: it's supposed to grab fresh copies ;;; of actions (i.e., the actions in the PLAN, which is a replan) in @@ -225,7 +225,7 @@ Modified search state object." #+ignore(break "Inside FREEZE-STATE, before adding divergences, world state is: ~S" new-state-obj) ;; now put the divergences into effect, taking sleazy advantage of the fact that the ;; world state tag increments by two. - (let ((new-tag + (let ((new-tag (shop2.common:tag-state new-state-obj 1))) (iter (for (op fact) in divergence) (ecase op diff --git a/shop3/tests/replan-tests.lisp b/shop3/tests/replan-tests.lisp index e1cccb3c..e793e0dd 100644 --- a/shop3/tests/replan-tests.lisp +++ b/shop3/tests/replan-tests.lisp @@ -47,7 +47,7 @@ (unwind-protect (shop3:repair-plan domain plan plan-tree executed divergence search-state :plan-tree-hash plan-tree-hash) (shop-untrace)) - + ;;(list executed plan) (values (validate-replan repaired :shop-domain domain :package package @@ -84,7 +84,7 @@ (flet ((put-in-package (sexp) (let ((pddl-utils:*pddl-package* (find-package 'shop3-openstacks))) (pddl-utils:pddlify-tree sexp)))) - (is-true (test-replan)) + (is-true (test-replan)) (is-true (test-replan :failed-action (put-in-package '(!START-ORDER O3 N4 N3)) :divergence (put-in-package From a810a978137fbfbf7909cb63fc7119b29062dd14 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Thu, 14 Sep 2023 10:45:52 -0500 Subject: [PATCH 08/11] Fix bug revealed by new k-plans logic. Previously, because we were pushing onto the set of plans found, I didn't notice that we did not re-bind `*plans-found*` as required. --- shop3/explicit-stack-search/explicit-search.lisp | 3 ++- shop3/explicit-stack-search/plan-repair.lisp | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/shop3/explicit-stack-search/explicit-search.lisp b/shop3/explicit-stack-search/explicit-search.lisp index 958eaf37..b6db971b 100644 --- a/shop3/explicit-stack-search/explicit-search.lisp +++ b/shop3/explicit-stack-search/explicit-search.lisp @@ -335,7 +335,8 @@ List of analogical-replay tables -- optional (:first (cond ((and plan-return (>= (length *plans-found*) plan-num-limit)) (return-from seek-plans-stack - (plan-returns (reverse *plans-found*) unpack-returns))) + (plan-returns (reverse *plans-found*) + unpack-returns))) ;; we've found one plan, but there are possibly more plans to find... (plan-return (stack-backtrack state)) (t diff --git a/shop3/explicit-stack-search/plan-repair.lisp b/shop3/explicit-stack-search/plan-repair.lisp index c9d6463d..fda604cf 100644 --- a/shop3/explicit-stack-search/plan-repair.lisp +++ b/shop3/explicit-stack-search/plan-repair.lisp @@ -125,7 +125,8 @@ BEFORE the insertion of FAILED into the plan tree.") (defun replan-from-failure (domain failed-tree-node search-state &key (verbose 0) (plan-num-limit 1)) (let ((*verbose* verbose) - (*domain* domain)) + (*domain* domain) + *plans-found*) (when (>= *verbose* 2) (format t "~&World state before backjump is:~%") (pprint (state-atoms (world-state search-state)))) From d18f3b7e6b577ff0d0b6bab0ef0e985b679a3740 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Thu, 14 Sep 2023 10:49:35 -0500 Subject: [PATCH 09/11] Muffle excessive test output. --- shop3/tests/replan-tests.lisp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/shop3/tests/replan-tests.lisp b/shop3/tests/replan-tests.lisp index e793e0dd..c8c37e51 100644 --- a/shop3/tests/replan-tests.lisp +++ b/shop3/tests/replan-tests.lisp @@ -45,7 +45,8 @@ (equalp (second (reverse executed)) failed-action))) (multiple-value-bind (repaired new-plan-tree) (unwind-protect - (shop3:repair-plan domain plan plan-tree executed divergence search-state :plan-tree-hash plan-tree-hash) + (shop3:repair-plan domain plan plan-tree executed divergence search-state :plan-tree-hash plan-tree-hash + :verbose 0) (shop-untrace)) ;;(list executed plan) From ddbcb6b4a61d0d1a9f4bc0dcc579c8d26ca2c8e9 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Thu, 14 Sep 2023 12:10:57 -0500 Subject: [PATCH 10/11] Fix incorrect test count. --- shop3/shop3.asd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shop3/shop3.asd b/shop3/shop3.asd index 1552f037..0dfcd80e 100644 --- a/shop3/shop3.asd +++ b/shop3/shop3.asd @@ -259,7 +259,7 @@ shop3." (search-tests . :search-tests) ; 9 (plan-num-limit-tests . :plan-num-limit-tests) ; 25 ) - :num-checks 1079 + :num-checks 1086 :depends-on ((:version "shop3" (:read-file-form "shop-version.lisp-expr")) "shop3/openstacks" "shop3/pddl-helpers" From 8f0e6b3d331246b072ee364713f01fc15ba6097c Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Thu, 14 Sep 2023 16:51:11 -0500 Subject: [PATCH 11/11] Fix type declaration. Lower bound for plan-num-limit is 1, not zero. --- shop3/explicit-stack-search/explicit-search.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shop3/explicit-stack-search/explicit-search.lisp b/shop3/explicit-stack-search/explicit-search.lisp index b6db971b..95de9fba 100644 --- a/shop3/explicit-stack-search/explicit-search.lisp +++ b/shop3/explicit-stack-search/explicit-search.lisp @@ -28,7 +28,7 @@ (:state-type symbol) (:out-stream (or t stream)) (:which (member :first :all)) - (:plan-num-limit (and (integer 0) fixnum)) + (:plan-num-limit (and (integer 1) fixnum)) (:analogical-replay t) (:unpack-returns t) (:make-analogy-table t))