Saturday, February 20, 2010

short cl-dot tutorial

I wanted to automatically generate some diagrams from a database. I've
done it before, in other languages, generating strings to pass on to
graphviz, and decided to look at the lisp alternatives. Obviously I could write something to again just dump strings, but looking at the lisp libraries, there seemed to be two potential other alternatives:
cl-dot and s-dot.
Cl-dot seems to be written from a clos perspective, and s-dot is written from the prespective of generating s-expressions. I don't have any particular allegience in a holy war here, so decided to write out a short tutorial in both for myself and see if I had a preference.
Keeping it simple and avoiding all the database stuff, I decided to use two sets of sample information. The first set has class instances that point to a single other class instance in a list of instances. The second set has a list of class instances and a second list showing connections. You can think of the first set as manager reporting where each person only has one manager. The second set links people to projects and indicates how much time they spend on each project.

(defclass person ()
((id :accessor id :initarg :id )
(name :accessor name :initarg :name )
(manager-id :accessor manager-id :initarg :manager-id)))
(defclass project ()
((id :accessor id :initarg :id )
(name :accessor name :initarg :name)))
(defclass person-project ()
((id :accessor id :initarg :id)
(person-id :accessor person-id :initarg :person-id)
(project-id :accessor project-id :initarg :project-id)
(percent-allocated :accessor percent-allocated :initarg :percent-allocated)))
(defvar *person-list* (list
(make-instance 'person :id 2 :manager-id 2 :name "Mark")
(make-instance 'person :id 1 :manager-id 2 :name "John")
(make-instance 'person :id 3 :manager-id 2 :name "Janet")
(make-instance 'person :id 4 :manager-id 1 :name "Steve")
(make-instance 'person :id 5 :manager-id 3 :name "Paul")
(make-instance 'person :id 6 :manager-id 3 :name "Chris")))
(defvar *person-project-list*)
(setf *person-project-list* (list
(make-instance 'person-project :id 2 :person-id 1 :project-id 1 :percent-allocated 100)
(make-instance 'person-project :id 1 :person-id 2 :project-id 1 :percent-allocated 70)
(make-instance 'person-project :id 3 :person-id 3 :project-id 1 :percent-allocated 10)
(make-instance 'person-project :id 4 :person-id 4 :project-id 2 :percent-allocated 40)
(make-instance 'person-project :id 5 :person-id 5 :project-id 2 :percent-allocated 25)
(make-instance 'person-project :id 6 :person-id 2 :project-id 3 :percent-allocated 30)
(make-instance 'person-project :id 7 :person-id 3 :project-id 3 :percent-allocated 90)
(make-instance 'person-project :id 8 :person-id 4 :project-id 1 :percent-allocated 60)
(make-instance 'person-project :id 9 :person-id 5 :project-id 3 :percent-allocated 75)
(make-instance 'person-project :id 10 :person-id 6 :project-id 2 :percent-allocated 100)))

(defvar *project-list*)
(setf *project-list*
(list (make-instance 'project :id 1 :name
"Project Alpha")
(make-instance 'project :id 2 :name
"Project Beta")
(make-instance 'project :id 3 :name
"Project Gamma")))
(defun find-item-by-id (id item-list)
"Returns the item from the list with the specific id"
(remove-if-not #'(lambda (x) (= id (id x))) item-list))
(defun find-person (id)
"Returns an instance of person"
(car (find-item-by-id id *person-list*)))
(defun find-project-by-id (id)
"Returns the project with the specific id"
(car (remove-if-not #'(lambda (x) (= id (id x))) *project-list*)))
(defun find-manager (person)
"Returns the person's manager"
(car (remove-if-not #'(lambda (x) (= (manager-id person) (id x))) *person-list*)))

(defun find-projects-by-person (person)
"Returns a list of project instances connected to the person"
(mapcar #'(lambda (x) (find-project-by-id x))
(mapcar #'(lambda (x) (project-id x))
(remove-if-not #'(lambda (x) (= (id person) (person-id x)))
*person-project-list*))))

(defun find-project-percent (person project)
(percent-allocated (car (remove-if-not #'(lambda (x)
(and (= (person-id x) (id person))
(= (project-id x) (id project))))
*person-project-list*))))

If you are wondering, yes, it was deliberate to not put the persons in id order, just to see how it would affect the diagrams. Anyway, this just sets the stage for the comparison of the two dot-diagram libraries.

The first thing we need to do in the cl-dot version is create methods for a few generic methods. Notice that these methods will be tied to creating a manager-graph. You will have to redefine the methods to create other types of graphs.

(defmethod cl-dot:graph-object-node ((graph (eql 'manager-graph)) (object person))
(let ((name (name object)))
(make-instance 'cl-dot:node
:attributes `(:label ,name
:shape :box))))

(defmethod cl-dot:graph-object-points-to ((graph (eql 'manager-graph)) (object person))
(unless (= (id object) (manager-id object))
(list
(make-instance 'cl-dot:attributed
:object (find-manager object)
:attributes '(:weight 1)))))

Now to try it out. Replace the path name for the file with your requirements. You can also change the format to jpg, png, ps, pdf etc.

(let ((dgraph (cl-dot:generate-graph-from-roots 'manager-graph *person-list* '(:rankdir "RL"))))

(cl-dot:dot-graph dgraph "/home/sabra/test/manager-test.png" :format :png))

The first thing I notice is that the arrows are pointing from the person to the manager. If I wanted the arrows pointing the other way, I need to change things a bit. There is a generic method for "graph-object-pointed-to-by". This is described as "The edges will be directed from the other objects to this one." So let's try that.
(defmethod cl-dot:graph-object-pointed-to-by ((graph (eql 'manager-graph)) (object person))

;;Don't want people pointing at themselves
(unless (= (id object) (manager-id object))
(list
(make-instance 'cl-dot:attributed
:object (find-manager object)
:attributes '(:weight 1)))))

Ok. That results in a complete mess. I would have expected the same chart, but with double sets of arrows. Instead, I got something rather different. You might try it and see what you get. If we null out the "graph-object-points-to" method. We do get what we expected.

Now let's see if we can come up with a sensible graph for pointing people at projects and indicating, on the edges, the percentage of time each person spends on the project.

First, we need another node method for persons, this time tied to a project-graph. Then we need a node method for projects and a "points to" method showing persons pointing at projects, again all tied to a project graph.
(defmethod cl-dot:graph-object-node ((graph (eql 'project-graph)) (object person))
(let ((name (name object)))
(make-instance 'cl-dot:node
:attributes `(:label ,name
:shape :box))))

(defmethod cl-dot:graph-object-node ((graph (eql 'project-graph)) (object project))
(let ((name (name object)))
(make-instance 'cl-dot:node
:attributes `(:label ,name
:shape :box))))

(defmethod cl-dot:graph-object-points-to ((graph (eql 'project-graph)) (object person))
(mapcar #'(lambda (x)
(let ((edge-name (format nil "~a%" (find-project-percent object x))))
(make-instance 'cl-dot:attributed
:object x
:attributes `(:weight 1 :label ,edge-name))))
(find-projects-by-person object)))

At this point, calling something like:
(let ((dgraph (cl-dot:generate-graph-from-roots 'project-graph *person-list* '(:rankdir "LR"))))

(cl-dot:dot-graph dgraph "/home/sabra/test/project-test.png" :format :png))
results in a graph, but not a particularly attractive one. In addition, you will note that the persons are arranged in reverse order to the person list. That is something you are going to have to work out on your own.