Relating to a GP project I have a lot of auto-generated lisp snippets that can look basically like this:
(+ 2 (f1 (f2 x y) (f2 x y)))
In short: loads of one-liners.
How would one go about plotting this graphically into a function tree? Preferably by generating graphs in dot or something similar that can easily be shoved through graphviz so that i can render it into something like this:
+
/ \
/ \
2 f1
/ \
/ \
/ \
/ \
f2 f2
/ \ / \
/ \ / \
x y x y
How's this (in Scheme [Dr. Racket]):
(define (as-string elm)
(cond
((string? elm) (string-append "\\\"" elm "\\\""))
((number? elm) (number->string elm))
((symbol? elm) (symbol->string elm))
((null? elm) "*empty-list*")
(else (error "Unrecognized type"))))
(define (node-name-label names labels)
(apply append (map (lambda (a b)
(if (list? a)
(node-name-label a b)
(list (cons a b))))
names labels)))
(define (node-txt names labels)
(apply string-append (map (lambda (x)
(let ((name (car x)) (label (cdr x)))
(string-append name " [label=\"" (as-string label) "\"];\n")))
(node-name-label names labels))))
(define (graph-txt lst)
(apply string-append (map (lambda (x)
(let ((a (car x)) (b (cdr x)))
(string-append a " -- " b ";\n")))
(get-relationships lst))))
(define (declare-nodes lst (basename "node"))
(map (lambda (x n)
(if (and (list? x) (not (empty? x)))
(declare-nodes x (string-append basename "_" (number->string n)))
(string-append basename "_" (number->string n))))
lst
(range 0 (length lst))))
(define (get-relationships lst)
(if (< (length lst) 2)
null
(apply append (map (lambda (x)
(if (list? x)
(cons (cons (car lst) (car x)) (get-relationships x))
(list (cons (car lst) x))))
(cdr lst)))))
(define (range start end)
(if (>= start end)
'()
(cons start (range (+ 1 start) end))))
(define (get-graph code graph-title)
(let ((names (declare-nodes code)))
(string-append
"graph "
graph-title
" {\n"
(node-txt names code)
"\n"
(graph-txt names)
"}")))
Usage: (display (get-graph '(+ 2 (f1 (f2 () y) (f2 x y))) "simple_graph")) produces:
graph simple_graph {
node_0 [label="+"];
node_1 [label="2"];
node_2_0 [label="f1"];
node_2_1_0 [label="f2"];
node_2_1_1 [label="*empty-list*"];
node_2_1_2 [label="y"];
node_2_2_0 [label="f2"];
node_2_2_1 [label="x"];
node_2_2_2 [label="y"];
node_0 -- node_1;
node_0 -- node_2_0;
node_2_0 -- node_2_1_0;
node_2_1_0 -- node_2_1_1;
node_2_1_0 -- node_2_1_2;
node_2_0 -- node_2_2_0;
node_2_2_0 -- node_2_2_1;
node_2_2_0 -- node_2_2_2;
}
I made a quick&dirty perl script that does what i need. Placing it here in case someone else could use it:
Link: http://jarmund.net/stuff/lisp2svg.pl.txt
Example output: http://jarmund.net/graphs/lisp.svg
NB: You're not allowed to laugh at the ugly code, and it only handles the most basic things, so it might require some hacking to do anything more than what i need it for.
Related
I'm learning Racket and I don't know why lst is always empty:
#lang racket
(define sort-asc-by-second
(lambda (lst)
(sort lst
(lambda (x y) (< (cdr x) (cdr y))))))
(define sum
(lambda (lst)
(apply + (map cdr lst))
)
)
(define greater-than
(lambda (lst y)
(cond ((null? lst) (void))
((>= (cdr (car lst)) y) (car lst))
(else (greater-than (cdr lst) y)))))
(define my-procedure
(lambda (lst)
(define sorted (sort-asc-by-second lst))
(define suma (sum lst))
(define probabilidades (map (lambda (p) (cons (car p) (/ (cdr p) suma))) sorted))
(define prob (random))
(car (greater-than lst prob))
)
)
(define lst '())
(do ([x 6000 (- x 1)]
(set! lst (my-procedure '((a . 1)(b . 2)(c . 3)))))
((zero? x) lst))
(display lst)
I want to modify the lst list inside the do, but it doesn't.
Do you know why lst is empty?
UPDATE
I have tested the following instructions with the following results:
> (my-procedure '((a . 1)(b . 2)(c . 3)))
'a
> (set! lst (my-procedure '((a . 1)(b . 2)(c . 3))))
> (display lst)
'a
I still doesn't know why lst is empty when I do the loop.
The do-form is
(do (initialisers)
(stop-condition end-expression)
body)
but you have written
(do (initialiser body)
(stop-condition end-expression))
with the unfortunate effect that the value of (my-procedure '((a . 1)(b . 2)(c . 3))) has been bound to the name set! inside the loop, and lst is never modified.
I guess that you mean this lst:
(define lst '())
You defined it as the empty list. You never set it to anything else.
Maybe the documentation of set! helps a bit. While you are there, look for the documentation of do.
The next problem you might encounter is that setting something to the same value repeatedly will not result in an observable effect (except CPU temperature maybe).
Your code
(do ([x 6000 (- x 1)]
(set! lst (my-procedure '((a . 1)(b . 2)(c . 3)))))
((zero? x) lst))
is the same as
(do ( [x 6000 (- x 1) ]
[set! lst (my-procedure '((a . 1)(b . 2)(c . 3)))] )
((zero? x) lst))
You define set! as one of your loop variables (the other is x). lst is its initial value, and (my-procedure '((a . 1)(b . 2)(c . 3))) its step expression.
So your local binding for set! is repeatedly set to 'a while x is counting down to 0; then the same lst -- which were never changed -- is returned.
Try it:
> (do ([x 0 (- x 1)]
(set! 1 (my-procedure '((a . 1)(b . 2)(c . 3)))))
((zero? x) set!))
1
This is how I make it work:
(do ([x 6000 (- x 1)])
((zero? x))
(set! lst (cons (my-procedure '((a . 1)(b . 2)(c . 3))) lst)))
I need to write a scheme function that returns as a function which then takes another argument, eg a list and in turn return the desired result. In this example (c?r "arg") would return -- (car(cdr -- which then subsequently takes the list argument to return 2
> ((c?r "ar") '(1 2 3 4))
2
> ((c?r "ara") '((1 2) 3 4))
2
The problem I have is how can I return a function that accepts another arg in petite?
Here's how you might write such a function:
(define (c?r cmds)
(lambda (lst)
(let recur ((cmds (string->list cmds)))
(if (null? cmds)
lst
(case (car cmds)
((#\a) (car (recur (cdr cmds))))
((#\d) (cdr (recur (cdr cmds))))
(else (recur (cdr cmds))))))))
Note that I'm using d to signify cdr, not r (which makes no sense, to me). You can also write this more succinctly using string-fold-right (requires SRFI 13):
(define (c?r cmds)
(lambda (lst)
(string-fold-right (lambda (cmd x)
(case cmd
((#\a) (car x))
((#\d) (cdr x))
(else x)))
lst cmds)))
Just wanted to add my playing with this. Uses SRFI-1.
(import (rnrs)
(only (srfi :1) fold)) ;; require fold from SRFI-1
(define (c?r str)
(define ops (reverse (string->list str)))
(lambda (lst)
(fold (lambda (x acc)
((if (eq? x #\a) car cdr) ; choose car or cdr for application
acc))
lst
ops)))
Its very similar to Chris' version (more the previous fold-right) but I do the reverseso i can use fold in the returned procedure. I choose which of car or cdr to call by looking at the character.
EDIT
Here is an alternative version with much more preprocessing. It uses tail-ref and list-tail as shortcuts when there are runs of #\d's.
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (reverse
(if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs)))))
(lambda (lst)
(fold (lambda (fun lst)
(fun lst))
lst
funs))))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
This can be made even simpler in #!racket. we skip the reverse and just do (apply compose1 funs).
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs))))
(apply compose1 funs)))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
Assuming a compose procedure:
(define (compose funs . args)
(if (null? funs)
(apply values args)
(compose (cdr funs) (apply (car funs) args))))
(compose (list cdr car) '(1 2 3 4))
=> 2
c?r can be defined in terms of compose like so:
(define (c?r funs)
(lambda (e)
(compose
(map
(lambda (f) (if (char=? f #\a) car cdr))
(reverse (string->list funs)))
e)))
then
((c?r "ar") '(1 2 3 4))
=> 2
((c?r "ara") '((1 2) 3 4))
=> 2
I'm trying to write a procedure that "encapsulates" (i.e. puts in a list) elements of a list between a "separator" element.
(my-proc '(1 + 2))
=> ((1) (2))
(my-proc '(x * y + z ^ 2 + 1 + 5))
=> ((x * y) (z ^ 2) (1) (5))
(my-proc '((x + 1) * y + 5))
=> (((x + 1) * y) (5))
In this case the procedure can be hard-coded to define the + symbol as the separator.
Assume that foldr (fold right operation) is defined, I'd prefer that it'd be in terms of it.
I'm not giving a full solution since this looks really homework-y.
(define (split-expr expr)
(foldr (lambda (e es)
(if (eq? e '+)
<???> ; do split
(cons (cons e (car es))
(cdr es))))
<???> ; what should start be?
es))
Just for fun, here's a version in continuation-passing style (no foldr, probably not suitable as a homework answer):
(define split/cps
(λ (sep ls)
(let loop ([ls ls] [k (λ (item acc)
(if item (cons item acc) acc))])
(cond
[(null? ls)
(k #f '())]
[(eq? sep (car ls))
(loop (cdr ls)
(λ (item acc)
(k #f (if item (cons item acc) acc))))]
[else
(loop (cdr ls)
(λ (item acc)
(k (if item
(cons (car ls) item)
(list (car ls)))
acc)))]))))
Here's another way to do it, also without foldr:
(define split/values
(λ (sep ls)
(let loop ([ls ls])
(cond
[(null? ls)
'()]
[else
(let-values ([(a d) (car-to-sep sep ls)])
(if (null? a)
(loop d)
(cons a (loop d))))]))))
(define car-to-sep
(λ (sep ls)
(let loop ([ls ls] [a '()])
(cond
[(null? ls)
(values '() '())]
[(eq? sep (car ls))
(values '() (cdr ls))]
[else
(let-values ([(a d) (loop (cdr ls) a)])
(values (cons (car ls) a) d))]))))
Basically, I want '( (whatever1) (whatever2) (whatever3) ... ) ===> ( "(whatever1)" "(whatever2)" "(whatever3)" ), which is just add quotes outside of the list, and keep the contents in the list unchanged. e.g.
'((define X ::int)
(define b0 :: bool (=> T (and (= X X) (= 0 0)))))
will be turned into:
'("(define X ::int)"
"(define b0 :: bool (=> T (and (= X X) (= 0 0))))")
However, the following code I am using eliminate all spaces!
#lang racket
(require syntax/to-string)
(define lst-sub '((define x :: int) (=> T (and (= X X) (= 0 0)))))
(pretty-write (map (λ (x) (string-append "(" (syntax->string (datum->syntax #f x)) ")")) lst-sub))
which returns
("(definex::int)" "(=>T(and(=XX)(=00)))")
So the question is: there is no spaces anymore!
How can I get around this??
#lang racket
(define lst-sub '((define x :: int) (=> T (and (= X X) (= 0 0)))))
(pretty-write (map (λ (x) (format "~s" x)) lst-sub))
Alright. I don't take the "easy" route I thought. and worked out as follows, which ends up with more lines of code :(
(define (toString-with-space data)
(match data
[(? symbol?) (string-append (symbol->string data) " ")]
[(? number?) (string-append (number->string data) " ")]))
(define (flat-def def-lst)
(if (empty? def-lst)
(list)
(begin
(let ([f (car def-lst)])
(if (not (list? f))
(cons (toString-with-space f) (flat-def (drop def-lst 1)))
(append (list "(") (flat-def f) (flat-def (drop def-lst 1)) (list ")")))))))
(define (lstStr->lstChars lst-str)
(for/fold ([l empty])
([el (in-list lst-str)])
(append l (string->list el))))
(define flat (flat-def ' (define b1 :: bool (=> (and (= X x) (= Y y)) (and (= Y y) (= X x))))))
(set! flat (append (list "\"" "(") flat (list ")" "\"")))
(set! flat (lstStr->lstChars flat))
(set! flat (list->string flat))
(display flat)
The function I wrote for SICP 2.20 is:
(define (same-parity x . y)
(if (null? (car y)
'()
(if (= (even? (car y)) (even? x))
(cons (car y) (same-parity (cons x (cdr y))))
(same-parity (cons x (cdr y))))))
And then I try to call it with
(same-parity 1 2 3 4 5 6 7)
The error I get is:
"The object #t, passed as the first argument to integer-equal? is not the correct type."
I thought that equal works with #t and #f...
An example of code I found online is the following, I ran it and it works. But, what am I doing wrong?
(define (same-parity a . rest)
(define (filter rest)
(cond ((null? rest) '())
((= (remainder a 2) (remainder (car rest) 2))
(cons (car rest) (filter (cdr rest))))
(else
(filter (cdr rest)))))
(filter (cons a rest)))
The = procedure accepts numbers. But even? returns a boolean not a number.
Use equal? instead of =.
equal? works with booleans.
For instance at the REPL:
> (even? 2)
#t
> (= (even? 2) (even? 2))
=: expects type <number> as 1st argument, given: #t; other arguments were: #t
> (equal? (even? 2) (even? 2))
#t