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