I'm trying to figure out how to use vertex-attributes with racket graphviz (graph library). For example adding some style attributes. Here's what I have so far.
#lang racket
(require graph)
(define mygraph (directed-graph '(
(
(a b)
(c d)
)
)))
(define-vertex-property mygraph style #:init "")
(style-set! 'b "filled, bold")
(define graphtext (graphviz mygraph
#:vertex-attributes [style 'mygraph]))
In the function definition for graphviz It says that #:vertex-attributes must be a list of lists and contain a symbol or procedure. But it also implies that you have to use #:vertex-attributes in conjunction with define-vertex-property but I'm not exactly sure how I connect the two.
A couple variations I've tried with no success...
(define graphtext (graphviz mygraph
#:vertex-attributes [style 'b]))
(define graphtext (graphviz mygraph
#:vertex-attributes [style 'b]))
(define graphtext (graphviz mygraph
#:vertex-attributes [style (lambda () 'b)]))
Try this:
(define graphtext
(graphviz mygraph
#:vertex-attributes `([style ,style])))
The graph library tests were helpful in figuring it out.
From the documentation you linked, #:vertex-attributes associates an attribute name (corresponding to symbol? in the contract) with a vertex property. The form
(define-vertex-property graph prop-name maybe-init maybe-vs)
defines a vertex property prop-name, which is a procedure (corresponding to procedure? in the contract).
`([style ,style]) associates the attribute name style with the vertex property style.
Related
I’d like to develop an efficient strategy that can quickly test if a pre-specified path exists in a large fully-connected directed labeled graph. For example, starting at some node, say node0, does there exist a path to another node, say node9, that follows a sequence of labeled links, say node0 -> link3 -> link1 -> link4+ -> link1 -> node9, where link+ means one or more repetitions of that link’s label. The graph is dynamic, such that nodes and links will be continuously added and deleted. Unique node and link labels would be strings constructed from underlying semantic information.
My first (simplest) idea is to intern all labeled graph nodes and links in a separate package as symbols. Then install a hash table as the symbol-value of each node. The hash table would carry the associations for that node from all of the links emanating from that node to their respective target nodes. Testing whether the next link in the chain exists, then is a simple table lookup. The total number of lookups depends on the length of the chain of links. All programmatic references to node and label symbols would be via the package name.
However, I’m not sure about the advisability of using symbols and symbol values as data structures. Does putting them in their own package mitigate potential conflicts in this case?
If you want to use symbols, you do not need hash-tables; you can store data in the symbol-value slot of the symbol, and any additional data in its symbol-plist. Lookup is either already done at read time, or with find-symbol or intern at runtime. You could use unintern to dissociate the symbol from its home package, but other nodes could still reference it, so you would need to remove any other reference to that symbol when removing a node (that's why sometimes you store both the ingoing and outgoing edges of a node).
It can be done, and as far as I know, this used to be a common way to work with symbols historically. One possible drawback is that when you create a package you have to name it (so no on-the-fly, anonymous package). You have to potentially choose a string that is not currently used as a package name, and you restrict the name of your nodes to a specific package.
Another way to implement this is to have a node class which holds a name, where the name can be any symbol the user choose (in any package). A graph class maintains all nodes, and edges, etc, and you can manipulate those objects in isolation, without messing up with the environment's list of packages, etc. This could be a little bit cleaner.
It was recently made available, so I'd like also to point out that this book exists: Programming Algorithms by Vsevolod Domkin, which uses Common Lisp to implement algorithms.
Rather than obsess about implementation, I would design a protocol which the system needs to follow. Here is one such (note I have made some assumptions here, some of which are probably implicit, and none of which may agree with how you want things to work):
;;;; Protocol
;;;
;;; By assumption there is one link with each label, each link points
;;; at one other node.
;;;
;;; NODEs have identity and can be destructively modified but it is
;;; not specified whether node equality is object identity.
;;;
(defgeneric node-link-labelled (node label)
(:documentation "Return the node linked to NODE via LABEL, or NIL".))
(defgeneric (setf node-link-labelled) (target node label)
(:documentation "set the link with label LABEL of NODE to TARGET, replacing it if
it exists. Return TARGET."))
(defgeneric nodes-equal (n1 n2)
(:documentation "Are N1 and N2 the same node?"))
(defgeneric node-remove-link (node label)
(:documentation "Remove the link with label LABEL from NODE. Return NODE.
The link need not exist"))
(defgeneric mapc-node-links (fn node)
(:documentation "call FN with arguments NODE, LABEL TARGET for each link of NODE.
FN is allowed to delete the link corresponding to LABEL but should not otherwise
modify NODE"))
Then you can write implementations for this protocol. Here is a simple one in which nodes are conses of (<something> . <links>). This will be slow for large numbers of links, but probably very fast for small numbers. It has the nice feature that you can give nodes names, which is not supported in the above protocol.
;;;; Consy nodes are simple
;;;
(defun make-consy-node (&optional (label 'node))
(list label))
(defmethod node-link-labelled ((node cons) label)
(cdr (assoc label (cdr node))))
(defmethod nodes-equal ((n1 cons) (n2 cons))
(eql n1 n2))
(defmethod (setf node-link-labelled) (target (node cons) label)
(let ((found (assoc label (cdr node))))
(if found
(setf (cdr found) target)
(push (cons label target) (cdr node))))
target)
(defmethod node-remove-link ((node cons) label)
(setf (cdr node) (delete-if (lambda (link)
(eql (car link) label))
(cdr node)))
node)
(defmethod mapc-node-links (fn (node cons))
;; This is at least safe
(loop for (label . target) in (copy-list (cdr node))
do (funcall fn node label target))
node)
Or you can implement nodes as hash tables, which will be fast for graphs with many per-node links:
;;;; Hashy nodes
;;;
(defun make-hashy-node ()
(make-hash-table))
(defmethod nodes-equal ((n1 hash-table) (n2 hash-table))
(eql n1 n2))
(defmethod node-link-labelled ((node hash-table) label)
(values (gethash label node nil)))
(defmethod (setf node-link-labelled) (target (node hash-table) label)
(setf (gethash label node) target)
target)
(defmethod node-remove-link ((node hash-table) label)
(remhash label node)
node)
(defmethod mapc-node-links (fn (node hash-table))
(maphash (lambda (label target)
(funcall fn node label target))
node)
node)
Or you can do any number of other things. And since they all follow the protocol you can mix them:
(let ((n1 (make-hashy-node)))
(setf (node-link-labelled n1 'foo) (make-hashy-node)
(node-link-labelled n1 'bar) (make-consy-node 'n2))
n1)
You can define node construction as part of the protocol if you want:
(defgeneric make-node-of-sort (sort &key)
(:documentation "make a node whose sort is SORT. Methods on this GF should
use EQL specializers on SORT"))
...
(defmethod make-node-of-sort ((sort (eql 'consy)) &key (name 'node))
(list name))
...
I'm Haruo. My pleasure is solving SPOJ in Common Lisp(CLISP). Today I solved Classical/Balk! but in SBCL not CLISP. My CLISP submit failed due to runtime error (NZEC).
I hope my code becomes more sophisticated. Today's problem is just a chance. Please the following my code and tell me your refactoring strategy. I trust you.
https://github.com/haruo-wakakusa/SPOJ-ClispAnswers/blob/0978813be14b536bc3402f8238f9336a54a04346/20040508_adrian_b.lisp
Haruo
Take for example get-x-depth-for-yz-grid.
(defun get-x-depth-for-yz-grid (planes//yz-plane grid)
(let ((planes (get-planes-including-yz-grid-in planes//yz-plane grid)))
(unless (evenp (length planes))
(error "error in get-x-depth-for-yz-grid"))
(sort planes (lambda (p1 p2) (< (caar p1) (caar p2))))
(do* ((rest planes (cddr rest)) (res 0))
((null rest) res)
(incf res (- (caar (second rest)) (caar (first rest)))))))
style -> ERROR can be replaced by ASSERT.
possible bug -> SORT is possibly destructive -> make sure you have a fresh list consed!. If it is already fresh allocated by get-planes-including-yz-grid-in, then we don't need that.
bug -> SORT returns a sorted list. The sorted list is possibly not a side-effect. -> use the returned value
style -> DO replaced with LOOP.
style -> meaning of CAAR unclear. Find better naming or use other data structures.
(defun get-x-depth-for-yz-grid (planes//yz-plane grid)
(let ((planes (get-planes-including-yz-grid-in planes//yz-plane grid)))
(assert (evenp (length planes)) (planes)
"error in get-x-depth-for-yz-grid")
(setf planes (sort (copy-list planes) #'< :key #'caar))
(loop for (p1 p2) on planes by #'cddr
sum (- (caar p2) (caar p1)))))
Some documentation makes a bigger improvement than refactoring.
Your -> macro will confuse sbcl’s type inference. You should have (-> x) expand into x, and (-> x y...) into (let (($ x)) (-> y...))
You should learn to use loop and use it in more places. dolist with extra mutation is not great
In a lot of places you should use destructuring-bind instead of eg (rest (rest )). You’re also inconsistent as sometimes you’d write (cddr...) for that instead.
Your block* suffers from many problems:
It uses (let (foo) (setf foo...)) which trips up sbcl type inference.
The name block* implies that the various bindings are scoped in a way that they may refer to those previously defined things but actually all initial value may refer to any variable or function name and if that variable has not been initialised then it evaluates to nil.
The style of defining lots of functions inside another function when they can be outside is more typical of scheme (which has syntax for it) than Common Lisp.
get-x-y-and-z-ranges really needs to use loop. I think it’s wrong too: the lists are different lengths.
You need to define some accessor functions instead of using first, etc. Maybe even a struct(!)
(sort foo) might destroy foo. You need to do (setf foo (sort foo)).
There’s basically no reason to use do. Use loop.
You should probably use :key in a few places.
You write defvar but I think you mean defparameter
*t* is a stupid name
Most names are bad and don’t seem to tell me what is going on.
I may be an idiot but I can’t tell at all what your program is doing. It could probably do with a lot of work
Does anyone know how I can figure out the free variables in a lambda expression? Free variables are the variables that aren't part of the lambda parameters.
My current method (which is getting me nowhere) is to simply use car and cdr to go through the expression. My main problem is figuring out if a value is a variable or if it's one of the scheme primitives. Is there a way to test if something evaluates to one of scheme's built-in functions? For example:
(is-scheme-primitive? 'and)
;Value: #t
I'm using MIT scheme.
For arbitrary MIT Scheme programs, there isn't any way to do this. One problem is that the function you describe just can't work. For example, this doesn't use the 'scheme primitive' and:
(let ((and 7)) (+ and 1))
but it certainly uses the symbol 'and.
Another problem is that lots of things, like and, are special forms that are implemented with macros. You need to know what all of the macros in your program expand into to figure out even what variables are used in your program.
To make this work, you need to restrict the set of programs that you accept as input. The best choice is to restrict it to "fully expanded" programs. In other words, you want to make sure that there aren't any uses of macros left in the input to your free-variables function.
To do this, you can use the expand function provided by many Scheme systems. Unfortunately, from the online documentation, it doesn't look like MIT Scheme provides this function. If you're able to use a different system, Racket provides the expand function as well as local-expand which works correctly inside macros.
Racket actually also provides an implementation of the free-variables function that you ask for, which, as I described, requires fully expanded programs as input (such as the output of expand or local-expand). You can see the source code as well.
For a detailed discussion of the issues involved with full expansion of source code, see this upcoming paper by Flatt, Culpepper, Darais and Findler.
[EDIT 4] Disclaimer; or, looking back a year later:
This is actually a really bad way to go about solving this problem. It works as a very quick and dirty method that accomplishes the basic goal of the OP, but does not stand up to any 'real life' use cases. Please see the discussion in the comments on this answer as well as the other answer to see why.
[/EDIT]
This solution is probably less than ideal, but it will work for any lambda form you want to give it in the REPL environment of mit-scheme (see edits). Documentation for the procedures I used is found at the mit.edu doc site. get-vars takes a quoted lambda and returns a list of pairs. The first element of each pair is the symbol and the second is the value returned by environment-reference-type.
(define (flatten lst)
(cond ((null? lst) ())
((pair? (car lst)) (append (flatten (car lst)) (flatten (cdr lst))))
(else
(cons (car lst) (flatten (cdr lst))))))
(define (get-free-vars proc-form)
(let ((env (ge (eval proc-form user-initial-environment))))
(let loop ((pf (flatten proc-form))
(out ()))
(cond ((null? pf) out)
((symbol? (car pf))
(loop (cdr pf) (cons (cons (car pf) (environment-reference-type env (car pf))) out)))
(else
(loop (cdr pf) out))))))
EDIT: Example usage:
(define a 100)
(get-vars '(lambda (x) (* x a g)))
=> ((g . unbound) (a . normal) (x . unbound) (* . normal) (x . unbound) (lambda . macro))
EDIT 2: Changed code to guard agains calling environment-reference-type being called with something other than a symbol.
EDIT 3: As Sam has pointed out in the comments, this will not see the symbols bound in a let under the lambda as having any value.. not sure there is an easy fix for this. So, my statement about this taking any lambda is wrong, and should have read more like "Any simple lambda that doesn't contain new binding forms"... oh well.
;checks to see if two sets (represented as lists) are equal
(define (setsEqual? S1 S2)
(cond
( (null? (cdr S1)) (in_member S1 S2))
( (in_member (car S1) S2) (setsEqual? (cdr S1) S2))
(else false)))
;checks for an element in the list
(define (in_member x list)
(cond
( (eq? x (car list)) true)
( (null? list) false)
(else (in_member x (cdr list)))))
Can't seem to find a base case to get this working. Any help is appreciated!
What is a set? (It's a list---okay, what is a list?) Here's a hint: there are two variants of "list": '() (aka null, aka empty) and those made with cons. Your function(s) should follow the structure of the data they consume. Yours don't.
I recommend reading How to Design Programs (text available online); it will teach you a "design recipe" for tackling problems like these. The rough outline is: describe your data semi-formally (that answers what is a list?), formulate examples and tests; use your description of the data to create a template for processing that kind of data; finally, fill in the template. The key thing is that the template is determined by the data definition. It's reusable, and filling in the template for a specific function can often be done in seconds---if you've created your template and examples correctly.
HtDP Chapter 9 talks about processing lists, specifically. That'll help with in_member.
Chapter 17 talks about processing multiple complex arguments (eg, two lists at once). One more hint: if I were writing this function, I would make use of the following fact about sets: two sets are equal if each is a subset of the other.
I am familiar with Common Lisp and trying to learn some Scheme, so I have been trying to understand how I'd use Scheme for things I usually code in Common Lisp.
In Common Lisp there's fboundp, which tells me if a symbol (the value of a variable) is bound to a function. So, I would do this:
(let ((s (read)))
(if (fboundp s)
(apply (symbol-function s) args)
(error ...)))
Is that possible in Scheme? I've been trying to find this in the R6RS spec but coudn't find anything similar.
This way?
check if it is a symbol
evaluate the symbol using EVAL to get its value
check if the result is a procedure with PROCEDURE?
In Scheme, functions are not tied to symbols like they are in Common Lisp. If you need to know, whether a value is actually a procedure, you can use the procedure? predicate:
(if (procedure? s) (do-something-with s) (do-something-else))
There is no direct way in portable Scheme to achieve, what your example code wants to do, as symbols in Scheme are simply kind of unified strings, lacking Common Lisp's value/function/plist slots.
You could try something like:
(define function-table (list `(car ,car) `(cdr ,cdr) `(cons ,cons) `(display ,display)))
(let* ((s (read))
(f (cond ((assq s function-table) => cadr)
(else (error "undefined function")))))
(apply f args))
i.e., defining your own mapping of "good" functions. This would have the advantage, that you can limit the set of function to only "safe" ones, or whatsoever.