From 70be97a797c70da86ecb35489ef516454f1457bf Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Thu, 19 Oct 2023 10:21:59 -0500 Subject: [PATCH] Fix errors from rebasing. --- shop3/decls.lisp | 1 + shop3/hddl/hddl-plan.lisp | 10 ---------- shop3/package.lisp | 7 +++++-- shop3/planning-tree/tree-accessors.lisp | 6 ++++-- shop3/planning-tree/tree-reductions.lisp | 15 +++++---------- shop3/shop3.lisp | 1 + 6 files changed, 16 insertions(+), 24 deletions(-) diff --git a/shop3/decls.lisp b/shop3/decls.lisp index eb62324c..e12db6ab 100644 --- a/shop3/decls.lisp +++ b/shop3/decls.lisp @@ -89,6 +89,7 @@ (defvar *operator-tasks*) ; record of the task atom for operators (declaim (type hash-table *operator-tasks* *task-operator*)) (defvar *task-operator*) ; inverse of *operator-tasks* +(defvar *reduction-labels*) ; support recording method labels in plan tree (defparameter *optimize-cost* nil) ; whether to optimize with branch and bound (defparameter *optimal-plan* 'fail) ; optimal plan found so far (defparameter *optimal-cost* 0) ; cost of *optimal-plan* diff --git a/shop3/hddl/hddl-plan.lisp b/shop3/hddl/hddl-plan.lisp index 9d157513..2b1e655b 100644 --- a/shop3/hddl/hddl-plan.lisp +++ b/shop3/hddl/hddl-plan.lisp @@ -103,13 +103,3 @@ and prints it to STREAM in the IPC format." (defun forest-roots (plan-tree) (mapcar #'shop:tree-node-task plan-tree)) - -(declaim (ftype (function (list hash-table) (only-value list)) - tree-decompositions)) -(defun tree-decompositions (plan-forest task-indices &optional (stream t)) - (iter (with open = plan-forest) - (while open) - (as node = (pop open)) - (if (shop:complex-node-p node) - )) - ) diff --git a/shop3/package.lisp b/shop3/package.lisp index 088bcd00..fad8ccb8 100644 --- a/shop3/package.lisp +++ b/shop3/package.lisp @@ -243,7 +243,7 @@ #:adl-mixin #:adl-domain #:fluents-mixin - + ;; MIXIN #:pure-logic-domain-mixin @@ -259,10 +259,13 @@ #:complex-node-p #:complex-node-task #:complex-node-children + #:complex-node-reduction-label + #:complex-node #:primitive-node-p #:primitive-node-task #:primitive-node-cost #:primitive-node-position + #:primitive-node #:remove-internal-operators #:tree-node-task #:tree-node-task-name @@ -284,7 +287,7 @@ #:singleton-variable #:incorrect-arity-error #:incomplete-dependency-error - + ;; things you might want to use in your domain definitions #:variablep diff --git a/shop3/planning-tree/tree-accessors.lisp b/shop3/planning-tree/tree-accessors.lisp index 1a2c1d8b..b53fa5f9 100644 --- a/shop3/planning-tree/tree-accessors.lisp +++ b/shop3/planning-tree/tree-accessors.lisp @@ -54,7 +54,7 @@ ;;; markings. (in-package :shop) -(defstruct (complex-node (:type list) +(defstruct (complex-node (:type list) (:constructor make-complex-node (task children &key reduction-label))) task (reduction-label nil :type symbol) @@ -328,7 +328,9 @@ tree (although they will be EQUALP." (primitive-node-task node) (primitive-node-position node))) ((complex-node-p node) - (copy-complex-node node)) + (make-complex-node (complex-node-task node) + (list-iter (complex-node-children node)) + :reduction-label (complex-node-reduction-label node))) (t (error 'type-error :expected-type 'tree-node :datum node))))) ;; Ugh: SHOP plan "trees" are really forests. Most of the time. diff --git a/shop3/planning-tree/tree-reductions.lisp b/shop3/planning-tree/tree-reductions.lisp index 39abd4a9..31f64921 100644 --- a/shop3/planning-tree/tree-reductions.lisp +++ b/shop3/planning-tree/tree-reductions.lisp @@ -70,11 +70,11 @@ (let ((all-subtasks (extract-subtasks reduction))) (iter (for subtask in all-subtasks) (setf (gethash subtask *subtask-parents*) - task1))) + task1)) (when method-label (alexandria:nconcf *reduction-labels* (mapcar #'(lambda (subtask) (cons subtask method-label)) - all-subtasks)))) + all-subtasks))))) (defun extract-subtasks (reduction) (cond @@ -99,7 +99,8 @@ (defun extract-tree (plan) (strip-tree-tags (let* ((operator-nodes (plan-operator-nodes plan)) - ;; all-nodes are either operator-nodes or complex tasks + ;; all-nodes are either primitive-nodes or complex tasks + ;; this is kind of gross... (all-nodes (plan-tree-nodes operator-nodes)) (*node-children-table* (create-node-children-table *subtask-parents* all-nodes operator-nodes)) (root-tasks (node-children nil *node-children-table*))) @@ -143,8 +144,7 @@ ROOT-NODE is a PRIMITIVE-NODE." (make-complex-node root-node (mapcar #'(lambda (child) (extract-subtree child nodes)) children) - :reduction-label label)) - root-node) + :reduction-label label))) ((primitive-node-p root-node) root-node) (t @@ -251,11 +251,6 @@ expanded -- if it is part of a failed search branch then or (c) TASK itself." (extend-plan-tree-nodes (rest base-nodes) (cons node acc)))))) ;;; Introduced an OPERATOR-NODE structure as a way of better -;;; understanding the TREE extraction code. [2004/02/05:rpg] -(defstruct (operator-node (:type list)) - cost - operator - position) ;;; I think OPERATOR-TASK here actually applies to an operator NODE... ;;; this function is necessary because the operators are not EQ diff --git a/shop3/shop3.lisp b/shop3/shop3.lisp index be48cd3d..9c3d6f40 100644 --- a/shop3/shop3.lisp +++ b/shop3/shop3.lisp @@ -168,6 +168,7 @@ MPL/GPL/LGPL triple license. For details, see the software source file.") ;; [mpelican:20090226.1825CST] obsolete, please use state-type arg or default-state-type slot in domain class (*state-encoding* :obsolete-state-encoding-variable) (*plan-tree* plan-tree) + (*reduction-labels* nil) (*collect-state* (or collect-state plan-tree)) (*subtask-parents* (make-subtask-parents-table)) (*operator-tasks* (make-operator-task-table))