# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1478007911 0
# Node ID 275d36f92936f28d12757e54bd4956ed6b8067ba
# Parent  7c5b8fa516a22de9736094293bddf548448db5c4
Add ZDD `keep-avoiders-of` operation

diff -r 7c5b8fa516a2 -r 275d36f92936 src/zdd.lisp
--- a/src/zdd.lisp	Tue Nov 01 13:38:22 2016 +0000
+++ b/src/zdd.lisp	Tue Nov 01 13:45:11 2016 +0000
@@ -235,6 +235,22 @@
   (zdd-remove-supersets-of% zdd (sort set #'<)))
 
 
+(defun zdd-keep-avoiders-of% (zdd set)
+  (ematch* (zdd set)
+    ((_ nil) zdd)
+    (((leaf) _) zdd)
+    (((node var hi lo) (list* el remaining))
+     (cond
+       ((= var el) (zdd-keep-avoiders-of% lo remaining))
+       ((< var el) (zdd-node var
+                             (zdd-keep-avoiders-of% hi set)
+                             (zdd-keep-avoiders-of% lo set)))
+       ((> var el) (zdd-keep-avoiders-of% zdd remaining))))))
+
+(defun zdd-keep-avoiders-of (zdd set)
+  (zdd-keep-avoiders-of% zdd (sort set #'<)))
+
+
 (defun zdd-family (&rest sets)
   (reduce #'zdd-union (mapcar #'zdd-set sets)))
 
@@ -266,10 +282,10 @@
   (-<> (zdd-join (zdd-family '(1 2) '(7 8) '())
                  (zdd-family '(1 5 9) nil)
                  (zdd-set '(1)))
-    (zdd-remove-supersets-of <> '(5 9))
-    ; (enumerate <>)
+    (print-enumerated <>)
+    (zdd-keep-avoiders-of <> '(2 7))
+    (print-enumerated <>)
     (draw <>)
-    (print-enumerated <>)
     (zdd-size <>)
     )
   )