ZDD ops `keep-supersets-of` and `remove-supersets-of`
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)))