# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1478007488 0
# Node ID 1d01fdf921fa47d9770124c68da98ff4de4407e7
# Parent  10be262d7ae3c520a1db0214f71ea25ec11b6698
ZDD ops `keep-supersets-of` and `remove-supersets-of`

diff -r 10be262d7ae3 -r 1d01fdf921fa src/zdd.lisp
--- a/src/zdd.lisp	Sun Oct 30 18:27:49 2016 +0000
+++ b/src/zdd.lisp	Tue Nov 01 13:38:08 2016 +0000
@@ -171,6 +171,42 @@
     (leaf nil)))
 
 
+(defun zdd-keep-supersets-of% (zdd set)
+  (ematch* (zdd set)
+    ((_ nil) zdd)
+    (((leaf) _) (leaf nil))
+    (((node var hi lo) (list* el remaining))
+     (cond
+       ((= var el) (zdd-node var
+                             (zdd-keep-supersets-of% hi remaining)
+                             (leaf nil)))
+       ((< var el) (zdd-node var
+                             (zdd-keep-supersets-of% hi set)
+                             (zdd-keep-supersets-of% lo set)))
+       ((> var el) (leaf nil))))))
+
+(defun zdd-keep-supersets-of (zdd set)
+  (zdd-keep-supersets-of% zdd (sort set #'<)))
+
+
+(defun zdd-remove-supersets-of% (zdd set)
+  (ematch* (zdd set)
+    ((_ nil) (leaf nil))
+    (((leaf) _) zdd)
+    (((node var hi lo) (list* el remaining))
+     (cond
+       ((= var el) (zdd-node var
+                             (zdd-remove-supersets-of% hi remaining)
+                             lo))
+       ((< var el) (zdd-node var
+                             (zdd-remove-supersets-of% hi set)
+                             (zdd-remove-supersets-of% lo set)))
+       ((> var el) zdd)))))
+
+(defun zdd-remove-supersets-of (zdd set)
+  (zdd-remove-supersets-of% zdd (sort set #'<)))
+
+
 (defun zdd-family (&rest sets)
   (reduce #'zdd-union (mapcar #'zdd-set sets)))