How to use multiple statements inside cond? - scheme

For example I have the following code, I define a variable v1 then check the value of v1. If v1 == 1, I want to (print-list q2) and read another input and store to v2, something like this: (define v2 (read)).
(define v1 (read))
(cond
[(null? v1) (printf "No input..\n")]
[(= v1 1) (print-list q2)]
How do I achieve my solution above?

You can write more than one expression after a cond's condition:
(define v1 (read))
(cond
[(null? v1) (printf "No input..\n")]
[(= v1 1)
(define v2 (read))
(print-list q2)]
[else (error "Unexpected value")])
Of course, the above will only work if print-list and q2 were previously defined, but it illustrates the general idea of what you want to do. Just remember that although all expressions after the condition will be executed sequentially, only the value of the last expression will be returned, which in this example is (print-list q2).

One can also use recursion to read repeatedly:
(define (f)
(let loop ((v (read)))
(cond [(= 0 v) "End."]
[(= 1 v) (println '(a b c))]
; [.. other options ..]
[else
(println '(1 2 3))
(loop (read))])))
Testing:
(f)
1
'(a b c)
0
"End."
>

Related

Problems about Scheme with postfix

Here is my code about postfix in scheme:
(define (stackupdate e s)
(if (number? e)
(cons e s)
(cons (eval '(e (car s) (cadr s))) (cddr s))))
(define (postfixhelper lst s)
(if (null? lst)
(car s)
(postfixhelper (cdr lst) (stackupdate (car lst) s))))
(define (postfix list)
(postfixhelper list '()))
(postfix '(1 2 +))
But when I tried to run it, the compiler said it takes wrong. I tried to check it, but still can't find why it is wrong. Does anyone can help me? Thanks so much!
And this is what the compiler said:
e: unbound identifier;
also, no #%app syntax transformer is bound in: e
eval never has any information about variables that some how are defined in the same scope as it is used. Thus e and s does not exist. Usually eval is the wrong solution, but if you are to use eval try doing it as as little as you can:
;; Use eval to get the global procedure
;; from the host scheme
(define (symbol->proc sym)
(eval sym))
Now instead of (eval '(e (car s) (cadr s))) you do ((symbol->proc e) (car s) (cadr s)). Now you should try (postfix '(1 2 pair?))
I've made many interpreters and none of them used eval. Here is what I would have done most of the time:
;; Usually you know what operators are supported
;; so you can map their symbol with a procedure
(define (symbol->proc sym)
(case sym
[(+) +]
[(hyp) (lambda (k1 k2) (sqrt (+ (* k1 k1) (* k2 k2))))]
[else (error "No such operation" sym)]))
This fixes the (postfix '(1 2 pair?)) problem. A thing that I see in your code is that you always assume two arguments. But how would you do a double? eg something that just doubles the one argument. In this case symbol->proc could return more information:
(define (symbol->op sym)
(case sym
[(+) (cons + 2)]
[(double) (cons (lambda (v) (* v v)) 1)]
[else (error "No such operation" sym)]))
(define op-proc car)
(define op-arity cdr)
And in your code you could do this if it's not a number:
(let* ([op (symbol->op e)]
[proc (op-proc op)]
[arity (op-arity op)])
(cons (apply proc (take s arity)
(drop s arity)))
take and drop are not R5RS, but they are simple to create.

Scheme - Deriviative using table

I am trying to get the derivative in scheme using the code below. Would anyone be able to tell me where I am going wrong? I have been trying to figure it out for a while now.
(define d3
(λ (e)
(cond ((number? e) 0)
((equal? e 'x) 1)
(else
;; We handle only BINARY ops here, and only + and *
(let ((op (car e)) (args (cdr e)))
(apply (lookup op d-op-table) args))))))
(define d-op-table
(list(list '+ (λ (u v) (+ (d3 u) (d3 v))))
(list '+ (λ (u1 v1)
(list '(* u1 (d v1)))(list '(* (d u1) v1))))))
(define lookup
(λ (op table)
(if (equal? op (caar table))
(cadar table)
(lookup op (cdr table)))))
When I run the function, I get the following error. I input, (d3 '(* 2 x)).
caar: contract violation
expected: (cons/c pair? any/c)
given: '()
The lookup table is incorrect, sometimes you evaluate expressions but others you just quote them, without evaluating them. For example, '(* u1 (d v1)) will just evaluate to '(* u1 (d v1)), the derivate is not actually computed! The multiplication case looks particularly bad, it doesn't even have the proper search key *.
This is closer to what you intended, notice that you need more work to actually detect which expressions can be simplified - for instance: (* 0 x) is 0, but it should be enough to get you started:
(define d-op-table
(list (list '+ (λ (u v) (list '+ (d3 u) (d3 v))))
(list '* (λ (u v)
(list '+
(list '* u (d3 v))
(list '* (d3 u) v))))))
Now your example works:
(d3 '(* 2 x))
=> '(+ (* 2 1) (* 0 x))
If you want to write a truly useful differentiation procedure, better take a look at SICP.

car implementation in scheme

I am trying to write by myself the cons function in scheme. I have written this code:
(define (car. z)
(z (lambda (p q) p)))
and I am trying to run :
(car. '(1 2 3))
I expect to get the number 1, but it does not work properly.
When you implement language data structures you need to supply constructors and accessors that conform to the contract:
(car (cons 1 2)) ; ==> 1
(cdr (cons 1 2)) ; ==> 2
(pair? (cons 1 2)) ; ==> 2
Here is an example:
(define (cons a d)
(vector a d))
(define (car p)
(vector-ref p 0))
(define (cdr p)
(vector-ref p 1))
Now if you make an implementation you would implement read to be conformant to this way of doing pairs so that '(1 2 3) would create the correct data structure the simple rules above is still the same.
From looking at car I imagine cons looks like this:
(define (cons a d)
(lambda (p) (p a d)))
It works with closures. Now A stack machine implementation of Scheme would analyze the code for free variables living passed their scope and thus create them as boxes. Closures containing a, and d aren't much different than vectors.
I urge you to implement a minimalistic Scheme interpreter. First in Scheme since you can use the host language, then a different than a lisp language. You can even do it in an esoteric language, but it is very time consuming.
Sylwester's answer is great. Here's another possible implementation of null, null?, cons, car, cdr -
(define null 'null)
(define (null? xs)
(eq? null xs))
(define (cons a b)
(define (dispatch message)
(match message
('car a)
('cdr b)
(_ (error 'cons "unsupported message" message))
dispatch)
(define (car xs)
(if (null? xs)
(error 'car "cannot call car on an empty pair")
(xs 'car)))
(define (cdr xs)
(if (null? xs)
(error 'cdr "cannot call cdr on an empty pair")
(xs 'cdr)))
It works like this -
(define xs (cons 'a (cons 'b (cons 'c null))))
(printf "~a -> ~a -> ~a\n"
(car xs)
(car (cdr xs))
(car (cdr (cdr xs))))
;; a -> b -> c
It raises errors in these scenarios -
(cdr null)
; car: cannot call car on an empty pair
(cdr null)
; cdr: cannot call cdr on an empty pair
((cons 'a 'b) 'foo)
;; cons: unsupported dispatch: foo
define/match adds a little sugar, if you like sweet things -
(define (cons a b)
(define/match (dispatch msg)
(('car) a)
(('cdr) b)
(('pair?) #t)
((_) (error 'cons "unsupported dispatch: ~a" msg)))
dispatch)
((cons 1 2) 'car) ;; 1
((cons 1 2) 'cdr) ;; 2
((cons 1 2) 'pair?) ;; #t
((cons 1 2) 'foo) ;; cons: unsupported dispatch: foo

Loop for-each in Scheme

I'm new to Scheme...
can someone please explain for me why the for-each statement doesn't print out the output??
I have a graph defined:
(define graph '((a (b.c)) (c (d))))
and my test code:
(define testing
(lambda (a-list)
(if (null? a-list)
"size = 0"
(for-each (lambda (i)
(cons (car i) (length (cdr i)))
(length a-list))
a-list))))
when run this (testing graph), output expected is ((a . 2) (c . 1)) but it display nothing...
The for-each procedure doesn't build a list as output, it just executes a procedure on each of the input list's elements. You're looking for map, which creates a new list with the result of applying a function to each of the elements in the input list. Also notice that there are bugs in your code regarding the creation/traversal of the graph. This should fix the problems:
(define graph
'((a (b c)) ; fixed a bug here
(c (d))))
(define testing
(lambda (a-list)
(if (null? a-list)
"size = 0"
(map (lambda (i)
(cons (car i) (length (cadr i)))) ; fixed a bug here
a-list))))
Now it works as expected:
(display (testing graph))
=> '((a . 2) (c . 1))

binary trees searching inside

Can anyone tell me what I need to do here?
(define (count-values abst v)
(cond [(empty? abst) 0]
[else (+ (cond [(equal? v (bae-fn abst)) 1]
(else 0))
(count-values .... v)
(count-values .... v ))]))
I basically need a function that counts the amount of symbols v inside a binary tree
(define bae
(make-bae '+
(make-bae '* (make-bae '+ 4 1)
(make-bae '+ 5 2))
(make-bae '- 6 3)))
(count-values bae '+) => 3
because there are 3 '+ in bae
You need to:
Post the definition of the tree - I'm guessing bae is a struct - don't assume we know your code, post all the relevant information as part of the question
Make sure that the code you post works at least in part - for instance, the (define bae ...) part won't work even if you provided the definition of bae, because of a naming conflict
Follow the recipe for traversing a binary tree, I bet it's right in the text book
The general idea for the solution goes like this, without taking a look at the actual implementation of the code you've done so far is the only help I can give you:
If the tree is empty, then return 0
If the current element's value equals the searched value, add 1; otherwise add 0
Either way, add the value to the result of recursively traversing the left and right subtrees
If you define your data structure recursively, then a recursive count algorithm will naturally arise:
;; Utils
(define (list-ref-at n)
(lambda (l) (list-ref l n)))
(define (eq-to x)
(lambda (y) (eq? x y)))
;; Data Type
(define (make-bae op arg1 arg2)
`(BAE ,op, arg1, arg2))
(define (bae? thing)
(and (list? thing) (eq? 'BAE (car thing)) (= 4 (length thing))))
(define bae-op (list-ref-at 1))
(define bae-arg1 (list-ref-at 2))
(define bae-arg2 (list-ref-at 3))
;; Walk
(define (bae-walk func bae) ;; 'pre-ish order'
(if (not (bae? bae))
(func bae)
(begin
(func (bae-op bae))
(bae-walk func (bae-arg1 bae))
(bae-walk func (bae-arg2 bae)))))
;; Count
(define (bae-count-if pred bae)
(let ((count 0))
(bae-walk (lambda (x)
(if (pred x)
(set! count (+ 1 count))))
bae)
count))
(define (bae-count-if-plus bae)
(bae-count-if (eq-to '+) bae))
> bae
(BAE + (BAE * (BAE + 4 1) (BAE + 5 2)) (BAE - 6 3))
> (bae-count-if-plus bae)
3
;; Find
(define (bae-find-if pred bae)
(call/cc (lambda (exit)
(bae-walk (lambda (x)
(if (pred x) (exit #t)))
bae)
#f)))

Resources