Merge pull request #18 from rpgoldman/hddl-parse-plan

Author: rpgoldman

hddl-utils/commons.lisp

@@ -441,10 +441,18 @@ element to *remain*.
   `(let ((*pddl-package* *hddl-package*))
      (setf (pddl-utils:domain-predicates ,domain) ,new-pred-list)))
 
+(defun hddl-plan-p (sexp)
+  (and (listp sexp) (eq (first sexp) :hddl-plan)))
+
+(deftype hddl-plan ()
+  "An HDDL-PLAN is an s-expression headed by :HDDL-PLAN and whose
+CDR is a property list with :ACTIONS, :ROOTS and :DECOMOPOSITIONS."
+  '(satisfies hddl-plan-p))
+
 (defun hddl-plan-to-pddl-plan (hddl-plan)
   "Take the S-expression form of an HDDL plan and return a PDDL plan extracted from it."
   (pddlify-tree
-   (mapcar #'cdr (getf hddl-plan :actions))))
+   (mapcar #'cdr (getf (cdr hddl-plan) :actions))))
 
 (defun hddl-domain-to-pddl-domain (hddl-domain)
   (pddl-utils:make-domain (domain-name hddl-domain)

hddl-utils/package.lisp

@@ -96,5 +96,6 @@
    #:hddl-problem-to-pddl-problem
    #:canonicalize-problem
    #:hddl-variable
+   #:hddl-plan                          ; type
    )
 )

hddl-utils/tests/extract-seq.hddl

@@ -0,0 +1,33 @@
+==>
+1 switch_on instrument0 satellite0
+29 turn_to satellite0 groundstation2 star0
+30 calibrate satellite0 instrument0 groundstation2
+4 turn_to satellite0 phenomenon6 groundstation2
+5 take_image satellite0 phenomenon6 instrument0 thermograph0
+6 turn_to satellite0 star5 phenomenon6
+7 take_image satellite0 star5 instrument0 thermograph0
+8 turn_to satellite0 phenomenon4 star5
+9 take_image satellite0 phenomenon4 instrument0 thermograph0
+
+root 10
+10 main -> take-one 11 12
+11 have-image phenomenon6 thermograph0 -> prepare-then-take 13 14
+13 prepare-instrument satellite0 instrument0 -> prepare 17 18
+17 turn-on-instrument satellite0 instrument0 -> turn-on 1
+18 calibrate-instrument satellite0 instrument0 -> repoint-then-calibrate 29 30
+14 take-image satellite0 instrument0 phenomenon6 thermograph0 -> turn-then-take 4 5
+12 main -> take-one 15 16
+15 have-image star5 thermograph0 -> prepare-then-take 19 20
+19 prepare-instrument satellite0 instrument0 -> prepare 23 24
+23 turn-on-instrument satellite0 instrument0 -> already-on
+24 calibrate-instrument satellite0 instrument0 -> no-calibration-needed
+20 take-image satellite0 instrument0 star5 thermograph0 -> turn-then-take 6 7
+16 main -> take-one 21 22
+21 have-image phenomenon4 thermograph0 -> prepare-then-take 25 26
+25 prepare-instrument satellite0 instrument0 -> prepare 27 28
+27 turn-on-instrument satellite0 instrument0 -> already-on
+28 calibrate-instrument satellite0 instrument0 -> no-calibration-needed
+26 take-image satellite0 instrument0 phenomenon4 thermograph0 -> turn-then-take 8 9
+22 main -> all-done
+<==
+

hddl-utils/tests/tests.lisp

@@ -254,3 +254,21 @@
           (copy-tree *method-subtasks*))
     (is (equalp template method)))
   )
+
+(test extract-sequence
+  (let* ((plan (hddl-utils:read-hddl-plan-file
+                (asdf:system-relative-pathname "hddl-utils"
+                                               "hddl-utils/tests/extract-seq.hddl")))
+         (seq (hddl-utils:hddl-plan-to-pddl-plan plan)))
+    (is (equalp
+         (pddl-utils:pddlify-tree
+          '((SWITCH_ON INSTRUMENT0 SATELLITE0)
+            (TURN_TO SATELLITE0 GROUNDSTATION2 STAR0)
+            (CALIBRATE SATELLITE0 INSTRUMENT0 GROUNDSTATION2)
+            (TURN_TO SATELLITE0 PHENOMENON6 GROUNDSTATION2)
+            (TAKE_IMAGE SATELLITE0 PHENOMENON6 INSTRUMENT0 THERMOGRAPH0)
+            (TURN_TO SATELLITE0 STAR5 PHENOMENON6)
+            (TAKE_IMAGE SATELLITE0 STAR5 INSTRUMENT0 THERMOGRAPH0)
+            (TURN_TO SATELLITE0 PHENOMENON4 STAR5)
+            (TAKE_IMAGE SATELLITE0 PHENOMENON4 INSTRUMENT0 THERMOGRAPH0)))
+         seq))))

hddl/hddl-pprint.lisp

@@ -54,26 +54,6 @@ FOO BAR - TYPE1 BAZ - TYPE2."
   (let ((*package* (find-package *hddl-package*)))
     (read stream nil nil)))
 
-
-#|
-
-(defun print-pddl-plan-to-file (sexp filename &optional (if-exists :error))
-  "Print a PDDL plan to a file in IPC format that the VAL
-plan validator will read."
-  (with-open-file (str filename :direction :output :if-exists if-exists)
-    (print-pddl-plan sexp str)))
-
-(defun print-pddl-plan (sexp &optional (stream t))
-  "Print a PDDL plan in a format that the VAL
-validator will read it: one action s-expression per
-line."
-  (let ((*package* (find-package *pddl-package*))
-        (*print-pretty* nil))
-    (dolist (step sexp)
-      (prin1 step stream)
-      (terpri stream))))
-|#
-
 (defun read-HDDL-plan-file (filename)
   "Read a HDDL plan from FILENAME and return it
 in the form of a list of actions."
@@ -116,7 +96,15 @@ in the form of a list of actions."
                     (t :default))))
       (setf actions
        (iter (for line initially first-line then (read-line stream))
-         (when (string= (subseq line 0 4) "root")
+         (when (string= (string-trim () line) "")
+           (next-iteration))
+         (when (string= (handler-case (subseq line 0 4)
+                          #+sbcl(sb-kernel:bounding-indices-bad-error ()
+                                  "")
+                          ;; AFAICT, neither Allegro nor CCL
+                          ;; have distinct array bound errors.
+                          #-sbcl (error () ""))
+                        "root")
            ;; done reading actions
            (setf root-line line)
            (finish))

version.lisp-expr

@@ -1 +1 @@
-"3.2.4"
+"3.3.0"