Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #lang racket
- ;; Used for TODO
- (define ... null)
- ;; Variable functions
- (define (variable? e)
- (symbol? e))
- (define (same-variable? v1 v2)
- (and (variable? v1)
- (variable? v2)
- (eq? v1 v2)))
- (define (=number? exp num)
- (and (number? exp)
- (= exp num)))
- ;; Definition of addition functions
- (define (sum? e)
- (and (pair? e)
- (eq? (car e) '+)))
- (define (addend e)
- (cadr e))
- (define (augend e)
- (if (null? (cdddr e))
- (caddr e)
- (cons '+ (cddr e))))
- (define (make-sum a1 a2)
- (cond ((=number? a1 0) a2)
- ((=number? a2 0) a1)
- ((and (number? a1) (number? a2))
- (+ a1 a2))
- (else
- (list '+ a1 a2))))
- ;; Definition of multiplication functions
- (define (product? e)
- (and (pair? e)
- (eq? (car e) '*)))
- (define (multiplier e)
- (cadr e))
- (define (multiplicand e)
- (if (null? (cdddr e))
- (caddr e)
- (cons '* (cddr e))))
- (define (make-product m1 m2)
- (cond ((or (=number? m1 0) (=number? m2 0)) 0)
- ((=number? m1 1) m2)
- ((=number? m2 1) m1)
- ((and (number? m1) (number? m2))
- (* m1 m2))
- (else (list '* m1 m2))))
- ;; Defintion of expotentiation functions
- (define (expotentiation? e)
- (and (pair? e)
- (eq? (car e) '**)))
- (define (base e)
- (cadr e))
- (define (exponent e)
- (caddr e))
- (define (make-expotentiation b e)
- (cond ((=number? e 0) 1)
- ((=number? e 1) b)
- ((and (number? b) (number? e))
- (expt b e))
- (else (list '** b e))))
- ;; Definition of Derivation
- (define (deriv exp var)
- (cond ((number? exp) 0)
- ((variable? exp) (if (same-variable? exp var) 1 0))
- ((sum? exp) (make-sum (deriv (addend exp) var)
- (deriv (augend exp) var)))
- ((product? exp)
- (make-sum (make-product (multiplier exp)
- (deriv (multiplicand exp) var))
- (make-product (multiplicand exp)
- (deriv (multiplier exp) var))))
- ((expotentiation? exp)
- (make-product (exponent exp)
- (make-product (make-expotentiation (base exp)
- (make-sum (exponent exp) -1))
- (deriv (base exp) var))))
- (else
- (error "unknown expression type: DERIV" exp))))
- ;; Tests
- (deriv '(+ x 3) 'x) ;; Returns 1
- (deriv '(* x y) 'x) ;; Returns (+ y 0)
- (deriv '(+ x y (+ x 3)) 'x)
- (deriv '(** x (* x x)) 'x)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement