--- a/src/reasoners/zdd.lisp Mon Feb 13 17:54:31 2017 +0000
+++ b/src/reasoners/zdd.lisp Fri Feb 17 11:52:25 2017 +0000
@@ -199,13 +199,16 @@
(defun iset-to-list (reasoner iset)
- (map-tree (curry #'number-to-term reasoner)
- (scully.zdd::enumerate iset)))
+ (let ((contents (scully.zdd::enumerate iset)))
+ (if (null contents)
+ nil
+ (map-tree (curry #'number-to-term reasoner) contents))))
(defun dump-iset (reasoner iset)
(iterate (for i :from 0)
(for state :in (iset-to-list reasoner iset))
- (format t "STATE ~D:~%~{ ~S~%~}~2%" i state))
+ (let ((*package* (find-package :ggp-rules)))
+ (format t "STATE ~D:~%~{ ~S~%~}~2%" i state)))
iset)
@@ -229,6 +232,14 @@
(zr-roles reasoner))
+(defun filter-iset-for-percepts (reasoner iset role percepts)
+ (let ((universe (gethash role (zr-percept-universes reasoner)))
+ (percepts (mapcar (curry #'term-to-number reasoner) percepts)))
+ (dump-iset reasoner iset)
+ (pr universe)
+ (pr percepts)
+ (zdd-match iset percepts universe)))
+
;;;; Drawing ------------------------------------------------------------------
(defun label (reasoner n)
(let ((*package* (find-package :ggp-rules)))
@@ -466,51 +477,28 @@
; )
-
(defparameter *r* (make-zdd-reasoner *rules*))
-; (defparameter *i* (initial-iset *r*))
-; (defparameter *j* (initial-iset *r*))
-
-; (with-zdd
-; (-<> *r*
-; (make-iset <>
-; '(
-; (true (control xplayer))
-; (true (cell 1 1 B)) (true (cell 1 2 x)) (true (cell 1 3 o))
-; (true (cell 2 1 B)) (true (cell 2 2 o)) (true (cell 2 3 o))
-; (true (cell 3 1 x)) (true (cell 3 2 x)) (true (cell 3 3 x))
-; ))
-; (apply-rule-forest *r* <> (zr-possible-forest *r*))
-; (draw-zdd *r* <>)
-; (dump-iset *r* <>)
-; (no <>)
-; ))
-
+(defparameter *i* (initial-iset *r*))
(defun test ()
(with-zdd
(-<>
- (zdd-union
- (make-iset *r* '(
- (true (control oplayer))
- (true (cell 1 1 o)) (true (cell 1 2 x)) (true (cell 1 3 x))
- (true (cell 2 1 x)) (true (cell 2 2 o)) (true (cell 2 3 b))
- (true (cell 3 1 x)) (true (cell 3 2 o)) (true (cell 3 3 b))
- ))
- (make-iset *r* '(
- (true (control oplayer))
- (true (cell 1 1 o)) (true (cell 1 2 x)) (true (cell 1 3 x))
- (true (cell 2 1 x)) (true (cell 2 2 b)) (true (cell 2 3 o))
- (true (cell 3 1 x)) (true (cell 3 2 o)) (true (cell 3 3 b))
- )))
+ (initial-iset *r*)
(apply-rule-forest *r* <> (zr-possible-forest *r*))
- (zdd-join <> (make-iset *r* '((does oplayer (mark 3 3))
- (does xplayer noop))))
+ (zdd-join <> (make-iset *r* '((does random (choose heads heads))
+ (does alice noop))))
(apply-rule-forest *r* <> (zr-happens-forest *r*))
- (zdd-meet <> (zr-next-zdd *r*))
+ (filter-iset-for-percepts
+ *r* <> 'ggp-rules::alice
+ '((ggp-rules::sees ggp-rules::alice (ggp-rules::coins ggp-rules::unset))
+ (ggp-rules::sees ggp-rules::alice (ggp-rules::coins ggp-rules::heads))))
+ (pr <>)
(dump-iset *r* <>)
- (convert-next-to-true *r* <>)
- (dump-iset *r* <>)
+ ;; (dump-iset *r* <>)
+ ;; (zdd-meet <> (zr-next-zdd *r*))
+ ;; (dump-iset *r* <>)
+ ;; (convert-next-to-true *r* <>)
+ ;; (dump-iset *r* <>)
(no <>)
; (draw-zdd *r* <>)
)))
--- a/src/zdd.lisp Mon Feb 13 17:54:31 2017 +0000
+++ b/src/zdd.lisp Fri Feb 17 11:52:25 2017 +0000
@@ -361,8 +361,11 @@
`universe` should be an array of booleans, one per possible term.
+ Every element to match in `set` should be a member of the universe. This is
+ not checked. `set` does not need to be sorted beforehand.
+
"
- (zdd-match% zdd (sort set #'<) universe))
+ (zdd-match% zdd (sort (copy-list set) #'<) universe))
;;;; Scratch ------------------------------------------------------------------