lisp:land-of-lisp:ch7

This commit is contained in:
Logen Kain 2017-07-04 20:51:40 -07:00
parent fcce94e59f
commit 4c63f5ee18
4 changed files with 449 additions and 0 deletions

View 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))))

View 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*)

View 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

View 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)"];}