# HG changeset patch # User Steve Losh # Date 1478089821 0 # Node ID 1151f5fc872ee371684fc629d1ea0fec2114a631 # Parent 060160061ec6aba4371a356d78965aba9ac3042c Add some ZDD docstrings diff -r 060160061ec6 -r 1151f5fc872e src/zdd.lisp --- a/src/zdd.lisp Wed Nov 02 12:09:20 2016 +0000 +++ b/src/zdd.lisp Wed Nov 02 12:30:21 2016 +0000 @@ -13,18 +13,17 @@ (declare (ignore val)) (values)) -(defun print-through (function val) - (pr (funcall function val)) +(defun print-through (function-or-object val) + (if (functionp function-or-object) + (pr (funcall function-or-object val)) + (pr function-or-object)) val) (defun mapprint-through (function val) + "Calling `function` on each item in `val` and print the result, return `val`." (mapc #'pr (funcall function val)) val) -(defun line (x) - (declare (ignore x)) - '----------------------------------------) - ;;;; Bullshit ----------------------------------------------------------------- ;;; The BDD lib defines a pattern for `node` but not for `leaf`. It's awkward @@ -116,9 +115,11 @@ (defmacro with-zdd (&body body) + "Execute `body` with the ZDD settings properly initialized." `(with-odd-context (:operation #'zdd-apply :node-cache *cache*) ,@body)) + (defun enumerate (zdd) "Return a list of all members of `zdd`." (ematch zdd @@ -150,6 +151,7 @@ (recur hi))))) (hash-table-count seen))) + (defun pick-random (a a-weight b b-weight) (if (< (random (+ a-weight b-weight)) a-weight) @@ -169,15 +171,18 @@ (zdd-random-member lo) (cons var (zdd-random-member hi))))))) -(defun unit-patch (z) - (ematch z - ((sink t) z) + +(defun unit-patch (zdd) + "Ensure the empty set is a member of `zdd`." + (ematch zdd + ((sink t) zdd) ((sink nil) (sink t)) ((node variable hi lo) (zdd-node variable hi (unit-patch lo))))) (defun zdd-set (elements) + "Return a ZDD with a single member (which contains `elements`)." (make-set elements)) @@ -197,6 +202,7 @@ (zdd-union% hi-a hi-b) (zdd-union% lo-a lo-b))))))) (defun zdd-union (&rest zdds) + "Return the union of ZDDs: {α | α ∈ Z₁ or α ∈ Z₂}." (if zdds (reduce #'zdd-union% zdds) (sink nil))) @@ -221,6 +227,7 @@ (zdd-intersection% lo-a lo-b))))))) (defun zdd-intersection (&rest zdds) + "Return the intersection of ZDDs: {α | α ∈ Z₁ and α ∈ Z₂}." (if zdds (reduce #'zdd-intersection% zdds) (sink nil))) @@ -249,6 +256,7 @@ (zdd-join% lo-a lo-b))))))) (defun zdd-join (&rest zdds) + "Return the relational join of ZDDs: {α ∪ β | α ∈ Z₁ and β ∈ Z₂}." (if zdds (reduce #'zdd-join% zdds) (sink nil))) @@ -275,12 +283,14 @@ (zdd-meet% lo-a lo-b)))))))) (defun zdd-meet (&rest zdds) + "Return the relational meet of ZDDs: {α ∩ β | α ∈ Z₁ and β ∈ Z₂}." (if zdds (reduce #'zdd-meet% zdds) (sink nil))) (defun zdd-family (&rest sets) + "Return a ZDD that contains each of the given `sets` as members." (reduce #'zdd-union (mapcar #'zdd-set sets))) @@ -299,6 +309,7 @@ ((> var el) (sink nil)))))) (defun zdd-keep-supersets-of (zdd set) + "Return a ZDD of all supersets of `set` in `zdd`: {α | α ∈ Z and α ⊇ S}." (zdd-keep-supersets-of% zdd (sort set #'<))) @@ -317,6 +328,7 @@ ((> var el) zdd))))) (defun zdd-remove-supersets-of (zdd set) + "Return a ZDD of all non-supersets of `set` in `zdd`: {α | α ∈ Z and α ⊉ S}." (zdd-remove-supersets-of% zdd (sort set #'<))) @@ -333,6 +345,7 @@ ((> var el) (zdd-keep-avoiders-of% zdd remaining)))))) (defun zdd-keep-avoiders-of (zdd set) + "Return a ZDD of members of `zdd` avoiding `set`: {α | α ∈ Z and α ∩ S = ø}." (zdd-keep-avoiders-of% zdd (sort set #'<))) @@ -386,6 +399,11 @@ (sink nil)))))))))))) (defun zdd-match (zdd set lower-bound upper-bound) + "Return a ZDD of members that exactly match `set` within the universe. + + {α | α ∈ Z and α ∩ U = S} + + " (zdd-match% zdd (sort set #'<) lower-bound upper-bound)) @@ -593,7 +611,7 @@ '(1 2 1001) ) (mapprint-through #'enumerate <>) - (print-through #'line <>) + (print-through '-------------- <>) (zdd-match <> '() 100 999) (mapprint-through #'enumerate <>) (draw <> :hexp (lambda (v) (>= 999 v 100)))