6494ca97e78b

--- a/package.lisp	Sun Aug 13 00:06:58 2017 -0400
+++ b/package.lisp	Sun Aug 13 00:09:56 2017 -0400
@@ -119,29 +119,6 @@
   (:export
     ))
 
-(defpackage :sand.binary-decision-diagrams
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.graphviz
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
-
-(defpackage :sand.zero-suppressed-decision-diagrams
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.graphviz
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    )
-  (:nicknames :sand.zdd))
-
 (defpackage :sand.huffman-trees
   (:use
     :cl

--- a/sand.asd	Sun Aug 13 00:06:58 2017 -0400
+++ b/sand.asd	Sun Aug 13 00:09:56 2017 -0400
@@ -61,8 +61,6 @@
                  (:file "dijkstra-maps")
                  #+sbcl (:file "ffi")
                  #+sbcl (:file "profiling")
-                 (:file "binary-decision-diagrams")
-                 (:file "zero-suppressed-decision-diagrams")
                  (:file "huffman-trees")
                  (:file "streams")
                  (:file "color-difference")

--- a/src/binary-decision-diagrams.lisp	Sun Aug 13 00:06:58 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,96 +0,0 @@
-(in-package :sand.binary-decision-diagrams)
-
-(deftype non-negative-fixnum ()
-  `(integer 0 ,most-positive-fixnum))
-
-
-;;;; Reference ----------------------------------------------------------------
-(adt:defdata bdd
-  (sink bit)
-  (node non-negative-fixnum bdd bdd))
-
-(defun make-bdd (contents)
-  (etypecase contents
-    (bit (sink contents))
-    (cons
-      (destructuring-bind (number low high) contents
-        (node number (make-bdd low) (make-bdd high))))))
-
-
-(defun evaluate-bdd (bdd &rest arguments)
-  (recursively ((n 1)
-                (bdd bdd)
-                (argument (first arguments))
-                (remaining (rest arguments)))
-    (adt:match bdd bdd
-      ((sink bit) bit)
-      ((node number low high)
-       (if (> number n)
-         (recur (1+ n)
-                bdd
-                argument
-                remaining)
-         (recur (1+ n)
-                (if (zerop argument)
-                  low
-                  high)
-                (first remaining)
-                (rest remaining)))))))
-
-
-(defun bdd-map-nodes (function bdd)
-  (adt:match bdd bdd
-    ((sink _)
-     (list (funcall function bdd)))
-    ((node _ low high)
-     (append (list (funcall function bdd))
-             (bdd-map-nodes function low)
-             (bdd-map-nodes function high)))))
-
-(defun bdd-map-edges (function bdd)
-  (adt:match bdd bdd
-    ((sink _) nil)
-    ((node _ low high)
-     (list* (funcall function bdd low t)
-            (funcall function bdd high nil)
-            (append (bdd-map-edges function low)
-                    (bdd-map-edges function high))))))
-
-
-(defun node-label (node)
-  (adt:match bdd node
-    ((sink bit) (if (zerop bit) 'false 'true))
-    ((node number _ _) number)))
-
-(defun node-shape (node)
-  (adt:match bdd node
-    ((sink _) :box)
-    ((node _ _ _) :circle)))
-
-
-(defun draw-bdd (bdd &optional (path "bdd.dot"))
-  (let ((nodes (make-hash-table)))
-    (graphviz-digraph
-      (bdd-map-nodes (lambda (node)
-                       (list (ensure-gethash node nodes (gensym))
-                             :label (node-label node)
-                             :shape (node-shape node)))
-                     bdd)
-      (bdd-map-edges (lambda (a b lowp)
-                       (list (gethash a nodes)
-                             (gethash b nodes)
-                             :style (if lowp :dashed :solid)))
-                     bdd)
-      :path path)))
-
-
-;;;; Scratch ------------------------------------------------------------------
-(defparameter *maj*
-  (make-bdd '(1
-              (2 0 (3 0 1))
-              (2 (3 0 1) 1))))
-
-
-; (evaluate-bdd *maj* 1 0 1)
-
-; (draw-bdd *maj* t)

--- a/src/zero-suppressed-decision-diagrams.lisp	Sun Aug 13 00:06:58 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,84 +0,0 @@
-(in-package :sand.zero-suppressed-decision-diagrams)
-
-(adt:defdata zdd
-  empty
-  unit
-  (node t zdd zdd))
-
-
-(defun zdd-with (element)
-  (node element empty unit))
-
-(defun patch-unit (z)
-  (adt:match zdd z
-    (empty unit)
-    (unit unit)
-    ((node element low high)
-     (node element (patch-unit low) high))))
-
-(defun zdd-union (z1 z2 &key (test #'<))
-  (recursively ((z1 z1) (z2 z2))
-    (adt:match zdd z1
-      (empty z2)
-      (unit (patch-unit z2))
-      ((node e1 l1 h1) (adt:match zdd z2
-                         (empty z1)
-                         (unit (patch-unit z1))
-                         ((node e2 l2 h2)
-                          (cond
-                            ((funcall test e1 e2) (node e1 (recur l1 z2) h1))
-                            ((funcall test e2 e1) (recur z2 z1))
-                            (t (node e1 (recur l1 l2) (recur h1 h2))))))))))
-
-(defun zdd-adjoin (z element &key (test #'<))
-  (recursively ((z z))
-    (adt:match zdd z
-      (empty empty)
-      (unit (node element empty unit))
-      ((node e low high)
-       (cond ((funcall test element e)
-              (node element empty z))
-             ((funcall test e element)
-              (node e (recur low) (recur high)))
-             (t
-              (node element empty (zdd-union low high :test test))))))))
-
-(defun zdd-disjoin (z element &key (test #'<))
-  (recursively ((z z))
-    (adt:match zdd z
-      (empty empty)
-      (unit unit)
-      ((node e low high)
-       (cond ((funcall test element e)
-              z)
-             ((funcall test e element)
-              (node e (recur low) (recur high)))
-             (t
-              (zdd-union low high :test test)))))))
-
-
-(defun enumerate-zdd (zdd)
-  (adt:match zdd zdd
-    (empty nil)
-    (unit (list nil))
-    ((node element low high)
-     (append (mapcar (lambda (s) (cons element s))
-                     (enumerate-zdd high))
-             (enumerate-zdd low)))))
-
-
-; (zdd-union (zdd-union (zdd-with 2) (zdd-with 1))
-;            (zdd-adjoin
-;              (zdd-union (zdd-union (zdd-with 2) (zdd-with 3))
-;                         (zdd-union (zdd-with 1) (zdd-with 3)))
-;              2))
-
-; (zdd-adjoin
-;   (zdd-union (zdd-union (zdd-with 2) (zdd-with 3))
-;              (zdd-union (zdd-with 1) (zdd-with 3)))
-;   2)
-
-; (zdd-disjoin * 2)
-
-
-; (enumerate-zdd *)