211 lines
7.4 KiB
Common Lisp
211 lines
7.4 KiB
Common Lisp
(defun dot-name (exp)
|
|
(substitute-if #\_ (complement #'alphanumericp) (prin1-to-string exp)))
|
|
|
|
;; A node in DOT format can only contain letters, digits, and the underscore
|
|
;; So here we are replacing any forbidden characters to underscores
|
|
|
|
;; example
|
|
;; (substitute-if #\e #'digit-char-p "I'm a l33t hack3r!")
|
|
;; >> "I'm a leet hacker!"
|
|
;; This says, if a char of the string is also a number, sub
|
|
|
|
;; By passing (complement) above, we are basically saying:
|
|
;; If char is not alphanumeric, replace with "_"
|
|
|
|
(defparameter *max-label-length* 30)
|
|
|
|
(defun dot-label (exp)
|
|
(if exp
|
|
(let ((s (write-to-string exp :pretty nil)))
|
|
(if (> (length s) *max-label-length*)
|
|
(concatenate 'string (subseq s 0 (- *max-label-length* 3)) "...")
|
|
s))
|
|
""))
|
|
|
|
;; max-label-length is our max chars for our label
|
|
;; if node label is larger than the limit, it gets cropped and an ... is added
|
|
;; (write-to_string) is similar to (prin1-to-string) as it writes an expression
|
|
;; to a string.
|
|
|
|
;; :pretty parameter is a keyword parameter that tells lisp not to alter the
|
|
;; string to make it pretty. Without this, lisp would place new lines or tabs
|
|
;; into our converted string to make it look more pleasing to the eye
|
|
;; by setting :pretty to nil, we tell lisp to output the expression without
|
|
;; any decorations (having new lines in a label can confuse Graphviz)
|
|
|
|
(defun nodes->dot (nodes)
|
|
(mapc (lambda (node)
|
|
(fresh-line)
|
|
(princ (dot-name (car node)))
|
|
(princ "[label=\"")
|
|
(princ (dot-label node))
|
|
(princ "\"];"))
|
|
nodes))
|
|
|
|
;; here we use mapc to go hrough eveyr node in the list of nodes
|
|
;; princ prints each node in the DOT format directly to screen
|
|
;; mapc is a slightly more efficient variant of mapcar;
|
|
;; The difference is that it does not returne the transformed list
|
|
;; The nodes->dot function uses the (dot-name) and (dot-label) to convert data
|
|
|
|
(defun edges->dot (edges)
|
|
(mapc (lambda (node)
|
|
(mapc (lambda (edge)
|
|
(fresh-line)
|
|
(princ (dot-name (car node)))
|
|
(princ "->")
|
|
(princ (dot-name (car edge)))
|
|
(princ "[label=\"")
|
|
(princ (dot-label (cdr edge)))
|
|
(princ "\"];"))
|
|
(cdr node)))
|
|
edges))
|
|
|
|
(defun graph->dot (nodes edges)
|
|
(princ "digraph{")
|
|
(nodes->dot nodes)
|
|
(edges->dot edges)
|
|
(princ "}"))
|
|
|
|
(defun dot->png (fname thunk)
|
|
(with-open-file (*standard-output*
|
|
fname
|
|
:direction :output
|
|
:if-exists :supersede)
|
|
(funcall thunk))
|
|
(ext:shell (concatenate 'string "dot -Tpng -O " fname)))
|
|
|
|
;; To keep this dot->png function reusale, the graph->dot function isn't
|
|
;; called directly, instead we write it to accept a thunk
|
|
|
|
;; In this scenairo, a function without arguments is commonly called a thunk
|
|
;; or suspension. In this caes, the thunk our function needs would be a
|
|
;; function that, when called, prints a DOT file to the console.
|
|
|
|
;; Why is a thunk useful?
|
|
;; the easiest way for us to write and debug graph->dot and other DOT
|
|
;; file functions is to have them print their results directly to
|
|
;; the console. When we call graph->dot, it doesn't return
|
|
;; its results as a value, but instead, prints them at the console
|
|
;; as a side effect. Therefore we can't just pass the value
|
|
;; of graph->dot to dot->png.
|
|
;; instead we pass in graph->dot as a thunk. then dot->png is responsible for
|
|
;; calling graph->dot, caputring the results, and sending them to a file
|
|
|
|
;; this technique is used a lot
|
|
;; First we print stuff to the console; next we wrap it in a thunk;
|
|
;; Finally we redirect the results to some other location
|
|
|
|
;; Writing to a file
|
|
|
|
;; The function with-open-file enables dot->png to write information to a file
|
|
;; for clarity, here's an example
|
|
;;(with-open-file (my-stream
|
|
;; "testfile.txt"
|
|
;; :direction :output
|
|
;; :if-exists :supersede)
|
|
;; (princ "Hello File!" my-stream))
|
|
|
|
;; :direction is set to :output (we are only writing, no reading)
|
|
;; :if-exists :supersede (if a file with that name exists, overwrite)
|
|
|
|
;; putting a colon in front of a symbol means that symbol always means itself
|
|
;; so :cigar can only be a constant named :CIGAR
|
|
|
|
;; Basicaly, this just says that a symbol has its own meaning.
|
|
|
|
;; so back to (dot->png) How does it save to file, and not just go to the console?
|
|
|
|
;; Aparently with-open-file is analogous to using (let) to create a variable.
|
|
;; Hence, it usually leads to the creation of a lexical (local) stream variable.
|
|
|
|
;; However, if a dynamic variable already existsw with the same name,
|
|
;; (let) will temporarily override the value of the dynamic variable to the
|
|
;; The new value.
|
|
|
|
;; *standard-output* is such a dynamic variable
|
|
;; This means that we can temporarily override the value of *standard-output*
|
|
;; to a new value by passing it into our (with-open-file) command
|
|
|
|
;; In the body, where we call our thunk, any values printed to the console,
|
|
;; will now be automagically routed to our file instead.
|
|
|
|
;; Well, that is interesting. Everything that normally goes to
|
|
;; *standard-output*, will instead go to our file within this function
|
|
|
|
;; Alright, let's wrap this up
|
|
|
|
(defun graph->png (fname nodes edges)
|
|
(dot->png fname
|
|
(lambda ()
|
|
(graph->dot nodes edges))))
|
|
|
|
;; This function takes the name of a DOT file (as the variable fname)
|
|
;; as well as the graph's nodes and edges and uses them to
|
|
;; generate the graph
|
|
|
|
;; It calls dot->png and creates the appropriate thunk, a lambda function
|
|
;; as is usual for a thunk, it takes no parameters.
|
|
|
|
;; The graph->dot function is called inside the thunk as a
|
|
;; delayed computation. Specifically if we called graph->dot directly,
|
|
;; its output would just show up in the console. However, when inside the thunk
|
|
;; it will be called at the leisure of the dot->png function, and the output
|
|
;; will generate the dot file with the filename passed in as the first param
|
|
;; to graph->png
|
|
|
|
;; Cool, now we can make a directional graph with this:
|
|
;; (graph->png "wizard.dot" *nodes* *edges*)
|
|
|
|
;; Now let's make a graph that's non-directional.
|
|
|
|
(defun uedges->dot (edges)
|
|
(maplist (lambda (lst)
|
|
(mapc (lambda (edge)
|
|
(unless (assoc (car edge) (cdr lst))
|
|
(fresh-line)
|
|
(princ (dot-name (caar lst)))
|
|
(princ "--")
|
|
(princ (dot-name (car edge)))
|
|
(princ "[label=\"")
|
|
(princ (dot-label (cdr edge)))
|
|
(princ "\"];")))
|
|
(cdar lst)))
|
|
edges))
|
|
|
|
(defun ugraph->dot (nodes edges)
|
|
(princ "graph{")
|
|
(nodes->dot nodes)
|
|
(uedges->dot edges)
|
|
(princ "}"))
|
|
|
|
(defun ugraph->png (fname nodes edges)
|
|
(dot->png fname
|
|
(lambda ()
|
|
(ugraph->dot nodes edges))))
|
|
|
|
;; (maplist) is like (mapcar) except that the function inside it
|
|
;; receives the entire remainder of the list, not just the
|
|
;; current item in the list
|
|
|
|
;; (maplist) sends the print function everything in the list from
|
|
;; the current item until the end
|
|
|
|
;; uedges->dot then uses the information about future nodes it gets
|
|
;; from maplist to check whether the destination of the node appears
|
|
;; later in the edge list
|
|
|
|
;; The actual checking is done with (assoc) looking for the current edge
|
|
;; in the list of remaining edges calculated as (cdr lst)
|
|
;; In this case it skips the edge so that only one of any pair of edgs will be
|
|
;; printed
|
|
|
|
;; (ugraph->dot) is similar to (graph->dot) except that it describes
|
|
;; the graph as just a graph when making DOT data instead of digraph
|
|
|
|
;; (ugraph->png) is almost the same as (graph->png) except that it calls
|
|
;; (ugraph->dot) instead of (graph->dot)
|
|
|
|
;; Test (ugraph->png "uwizard.dot" *nodes* *edges*)
|
|
|