Issue 146: Feature: add arg to find-plans that limits number of plans returned (shop classic and ESS)

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.

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

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 1) fixnum))
                                  (:analogical-replay t)
                                  (:unpack-returns t)
                                  (:make-analogy-table t))
@@ -40,6 +41,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 +65,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 +172,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 +197,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 +333,26 @@ 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 +522,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 +545,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)))

shop3/explicit-stack-search/plan-repair.lisp

@@ -123,9 +123,10 @@ 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))
+        (*domain* domain)
+        *plans-found*)
     (when (>= *verbose* 2)
       (format t "~&World state before backjump is:~%")
       (pprint (state-atoms (world-state search-state))))
@@ -144,7 +145,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 +226,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

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))

shop3/shop-version.lisp-expr

@@ -1 +1 @@
-"3.9.1"
+"3.10.0" ; 3.10 introduces :plan-num-limit

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) ; 25
                  )
-    :num-checks 1053
+    :num-checks 1086
     :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"

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.
 
@@ -104,24 +104,27 @@ 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).
    The keyword arguments are as follows:
 
      :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).
                       If there's more than one such plan, return the first.
         :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