cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 83602ae0390608531a666ea36d1e581027dad2c3
parent c938aea821dbbbac85b7832595a3d18ffc9068cd
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 22 Jun 2014 12:44:43 +0200

draw bdd using dot

Diffstat:
Mbdd.lisp | 42++++++++++++++++++++++++++++++++++++++++++
1 file changed, 42 insertions(+), 0 deletions(-)

diff --git a/bdd.lisp b/bdd.lisp @@ -248,3 +248,45 @@ ;;(time (let ((n 7)) (print-n-queens-board n (any-sat (build (build-n-queens n)))))) ;;(time (let ((n 8)) (print-n-queens-board n (any-sat (build (build-n-queens n)))))) ;;(time (let ((n 9)) (print-n-queens-board n (any-sat (build (build-n-queens n)))))) + +(defun to-dot (u &optional out) + (flet ((draw (s) + (format s "digraph bdd {~%") + (let ((g (make-hash-table :test #'eq)) + (zero (mk 2 0 0)) + (one (mk 2 1 1)) + (i 1)) + (labels ((rec (u) + (or (gethash u g) + (setf (gethash u g) + (cond + ((eq zero u) + (format s "n0 [label=\"0\",shape=square]~%") + 0) + ((eq one u) + (format s "n1 [label=\"1\",shape=square]~%") + 1) + (t + (let ((n (incf i))) + (destructuring-bind (v l &rest h) u + (declare (type var v)) + (format s "n~d [label=\"~a\"]~%" n v) + (format s "n~d -> n~d [style=dotted]~%" n (rec l)) + (format s "n~d -> n~d~%" n (rec h))) + n))))))) + (rec u))) + (format s "}~%"))) + (etypecase out + (null (draw *standard-output*)) + (stream (draw out)) + (pathname + (with-open-file (s out + :direction :output + :if-does-not-exist :create + :if-exists :supersede) + (draw s)))))) + +;;(to-dot (build '(and 2 3)) #p"/tmp/a.dot") +;;(to-dot (build '(or (and 2 3) (and 4 5))) #p"/tmp/a.dot") +;;(to-dot (build (build-n-queens 4)) #p"/tmp/a.dot") +;;(rw.os:run-command "dot" '("-Tpng" "-o/tmp/a.png" "/tmp/a.dot"))