lisp:land-of-lisp:ch7
This commit is contained in:
parent
fcce94e59f
commit
4c63f5ee18
78
lisp/land-of-lisp/ch7/graph-util-clean.lisp
Normal file
78
lisp/land-of-lisp/ch7/graph-util-clean.lisp
Normal file
@ -0,0 +1,78 @@
|
|||||||
|
(defun dot-name (exp)
|
||||||
|
(substitute-if #\_ (complement #'alphanumericp) (prin1-to-string exp)))
|
||||||
|
|
||||||
|
(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))
|
||||||
|
""))
|
||||||
|
|
||||||
|
(defun nodes->dot (nodes)
|
||||||
|
(mapc (lambda (node)
|
||||||
|
(fresh-line)
|
||||||
|
(princ (dot-name (car node)))
|
||||||
|
(princ "[label=\"")
|
||||||
|
(princ (dot-label node))
|
||||||
|
(princ "\"];"))
|
||||||
|
nodes))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
(defun graph->png (fname nodes edges)
|
||||||
|
(dot->png fname
|
||||||
|
(lambda ()
|
||||||
|
(graph->dot nodes edges))))
|
||||||
|
|
||||||
|
(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))))
|
210
lisp/land-of-lisp/ch7/graphlib.lisp
Normal file
210
lisp/land-of-lisp/ch7/graphlib.lisp
Normal file
@ -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*)
|
||||||
|
|
155
lisp/land-of-lisp/ch7/notes.lisp
Normal file
155
lisp/land-of-lisp/ch7/notes.lisp
Normal file
@ -0,0 +1,155 @@
|
|||||||
|
;; Remember that that a list is a string of cons cells
|
||||||
|
|
||||||
|
;; (cons 1 (cons 2 (cons 3 nil)))
|
||||||
|
;; >> (1 2 3)
|
||||||
|
|
||||||
|
;; but if we do it a bit different:
|
||||||
|
;;(cons 1 (cons 2 3))
|
||||||
|
;; >> (1 2 . 3) A bit different
|
||||||
|
|
||||||
|
;; This dot notation is lisp saying:
|
||||||
|
;; I tried to print this structure you entered using list notation
|
||||||
|
;; but the last item in the list didn't contain the usual nil
|
||||||
|
;; I expected; instead, it contained 3
|
||||||
|
|
||||||
|
;; A list that ends in something other than nil is refeered to as a doted list
|
||||||
|
|
||||||
|
;; dotted lists aren't that useful of a tool
|
||||||
|
;; It would be unusual for a lisp programmer to store data in one
|
||||||
|
;; However, given the pervasiveness of cons cells in Lisp,
|
||||||
|
;; you will frequently encounter a non-nil value at the end of a chain of
|
||||||
|
;; cons cells.
|
||||||
|
;; That's why you should become familiar with dotted lists, even if you never
|
||||||
|
;; Use them directly
|
||||||
|
|
||||||
|
;; A proper list could be written in dot notation
|
||||||
|
;; '(1 . (2 . (3 . nil)))
|
||||||
|
|
||||||
|
;; Thinking of it like this shows us why lisp is forced to show
|
||||||
|
;; the final cons cell
|
||||||
|
|
||||||
|
;; One common use for dotted lists is to elegantly represent pairs
|
||||||
|
;; (cons 2 3)
|
||||||
|
;; >> (2 . 3)
|
||||||
|
|
||||||
|
;; Creating pairs like this is conveient and efficient
|
||||||
|
;; we can extract members from the pair using standard car and cdr commands
|
||||||
|
;; efficient because Lisp only needs a single cons cell to connect two items
|
||||||
|
|
||||||
|
;; These types of pairs are commonly used in Lisp programs
|
||||||
|
;; For instance, it could be used to store x/y coors of a point or a key/value
|
||||||
|
;; pair in a complex data structure
|
||||||
|
|
||||||
|
;; Circular lists are a thing. A cons cell can point to an upstream
|
||||||
|
;; cons cell of a list
|
||||||
|
|
||||||
|
;; Before messing with cirular lists, we should do this
|
||||||
|
|
||||||
|
(setf *print-circle* t)
|
||||||
|
|
||||||
|
;; This let's list know we are doing stuff with self-referential data structs
|
||||||
|
;; and that it needs to be careful when printing on the screen
|
||||||
|
|
||||||
|
;; A straightforward way to do this is to use setf to put extra stuff
|
||||||
|
;; in the first parameter
|
||||||
|
|
||||||
|
;; (defparameter foo '(1 2 3))
|
||||||
|
;; (setf (cadddr foo) foo)
|
||||||
|
;; >> #1=(1 2 3 . #1#)
|
||||||
|
|
||||||
|
;; Here we created an infinite list of '(1 2 3 1 2 3 1 2 3 ...)
|
||||||
|
;; by replacing the nil at the end of a simple list with a reference to the
|
||||||
|
;; list itself
|
||||||
|
|
||||||
|
;;Association Lists -- We've used them a bit
|
||||||
|
|
||||||
|
;; alist for short
|
||||||
|
|
||||||
|
;; An alist consists of key/value pairs stored in a list
|
||||||
|
|
||||||
|
;; if a key appears multiple times in a list, it is assumed that the first
|
||||||
|
;; appearance of the key contains the desired value
|
||||||
|
|
||||||
|
;; (defparameter *drink-order* '((bill . double-espresso)
|
||||||
|
;; (lisa . small-drip coffee)
|
||||||
|
;; (john . medium-latte)))
|
||||||
|
|
||||||
|
;; To look up the order for a person...
|
||||||
|
|
||||||
|
;;(assoc 'lisa *drink-order*)
|
||||||
|
|
||||||
|
;; >> (LISA . SMALL-DRIP-COFFEE
|
||||||
|
|
||||||
|
;; The function searches the list from the beginning to find the desired key
|
||||||
|
;; Let's say Lisa wants to change her order so...
|
||||||
|
|
||||||
|
;; (push '(lisa. large-mocha-with-whipped-cream) *drink-order*)
|
||||||
|
|
||||||
|
;; >> ((LISA . LARGE-MOCHA-WITH-WHIPPED-CREAM)
|
||||||
|
;; (BILL . DOUBLE-ESPRESSO)
|
||||||
|
;; (LISA . SMALL-DRIP-COFFEE)
|
||||||
|
;; (JOHN . MEDIUM-LATTE))
|
||||||
|
|
||||||
|
;; Because, by default, the first reference to a key in an alist takes
|
||||||
|
;; precedence over later references to the same key,
|
||||||
|
;; the order lisa placed for a small drip is superseded by her more recent one
|
||||||
|
|
||||||
|
;; (assoc 'lisa *drink-order*)
|
||||||
|
;; >> (LISA . LARGE-MOCHA-WITH-WHIPPED-CREAM)
|
||||||
|
|
||||||
|
;; However, there is an issue with alists.
|
||||||
|
;; They are not very efficient way to store and retrieve data
|
||||||
|
;; Unless dealing with short lists under a doezn items or so
|
||||||
|
;; alists are typically one of the first tools in the Lispers toolbox
|
||||||
|
;; they may be replaced by other data structures as a program matures
|
||||||
|
;; later chapter (9) will explain more
|
||||||
|
|
||||||
|
;; Lisp programs are represented with syntax expressions
|
||||||
|
;; In this format, data is represented using nexted lists
|
||||||
|
;; often with Lisp symbols at the front of each list
|
||||||
|
;; explaining the structure of the data
|
||||||
|
;; Suppose we want to represent the component parts of a house
|
||||||
|
|
||||||
|
(defparameter *house* '((walls (mortar (cement)
|
||||||
|
(water)
|
||||||
|
(sand))
|
||||||
|
(bricks))
|
||||||
|
(windows (glass)
|
||||||
|
(frame)
|
||||||
|
(curtains))
|
||||||
|
(roof (shingles)
|
||||||
|
(chimney))))
|
||||||
|
|
||||||
|
;; This data structure elegantly captures the hierarchical nature of the parts
|
||||||
|
;; That make up a house.
|
||||||
|
|
||||||
|
;; Since it's structured as a Lisp syntax expression, we can see the lists
|
||||||
|
;; that make up the levels of the hierarch
|
||||||
|
;; Also, it follows the convention of a syntax expression by putting a
|
||||||
|
;; symbol at the front of each list
|
||||||
|
|
||||||
|
;; For example, here we have the windows symbol that is then followed by three
|
||||||
|
;; items representing the glass, frame, and curtains
|
||||||
|
|
||||||
|
;; data that is hierarchical and tree-like in nature can be naturally
|
||||||
|
;; expressed in this way
|
||||||
|
|
||||||
|
;; If we move beyond tree-like structures, data stored in a syntax
|
||||||
|
;; expression can become hard to visualize
|
||||||
|
|
||||||
|
;; in mathematics a graph consists of a bunch of nodes connected
|
||||||
|
;; by deges
|
||||||
|
;; Such graphs can be stored in cons cells, but they are difficult
|
||||||
|
;; to visualize. We saw this in Ch 5 when we stored the map of the Wizard's
|
||||||
|
;; house (which consisted of a directed graph) in two alists
|
||||||
|
;; One containing the node info, and one containing the edge info
|
||||||
|
|
||||||
|
;; It's hard to get a decent understanding of such structs
|
||||||
|
;; Unfortunaily, data that has the shape of a graph or contains other
|
||||||
|
;; properties that go beyond simple tree structs are common.
|
||||||
|
;; Fortunatly, there is an open source tool that optimally arranges this data
|
||||||
|
;; to create a pretty drawing of a graph
|
||||||
|
|
||||||
|
;; see seperate file for graphviz stuff
|
||||||
|
|
||||||
|
;; Let's create a graph drawing library, again, see other file
|
6
lisp/land-of-lisp/ch7/uwizard.dot
Normal file
6
lisp/land-of-lisp/ch7/uwizard.dot
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
graph{
|
||||||
|
LIVING_ROOM[label="(LIVING-ROOM (YOU ARE IN A ..."];
|
||||||
|
GARDEN[label="(GARDEN (YOU ARE IN A BEAUT..."];
|
||||||
|
ATTIC[label="(ATTIC (YOU ARE IN THE ATTI..."];
|
||||||
|
GARDEN--LIVING_ROOM[label="(EAST DOOR)"];
|
||||||
|
ATTIC--LIVING_ROOM[label="(DOWNSTAIRS LADDER)"];}
|
Loading…
x
Reference in New Issue
Block a user