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