lisp:land-of-lisp:ch7

lisp/land-of-lisp/ch7/graphlib.lisp

@@ -0,0 +1,210 @@
+(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*)
+