Added tag v1.2.1 for changeset 8cf220c55f13
author |
Steve Losh <steve@stevelosh.com> |
date |
Sat, 03 Nov 2018 15:44:01 -0400 |
parents |
412a127b7419 |
children |
63712529f020 f11da0d6a058 |
(in-package :digraph.dot)
(defun find-dot-roots (digraph)
(let ((nodes (vertices digraph))
(roots nil)
(test (digraph::digraph-test digraph)))
(labels ((descendents (vertex)
(map-depth-first #'identity digraph vertex))
(prune (vertex)
(setf nodes (set-difference nodes (descendents vertex)
:test test)))
(mark-root-and-prune (vertex)
(push vertex roots)
(prune vertex)))
(mapc #'mark-root-and-prune (digraph::roots digraph))
(loop :while nodes :do (mark-root-and-prune (pop nodes))))
roots))
(defparameter *current-digraph* nil)
(defmethod cl-dot:graph-object-node ((graph (eql 'digraph)) (vertex t))
(make-instance 'cl-dot:node
:attributes `(:label ,(format nil "~A" vertex) :shape :circle)))
(defmethod cl-dot:graph-object-points-to ((graph (eql 'digraph)) (vertex t))
(successors *current-digraph* vertex))
(defun draw (digraph &key (filename "digraph.png") (format :png))
"Draw `digraph` with cl-dot."
(let ((*current-digraph* digraph))
(cl-dot:dot-graph
(cl-dot:generate-graph-from-roots 'digraph (find-dot-roots digraph))
filename
:format format))
digraph)