1d01fdf921fa

ZDD ops `keep-supersets-of` and `remove-supersets-of`
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 01 Nov 2016 13:38:08 +0000
parents 10be262d7ae3
children 7c5b8fa516a2
branches/tags (none)
files src/zdd.lisp

Changes

--- 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)))