10be262d7ae3

Add ZDD meet operation
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 30 Oct 2016 18:27:49 +0000
parents c4fb52c19da9
children 1d01fdf921fa
branches/tags (none)
files src/zdd.lisp

Changes

--- a/src/zdd.lisp	Sun Oct 30 17:52:26 2016 +0000
+++ b/src/zdd.lisp	Sun Oct 30 18:27:49 2016 +0000
@@ -144,6 +144,32 @@
     (reduce #'zdd-join% zdds)
     (leaf nil)))
 
+(defun zdd-meet% (a b)
+  (ematch* (a b)
+    (((leaf nil) _) (leaf nil))
+    ((_ (leaf nil)) (leaf nil))
+
+    (((leaf t) _) (leaf t))
+    ((_ (leaf t)) (leaf t))
+
+    (((node var-a hi-a lo-a)
+      (node var-b hi-b lo-b))
+     (cond
+       ((< var-a var-b) (zdd-union (zdd-meet% hi-a b)
+                                   (zdd-meet% lo-a b)))
+       ((> var-a var-b) (zdd-union (zdd-meet% hi-b a)
+                                   (zdd-meet% lo-b a)))
+       ((= var-a var-b) (zdd-node var-a
+                                  (zdd-meet% hi-a hi-b)
+                                  (zdd-union (zdd-meet% hi-a lo-b)
+                                             (zdd-meet% lo-a hi-b)
+                                             (zdd-meet% lo-a lo-b))))))))
+
+(defun zdd-meet (&rest zdds)
+  (if zdds
+    (reduce #'zdd-meet% zdds)
+    (leaf nil)))
+
 
 (defun zdd-family (&rest sets)
   (reduce #'zdd-union (mapcar #'zdd-set sets)))
@@ -166,5 +192,10 @@
   (enumerate
     (zdd-join (zdd-family '(1 2) '(7 8) '())
               (zdd-family '(1 5 9) nil)
-              (zdd-set '(1))
-              )))
+              (zdd-set '(1)))))
+
+(with-zdd
+  (enumerate
+    (zdd-meet (zdd-family '(1 2) '(1 6))
+              (zdd-family '(2)))))
+