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.
Related
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.
I am using Scheme language to take the derivative of an inputted expression, and for the most part I believe my table driven function is working well enough but now I'd like to create a few expressions to handle simplifying the output.
For Example:
(d '(* (+ x 1) (+ x -1))) -> '(* 2 x) Rather than -> '(+ (* (+ x 1) (+ 1 0)) (* (+ 1 0) (+ x -1)))
I am rather new to Scheme so I know this is just a matter of being able to recursively parse lists but I'm not sure where to start, any idea how to achieve this?
Here is my code for the function
(define lookup (lambda (x alist) (cadr (assoc x alist))))
;-----------------------------------------------------
(define d
(lambda (e)
(cond ((number? e) 0)
((equal? e 'x) 1)
(else
(let ((op (car e)) (args (cdr e)))
(apply (lookup op d-op-table) args))))))
(define d-op-table
(list(list '+ (lambda (u v)(list '+ (d u) (d v))))
(list '- (lambda (u v)(list '- (d u) (d v))))
(list '* (lambda (u v)(list '+ (list '* u (d v))(list '* (d u) v))))
(list 'sin (lambda (u)(list '*( list 'cos (d u)))))
(list 'cos (lambda (u)(list '*( list '-sin (d u)))))
(list 'log (lambda (u)(list '* (list '/ 1 u) (d u))))
(list 'exp (lambda (u)(list '* (d u)(list 'exp u))))
(list 'expt (lambda (u v) (list 'expt (list '* v u) (- v 1))))))
I have created a function that takes a list as input and returns either a list or a atom. I want to apply this function to a deep list, starting with the inner lists, then finish once the function has been run on the outer list.
Can somebody give me some direction on this?
A sample input would be (a b (c (d e))) z) the function should compute on (d e) first with a result of say f. then the function should compute on (c f) with a result of say g then similarly on (a b g z) to produce an output of h.
An example function could be:
(define sum
(lambda (l)
(if (not (pair? l))
0
(+ (car l) (sum (cdr l))))))
Where input would be (1 2 (3 4) 5) > 15
Assuming your example transformation, expressed as a Scheme procedure:
(define (transform lst)
(case lst
(((d e)) 'f)
(((c f)) 'g)
(((a b g z)) 'h)
(else (error (~a "wot? " lst)))))
then what you are looking for seems to be
(define (f lst)
(transform
(map (lambda (e)
(if (list? e) (f e) e))
lst)))
Testing:
> (f '(a b (c (d e)) z))
'h
Here is an example:
(define product
(lambda (l)
(cond
[(number? l) l]
[(pair? l) (* (product (car l)) (product (cdr l)))]
[else 1])))
> (product '(1 2 (3 4) 5))
120
Im want to make a function where rootcheck has a list L as input, L always is 3 atoms (a b c) where a is coefficient of x^2, b coef of x and c is the constant. it checks if the equation is quadratic, using discriminant (b^2 - 4ac) and should output this (num 'L) where num is the number of roots and L is a list that contains the roots themselves (using quadratic formula), L is empty in case of no roots. here is my code:
(define roots-2
(lambda (L)
(let ((d (- (* (cdr L) (cdr L)) (4 (car L) (caddr L))))))
(cond ((< d 0) (cons(0 null)))
((= d 0) (cons(1 null)))
(else((> d 0) (cons(2 null)))))
))
its giving me no expression in body error.
also I tried to code the quadratic function and even tried some that are online, one compiled fint but gave me an error when I inserted input this is the code for the quadratic function, NOT MINE!
(define quadratic-solutions
(lambda (a b c) (list (root1 a b c) (root2 a b c))))
(define root1
(lambda (a b c) (/ (+ (- b) (sqrt (discriminant a b c)))
(* 2 a))))
(define root2
(lambda (a b c) (/ (- (- b) (sqrt (discriminant a b c)))
(*2 a))))
(define discriminant
(lambda (a b c) (- (square b) (* 4 (* a c)))))
There are several mistakes in the code:
Some parentheses are incorrectly placed, use a good IDE to detect such problems. This is causing the error reported, the let doesn't have a body
You forgot to multiply in the 4ac part
You're incorrectly accessing the second element in the list
The else part must not have a condition
The output list is not correctly constructed
This should fix the errors, now replace null with the actual call to the function that calculates the roots for the second and third cases (the (< d 0) case is fine as it is):
(define roots-2
(lambda (L)
(let ((d (- (* (cadr L) (cadr L)) (* 4 (car L) (caddr L)))))
(cond ((< d 0) (list 0 null))
((= d 0) (list 1 null))
(else (list 2 null))))))
for the quadractic function part, I found a code online and tweaked it to provide both roots of a quadratic equation. returns a list of both roots
(define (solve-quadratic-equation a b c)
(define disc (sqrt (- (* b b)
(* 4.0 a c))))
(list (/ (+ (- b) disc) (* 2.0 a))
(/ (- (- b) disc) (* 2.0 a))
))
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)))