SHARE
TWEET

Untitled

a guest Nov 14th, 2019 103 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (define (derivative xs)
  2.   (cond ((equal? xs 'x) 1)
  3.         ((number? xs) 0)
  4.         ((equal? (car xs) 'expt)
  5.          (cond
  6.            ((equal? (cadr xs) 'x )
  7.             (let* ((arg (cadr xs)) (pow (caddr xs)))
  8.                (list '* pow (list 'expt arg (- pow 1)))))
  9.            ((and (number? (cadr xs)) (equal? (caddr xs) 'x))
  10.             (let* ((arg (cadr xs)) (pow (caddr xs)))
  11.                (list '* (list 'expt arg pow) (list 'log arg))))
  12.            ((number? (cadr xs))
  13.             (let* ((arg (cadr xs)) (pow (caddr xs)))
  14.                (list '* (list 'expt arg pow) (list 'log arg) (derivative arg))))
  15.            ((and (not (number? (cadr xs))) (not (equal? (cadr xs) 'exp)))
  16.                (let* ((arg (cadr xs)) (pow (caddr xs)))
  17.                  (list '* pow (list 'expt arg (- pow 1)) (derivative arg))))))
  18.         ((equal? (car xs) 'sin) (list '* (list 'cos (cadr xs)) (derivative (cadr xs))))
  19.         ((equal? (car xs) 'cos) (list '- (list '* (list 'sin (cadr xs)) (derivative (cadr xs)))))
  20.         ((equal? (car xs) '*)
  21.          (cond
  22.            ((and (number? (cadr xs)) (equal? (caddr xs) 'x)) (cadr xs))
  23.            ((and (number? (cadr xs)) (not (> (length xs) 3))) (list '* (cadr xs) (derivative (caddr xs))))
  24.            ((and (number? (cadr xs)) (number? (caddr xs))) 0)
  25.            ((> (length xs) 3)
  26.                 (list '+ (list '* (derivative (cadr xs)) (caddr xs) (cadddr xs)) (list '* (cadr xs) (derivative (caddr xs)) (cadddr xs))
  27.                       (list '* (cadr xs) (caddr xs) (derivative (cadddr xs)))))
  28.            (else
  29.            (list '+ (list '* (derivative (cadr xs)) (caddr xs)) (list '* (cadr xs) (derivative (caddr xs)))))))
  30.         ((equal? (car xs) '+) (list '+ (derivative (cadr xs)) (derivative (caddr xs))))
  31.         ((equal? (car xs) '-)
  32.          (if (not (equal? (length xs) 3))
  33.              -1
  34.              (list '- (derivative (cadr xs)) (derivative (caddr xs)))))
  35.         ((equal? (car xs) '/)
  36.          (cond
  37.            ((and (number? (cadr xs)) (equal? (caddr xs) 'x)) (list '* '-1 (list '/ (cadr xs) (list 'expt (caddr xs) '2))))
  38.            ((number? (cadr xs)) (list '* '-1 (list '/ (cadr xs) (list 'expt (caddr xs) '2)) (derivative (caddr xs))))
  39.            ((and (number? (cadr xs)) (number? (caddr xs))) 0 )
  40.            (else
  41.             (list '/ (list '- (list '* (derivative (cadr xs)) (caddr xs)) (list '* (cadr xs) (derivative (caddr xs)))) (list 'expt (caddr xs) 2)))))
  42.         ((and (equal? (cadr xs) 'x) (equal? (car xs) 'exp)) (list 'exp 'x))
  43.         ((and (equal? (car xs) 'exp) (not (number? (cadr xs)))) (list '* (list 'exp (cadr xs)) (derivative (cadr xs))))
  44.         ((and (equal? (car xs) 'exp) (number? (cadr xs))) 0)
  45.         ((and (equal? (car xs) 'log) (equal? (cadr xs) 'x)) (list '/ 1 (cadr xs)))
  46.         ((and (equal? (car xs) 'log) (number? (cadr xs))) 0)
  47.         ((and (equal? (car xs) 'log) (not (number? (cadr xs)))) (list '* (list '/ 1 (cadr xs)) (derivative (cadr xs))))))
  48.  
  49. (begin (define x 2.0) (round (eval (derivative (quote (* 2 (* (exp x) (sin x) (cos x))))) (interaction-environment))))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top