# HG changeset patch # User Steve Losh # Date 1477760991 0 # Node ID c25e7dae8f3926da4ef8d2146e9f433445d7160b # Parent ecd4aaf2cc105be1506ec14a3ee4c1a22d69f8b1 Add variadic ZDD intersection/union wrappers diff -r ecd4aaf2cc10 -r c25e7dae8f39 src/zdd.lisp --- a/src/zdd.lisp Sat Oct 29 17:02:02 2016 +0000 +++ b/src/zdd.lisp Sat Oct 29 17:09:51 2016 +0000 @@ -72,9 +72,9 @@ (make-set elements)) -(defun zdd-union (a b) +(defun zdd-union% (a b) (ematch* (a b) - (((node) (leaf)) (zdd-union b a)) + (((node) (leaf)) (zdd-union% b a)) (((leaf nil) b) b) (((leaf t) b) (unit-patch b)) @@ -82,30 +82,39 @@ (((node var-a hi-a lo-a) (node var-b hi-b lo-b)) (cond - ((< var-a var-b) (zdd-node var-a hi-a (zdd-union lo-a b))) - ((> var-a var-b) (zdd-node var-b hi-b (zdd-union lo-b a))) + ((< var-a var-b) (zdd-node var-a hi-a (zdd-union% lo-a b))) + ((> var-a var-b) (zdd-node var-b hi-b (zdd-union% lo-b a))) ((= var-a var-b) (zdd-node var-a - (zdd-union hi-a hi-b) - (zdd-union lo-a lo-b))))))) + (zdd-union% hi-a hi-b) + (zdd-union% lo-a lo-b))))))) +(defun zdd-union (&rest zdds) + (if zdds + (reduce #'zdd-union% zdds) + (leaf nil))) -(defun zdd-intersection (a b) +(defun zdd-intersection% (a b) (ematch* (a b) - (((node) (leaf)) (zdd-intersection b a)) + (((node) (leaf)) (zdd-intersection% b a)) (((leaf nil) _) (leaf nil)) ((_ (leaf nil)) (leaf nil)) (((leaf t) (leaf _)) b) - (((leaf t) (node _ _ lo)) (zdd-intersection a lo)) + (((leaf t) (node _ _ lo)) (zdd-intersection% a lo)) (((node var-a hi-a lo-a) (node var-b hi-b lo-b)) (cond - ((< var-a var-b) (zdd-intersection lo-a b)) - ((> var-a var-b) (zdd-intersection lo-b a)) + ((< var-a var-b) (zdd-intersection% lo-a b)) + ((> var-a var-b) (zdd-intersection% lo-b a)) ((= var-a var-b) (zdd-node var-a - (zdd-intersection hi-a hi-b) - (zdd-intersection lo-a lo-b))))))) + (zdd-intersection% hi-a hi-b) + (zdd-intersection% lo-a lo-b))))))) + +(defun zdd-intersection (&rest zdds) + (if zdds + (reduce #'zdd-intersection% zdds) + (leaf nil))) (defun zdd-family (&rest sets) @@ -114,9 +123,14 @@ ;;;; Scratch ------------------------------------------------------------------ (with-zdd - (enumerate (gcprint (draw (zdd-union (zdd-family '(1 2 4) '(3 4)) - (zdd-set '(1 2))))))) + (enumerate (zdd-union (zdd-set '(1 2)) + (zdd-set '(1 2)) + (zdd-set '(1)) + (zdd-family '(2) '(1 2) '(3)) + ))) (with-zdd (enumerate (zdd-intersection (zdd-family '(1) '(1 2) '(3) ) - (zdd-family '(2 3 4) '(1 4) nil '(1 2))))) + (zdd-family '(2 3 4) '(1 4) nil '(1 2)) + (zdd-family nil '(1 2)) + )))