# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1488807627 0
# Node ID 016dd6d5f7645d0a6de7cb12c38cdf5e5ce13dbf
# Parent  3c9facf27dea58cbcc483b94ddb38fc42cebc213
Clean up the ZDD reasoner API a little bit

diff -r 3c9facf27dea -r 016dd6d5f764 gdl/pennies.gdl
--- a/gdl/pennies.gdl	Sat Feb 25 16:17:01 2017 +0000
+++ b/gdl/pennies.gdl	Mon Mar 06 13:40:27 2017 +0000
@@ -55,6 +55,11 @@
   (true (coin ?s2))
   (distinct ?s1 ?s2))
 
+(<= (goal alice 00)
+  (true (coins ?s1 ?s1))
+  (true (coin ?s2))
+  (distinct ?s1 ?s2))
+
 (<= terminal 
   (not (true (coin unset)))
   (not (true (coins unset unset))))
diff -r 3c9facf27dea -r 016dd6d5f764 package.lisp
--- a/package.lisp	Sat Feb 25 16:17:01 2017 +0000
+++ b/package.lisp	Mon Mar 06 13:40:27 2017 +0000
@@ -125,7 +125,21 @@
     :scully.zdd
     :scully.quickutils)
   (:shadowing-import-from :losh
-    :<>))
+    :<>)
+  (:export
+    :make-zdd-reasoner
+    :initial-iset
+    :rand-state
+    :terminalp
+    :roles
+    :filter-iset-for-percepts
+    :filter-iset-for-move
+    :compute-next-iset
+    :apply-happens
+    :apply-possible
+    :sprout
+    )
+  )
 
 
 (defpackage :scully.grounders.prolog
@@ -170,3 +184,12 @@
     :scully.reasoners.prolog)
   (:export
     ))
+(defpackage :scully.players.random-zdd
+  (:use
+    :cl
+    :losh
+    :iterate
+    :scully.quickutils
+    :scully.reasoners.zdd)
+  (:export
+    ))
diff -r 3c9facf27dea -r 016dd6d5f764 src/reasoners/zdd.lisp
--- a/src/reasoners/zdd.lisp	Sat Feb 25 16:17:01 2017 +0000
+++ b/src/reasoners/zdd.lisp	Mon Mar 06 13:40:27 2017 +0000
@@ -87,8 +87,8 @@
    term->number
    number->term
    initial-zdd
-   legal-zdd
-   goal-zdd
+   legal-zdds
+   goal-zdds
    terminal-zdd
    next-zdd
    percept-universes
@@ -161,8 +161,16 @@
           :possible-forest (build-rule-forest possible)
           :happens-forest (build-rule-forest happens)
           :initial-zdd (zdd-set (find-initial-state rules term->number))
-          :legal-zdd (make-predicate-zdd '(ggp-rules::legal) term->number)
-          :goal-zdd (make-predicate-zdd '(ggp-rules::goal) term->number)
+          :legal-zdds (iterate
+                        (for role :in roles)
+                        (collect-hash
+                          (role (make-predicate-zdd `(ggp-rules::legal ,role)
+                                                    term->number))))
+          :goal-zdds (iterate
+                        (for role :in roles)
+                        (collect-hash
+                          (role (make-predicate-zdd `(ggp-rules::goal ,role)
+                                                    term->number))))
           :terminal-zdd (make-predicate-zdd '(ggp-rules::terminal) term->number)
           :next-zdd (make-predicate-zdd '(ggp-rules::next) term->number)
           :percept-universes
@@ -286,6 +294,23 @@
     zdd-unit-p
     not))
 
+(defun legal-moves-for (reasoner iset role)
+  (-<> iset
+    (zdd-meet <> (gethash role (zr-legal-zdds reasoner)))
+    zdd-random-member
+    (mapcar (curry #'number-to-term reasoner) <>)
+    (mapcar #'third <>)))
+
+(defun goal-values-for (reasoner iset role)
+  (-<> iset
+    (zdd-meet <> (gethash role (zr-goal-zdds reasoner)))
+    enumerate
+    (mapcar #'first <>)
+    remove-duplicates
+    (mapcar (curry #'number-to-term reasoner) <>)
+    (mapcar #'third <>)))
+
+
 (defun roles (reasoner)
   (zr-roles reasoner))
 
@@ -303,8 +328,15 @@
 
 (defun compute-next-iset (reasoner iset)
   (-<> iset
-    (zdd-meet <> (zr-next-zdd *r*))
-    (convert-next-to-true *r* <>)))
+    (zdd-meet <> (zr-next-zdd reasoner))
+    (convert-next-to-true reasoner <>)))
+
+
+(defun apply-possible (reasoner iset)
+  (apply-rule-forest reasoner iset (zr-possible-forest reasoner)))
+
+(defun apply-happens (reasoner iset)
+  (apply-rule-forest reasoner iset (zr-happens-forest reasoner)))
 
 
 ;;;; Drawing ------------------------------------------------------------------
@@ -555,9 +587,9 @@
     (-<>
         (initial-iset *r*)
 
-      (apply-rule-forest *r* <> (zr-possible-forest *r*))
+      (apply-possible *r* <>)
       (sprout *r* <>)
-      (apply-rule-forest *r* <> (zr-happens-forest *r*))
+      (apply-happens *r* <>)
       (filter-iset-for-percepts
         *r* <>
         'ggp-rules::alice
@@ -568,9 +600,9 @@
         'ggp-rules::noop)
       (compute-next-iset *r* <>)
 
-      (apply-rule-forest *r* <> (zr-possible-forest *r*))
+      (apply-possible *r* <>)
       (sprout *r* <>)
-      (apply-rule-forest *r* <> (zr-happens-forest *r*))
+      (apply-happens *r* <>)
       (filter-iset-for-move
          *r* <>
         'ggp-rules::alice
@@ -581,9 +613,11 @@
         '((ggp-rules::sees ggp-rules::alice (ggp-rules::coins ggp-rules::heads))))
       (compute-next-iset *r* <>)
 
-      (apply-rule-forest *r* <> (zr-possible-forest *r*))
+      (apply-possible *r* <>)
 
-      (dump-iset *r* <>)
+      (pr (goal-values-for *r* <> 'ggp-rules::alice))
+
+      ;; (dump-iset *r* <>)
       (no <>)
       ; (draw-zdd *r* <>)
       )))