The d function should return the derivate of the inputted expression in its simplified form. I understand there is a derivate scheme function but instead I'm using lists to challenge myself. I am new to the language. I've written test cases to test my solution but the expected output is wrong and not simplified.
(define d
(λ (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 '+ (λ (u v)(list '+ (d u) (d v))))
(list '- (λ (u v)(list '- (d u) (d v))))
(list '* (λ (u v)(list '+ (list '* u (d v))(list '* v (d u)))))))
(list 'sin (λ (u)(list '*( list 'cos (d u)))))
(list 'cos (λ (u)(list '*( list '-sin (d u)))))
(list 'log (λ (u)(list '* (list '/1 u) (d u))))
(list 'exp (λ (u)(list '* (d u)(list 'exp u))))
(list 'expt (λ (u v) (list 'expt (list '* v u) (- v 1))))
(define lookup
(λ (op
table)
(if (equal? op (caar table))
(cadar table)
(lookup op (cdr table)))))
;; Test cases
;; (d '(* (+ x 4) (+ x -7)))
;; '(+ (* (+ x 4) (+ 1 0)) (* (+ x -7) (+ 1 0)))
;; (d '(* x (* x (* x (* x x)))))
;; '(+ (* x (+ (* x (+ (* x (+ (* x 1) (* x 1))) (* (* x x) 1))) (* (* x (* x x)) 1))) (* (* x (* x (* x x))) 1))
Example:
By inputting the function
(d '(* (+ x 1) (+ x -1)))
I expect
(+ (* (+ x 1) (+ 1 0)) (* (+ 1 0) (+ x -1)))
but i get
(+ (* (+ x 1) (+ 1 0)) (* (+ x -1) (+ 1 0)))
It is because the case for multiplication says so here:
(list '+ (list '* u (d v)) (list '* v (d u)))
That is, d(u*v) = u * dv + v * du.
The second term is "flipped" compared to what you say want, which is d(u*v) = u * dv + du * v:
(list '+ (list '* u (d v)) (list '* (d u) v))
Related
I am now following sicp Finding root of equations
#+begin_src emacs-lisp :session sicp :lexical t
(defun close-enoughp(x y)
(< (abs (- x y)) 0.001))
(defun search(f neg-point pos-point)
(let ((midpoint (average neg-point pos-point)))
(if (close-enoughp neg-point pos-point)
midpoint
(let ((test-value (funcall f midpoint)))
(cond ((posp test-value)
(search f neg-point midpoint))
((negp test-value)
(search f midpoint pos-point))
(t midpoint))))))
(defun half-interval-method(f a b)
(let ((a-value (funcall f a))
(b-value (funcall f b)))
(cond ((and (negp a-value) (posp b-value))
(search f a b))
((and (negp b-value) (posp a-value))
(search f b a))
(t
(error "Values are not of opposite sign" a b)))))
(defun negp(x)
(< x 0))
(defun posp(x)
(> x 0))
(defun average(a b)
(/ (+ a b) 2))
#+end_src
Test it
#+begin_src emacs-lisp :session sicp :lexical t
(half-interval-method (lambda (x) (- (* x x x) (* 2 x) 3))
0
20.0)
#+end_src
#+RESULTS:
: 1.89300537109375
But when try to find the square root of 3
#+begin_src emacs-lisp :session sicp :lexical t
(half-interval-method (lambda (x) (- (* x x) 3)
1
3.0)
)
#+end_src
It report error:
progn: Wrong number of arguments: ((t) (f a b) (let ((a-value (funcall f a)) (b-value (funcall f b))) (cond ((and (negp a-value) (posp b-value)) (search f a b)) ((and (negp b-value) (posp a-value)) (search f b a)) (t (error "Values are not of opposite sign" a b))))), 1
What' the reason that the function so much fragile?
You invoke the function incorrectly.
Replace
(half-interval-method (lambda (x) (- (* x x) 3)
1
3.0)
)
with
(half-interval-method (lambda (x) (- (* x x) 3))
1
3.0)
PS. Use show-paren-mode to catch such errors.
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 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.
I'm trying to write a code for extended Euclidian Algorithm in Scheme for an RSA implementation.
The thing about my problem is I can't write a recursive algorithm where the output of the inner step must be the input of the consecutive outer step. I want it to give the result of the most-outer step but as it can be seen, it gives the result of the most inner one. I wrote a program for this (it is a bit messy but I couldn't find time to edit.):
(define ax+by=1
(lambda (a b)
(define q (quotient a b))
(define r (remainder a b))
(define make-list (lambda (x y)
(list x y)))
(define solution-helper-x-prime (lambda (a b q r)
(if (= r 1) (- 0 q) (solution-helper-x-prime b r (quotient b r) (remainder b r)))
))
(define solution-helper-y-prime (lambda (a b q r)
(if (= r 1) (- r (* q (- 0 q) )) (solution-helper-y-prime b r (quotient b r) (remainder b r))
))
(define solution-first-step (lambda (a b q r)
(if (= r 1) (make-list r (- 0 q))
(make-list (solution-helper-x-prime b r (quotient b r) (remainder b r)) (solution-helper-y-prime b r (quotient b r) (remainder b r))))
))
(display (solution-first-step a b q r))
))
All kinds of help and advice would be greatly appreciated. (P.S. I added a scrrenshot of the instructions that was given to us but I can't see the image. If there is a problem, please let me know.)
This is a Diophantine equation and is a bit tricky to solve. I came up with an iterative solution adapted from this explanation, but had to split the problem in parts - first, obtain the list of quotients by applying the extended Euclidean algorithm:
(define (quotients a b)
(let loop ([a a] [b b] [lst '()])
(if (<= b 1)
lst
(loop b (remainder a b) (cons (quotient a b) lst)))))
Second, go back and solve the equation:
(define (solve x y lst)
(if (null? lst)
(list x y)
(solve y (+ x (* (car lst) y)) (cdr lst))))
Finally, put it all together and determine the correct signs of the solution:
(define (ax+by=1 a b)
(let* ([ans (solve 0 1 (quotients a b))]
[x (car ans)]
[y (cadr ans)])
(cond ((and (= a 0) (= b 1))
(list 0 1))
((and (= a 1) (= b 0))
(list 1 0))
((= (+ (* a (- x)) (* b y)) 1)
(list (- x) y))
((= (+ (* a x) (* b (- y))) 1)
(list x (- y)))
(else (error "Equation has no solution")))))
For example:
(ax+by=1 1027 712)
=> '(-165 238)
(ax+by=1 91 72)
=> '(19 -24)
(ax+by=1 13 13)
=> Equation has no solution
I am trying to write a representation of pairs that does not use cons, car or cdr but still follows the property of pairs, i.e., (car (cons x y)) should be x and (cdr (cons x y)) should be y.
So here is one solution that I got from the SICP book:
(define (special-cons x y)
(lambda (m) (m x y)))
I was able to write another solution but it can only allow numbers:
(define (special-cons a b)
(* (expt 2 a)
(expt 3 b)))
(define (num-divs n d)
(define (iter x result)
(if (= 0 (remainder x d))
(iter (/ x d) (+ 1 result))
result))
(iter n 0))
(define (special-car x)
(num-divs x 2))
(define (special-cdr x)
(num-divs x 3))
Is there any other solution that allows for pairs for any object x and object y?
What about structs (Racket) or record-types (R6RS)?
In Racket:
#lang racket
(struct cell (x y))
(define (ccons x y) (cell x y))
(define (ccar cl) (cell-x cl))
(define (ccdr cl) (cell-y cl))
(define (cpair? cl) (cell? cl))
(define x (ccons 1 2))
(cpair? x)
=> #t
(ccar (ccons 1 2))
=> 1
(ccdr (ccons 3 4))
=> 4
This is a good way of doing it.
#lang racket
(define (my-cons x y)
(lambda (p)
(if (= p 1) x y)))
(define (my-car pair)
(pair 1))
(define (my-cdr pair)
(pair 2))
Here is the test
> (my-car (my-cons 1 '(2 3 4)))
1
> (my-cdr (my-cons 1 '(2 3 4)))
'(2 3 4)
The classic Ableson and Sussman procedural implementation from Structure and Interpretation of Computer Programs (section 2.1.3):
(define (cons x y)
(define (dispatch m)
(cond ((= m 0) x)
((= m 1) y)
(else (error "Argument not 0 or 1 -- CONS" m))))
dispatch)
(define (car z)
(z 0))
(define (cdr z)
(z 1))
Rptx's solution is roughly equivalent, and this is presented for reference.