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))))))
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.
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))
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 function for insertion sort with and without primitive functions.
My code with primitive functions is below.
(define (insert n d)
(cond ((null? n) d)
((null? d) n)
(else (< (car n) (car d)) (cons (car n) (insert (cdr n) d)) (cons (car d) (insert (cdr d) n)))))
(define (sort n)
(cond ((null? n) '())
(else (insert (list (car n)) (sort (cdr n))))))
How should I revise insert and sort to not use car, cdr, and cons?
Edit: I tried to write the insert function. This is what I have so far.
(define (insert n d)
(let ((rest-digit (truncate (/ n 10))))
(if (null? n) 0
(+ rest-digit (insert (- n 1) d)))))
(insert '(3 2 1) '5)
Edit #2: I think I can use the built-in function expt.
Ultimately you will be using primitive functions. To illustrate let me show you a trick that actually uses cons, car, and cdr under the hood:
(define (my-car lst)
(apply (lambda (a . d) a) lst))
(define (my-cdr lst)
(apply (lambda (a . d) d) lst))
(define (my-cons a d)
(apply (lambda l l) a d))
(define test (my-cons 1 '(2 3)))
test ; ==> (1 2 3)
(my-car test) ; ==> 1
(my-cdr test) ; ==> (2 3)
This abuses the fact that apply takes a list as the final arguments and that rest arguments are cons-ed onto a list in order. cons doesn't work for all pairs:
(my-cons 1 2) ; ERROR: expected list?, got 1
You can make cons, car, and cdr such that they adher to the same rules as primitive cons, but that they are not made of pairs at all. Barmar suggested closures:
(define (ccons a d)
(lambda (f) (f a d))
(define (ccar cc)
(cc (lambda (a d) a)))
(define (ccdr cc)
(cc (lambda (a d) d)))
(define test2 (ccons 1 2))
test2 ; ==> #<function...>
(ccar test2) ; ==> 1
(ccdr test2) ; ==> 2
This works since a and d gets closed over in the returned function and that function passes those values and thus the function acts as an object with two attributes. The challenge with this is that you cannot just pass a list since only "lists" made with ccons will work with ccar and ccdr.
A less classical way is to use vectors:
(define vtag (make-vector 0))
(define (vcons a d)
(let ((v (make-vector 3)))
(vector-set! v 0 vtag)
(vector-set! v 1 a)
(vector-set! v 2 d)
v))
(define (vcar vl)
(vector-ref vl 1))
(define (vcdr vl)
(vector-ref vl 2))
(define (vpair? vl)
(eq? vtag (vector-ref vl 0)))
Or you can use records:
(define-record-type :rpair
(rcons a d)
rpair?
(a rcar)
(d rcdr))
(define test (rcons 1 2))
(rpair? test) ; ==> #t
(rcar test) ; ==> 1
(rcdr test) ; ==> 2
Now I think records just syntax sugar and abstractions and that under the hood you are doing exactly the same as the vector version with less code, but that isn't a bad thing.
EDIT
So from the comments if the only restriction is to avoid car, cdr, and cons, but no restrictions on their sisters we might as well implement with them:
(define (sort lst)
(define (insert e lst)
(if (null? lst)
(list e)
(let ((a (first lst)))
(if (>= a e)
(list* e lst)
(list* a (insert e (rest lst)))))))
(foldl insert
'()
lst))
(sort '(1 5 3 8 5 0 2))
; ==> (0 1 2 3 5 5 8)
And of course my first suggestion works in its place:
(define (sort lst)
(define (my-car lst)
(apply (lambda (a . d) a) lst))
(define (my-cdr lst)
(apply (lambda (a . d) d) lst))
(define (my-cons a d)
(apply (lambda l l) a d))
(define (insert e lst)
(if (null? lst)
(my-cons e '())
(let ((a (my-car lst)))
(if (>= a e)
(my-cons e lst)
(my-cons a (insert e (my-cdr lst)))))))
(foldl insert
'()
lst))
And of course, using substitution rules you can make it utterly ridiculous:
(define (sort lst)
;; insert element e into lst in order
(define (insert e lst)
(if (null? lst)
((lambda l l) e)
(let ((a (apply (lambda (a . d) a) lst)))
(if (>= a e)
(apply (lambda l l) e lst)
(apply (lambda l l)
a
(insert e (apply (lambda (a . d) d) lst)))))))
;; main loop of sort
;; insert every element into acc
(let loop ((lst lst) (acc '()))
(if (null? lst)
acc
(loop (apply (lambda (a . d) d) lst)
(insert (apply (lambda (a . d) a) lst)
acc)))))
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