#lang racket
(define (deriv expr var)
(cond [(number? expr) 0]
[(variable? expr)
(if (same-variable? expr var) 1 0)]
[(sum? expr)
(make-sum (deriv (addend expr) var)
(deriv (augend expr) var))]
[(product? expr)
(make-sum (make-product (multiplier expr)
(deriv (multiplicand expr) var))
(make-product (deriv (multiplier expr) var)
(multiplicand expr)))]
[(exponentiation? expr)
(make-product (exponent expr)
(make-product (make-exponentiation (base expr)
(sub1 (exponent expr)))
(deriv (base expr) var)))]
[else (error "unknown expression type -- DERIV" expr)]))
(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (=number? expr num)
(and (number? expr) (= expr num)))
;; This file contains four different representations for sums and products. The
;; original one below, another in 2.57, and two more in 2.58. Only one can be
;; commented out at a time in order for the file to load and for deriv to work.
;; (define (sum? x) (and (list? x) (eq? (first x) '+)))
;; (define (addend s) (second s))
;; (define (augend s) (third s))
;; (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)]))
;; (define (product? x) (and (list? x) (eq? (first x) '*)))
;; (define (multiplier p) (second p))
;; (define (multiplicand p) (third p))
;; (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)]))
;;;;;;;;;;
;; 2.56 ;;
;;;;;;;;;;
;; Define a constructor and selectors for exponentiation and add an exponentiation
;; rule to the deriv procedure above.
(define (exponentiation? x) (and (list? x) (eq? (first x) '**)))
(define (base e) (second e))
(define (exponent e) (third e))
(define (make-exponentiation b p)
(cond [(=number? p 0) 1]
[(=number? p 1) b]
[else (list '** b p)]))
(deriv (make-exponentiation (list '* 'x 'y) 2) 'x)
;; '(* 2 (* (* x y) y))
;;;;;;;;;;
;; 2.57 ;;
;;;;;;;;;;
;; Define new constructors and selectors for sums and products that can take more
;; than one term.
(define (sum? x) (and (list? x) (eq? (first x) '+)))
(define (addend s) (second s))
(define (augend s)
(define rst (rest (rest s)))
(if (= (length rst) 1)
(first rst)
(apply make-sum rst)))
(define (make-sum a1 a2 . more)
(define summands (append (list a1 a2) more))
(define numbers (filter number? summands))
(define not-numbers (filter-not number? summands))
(define sum-numbers (apply + numbers))
(cond [(empty? not-numbers) sum-numbers]
[(= (length not-numbers) 1)
(define not-number (first not-numbers))
(if (zero? sum-numbers)
not-number
(list '+ sum-numbers not-number))]
[else
(if (zero? sum-numbers)
(cons '+ not-numbers)
(append (list '+ sum-numbers) not-numbers))]))
(define (product? x) (and (list? x) (eq? (first x) '*)))
(define (multiplier p) (second p))
(define (multiplicand p)
(define rst (rest (rest p)))
(if (= (length rst) 1)
(first rst)
(apply make-product rst)))
(define (make-product m1 m2 . more)
(define factors (append (list m1 m2) more))
(define numbers (filter number? factors))
(define not-numbers (filter-not number? factors))
(define product-numbers (apply * numbers))
(cond [(empty? not-numbers) product-numbers]
[(zero? product-numbers) 0]
[(= (length not-numbers) 1)
(define not-number (first not-numbers))
(if (= product-numbers 1)
not-number
(list '* product-numbers not-number))]
[else
(if (= product-numbers 1)
(cons '* not-numbers)
(append (list '* product-numbers) not-numbers))]))
(deriv '(* x y (+ x 3)) 'x)
;; '(+ (* x y) (* y (+ x 3)))
(deriv '(+ x y (** z 2)) 'z)
;; '(* 2 z)
(deriv '(** (+ x y 3) 2) 'y)
;; '(* 2 (+ x y 3))
(deriv '(* (+ x y 3) 2) 'y)
;; 2
;;;;;;;;;;
;; 2.58 ;;
;;;;;;;;;;
;; a. Define new constructors and selectors for sums and products that use infix
;; notation, take exactly two terms, and are fully parenthesized.
;; (define (sum? x)
;; (and (list? x)
;; (= (length x) 3)
;; (eq? (second x) '+)))
;; (define (addend s) (first s))
;; (define (augend s) (third s))
;; (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)]))
;; (define (product? x)
;; (and (list? x)
;; (= (length x) 3)
;; (eq? (second x) '*)))
;; (define (multiplier p) (first p))
;; (define (multiplicand p) (third p))
;; (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)]))
;; (deriv '(x + (3 * (x + (y + 2)))) 'y)
;; ;; 3
;; (deriv '(x * (y + (2 * z))) 'x)
;; ;; '(y + (2 * z))
;; (deriv '(x * (y + (2 * z))) 'y)
;; ;; 'x
;; (deriv '(x * (y + (2 * z))) 'z)
;; ;; '(x * 2)
;; b. Define new constructors and selectors for sums and products that use infix
;; notation, can take more than two terms, and may not be fully parenthesized.
;; (define (not-plus? x)
;; (not (equal? x '+)))
;; (define (sum? x)
;; (and (list? x) (member '+ x) (not-plus? (last x))))
;; (define (addend s)
;; (define a1 (takef s not-plus?))
;; (if (= (length a1) 1) (first a1) a1))
;; (define (augend s)
;; (define a2 (rest (dropf s not-plus?)))
;; (if (= (length a2) 1) (first a2) a2))
;; (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)]))
;; (define (not-times? x)
;; (not (equal? x '*)))
;; (define (product? x)
;; (and (list? x)
;; (not (member '+ x)) ; multiplication binds tighter than addition
;; (member '* x)
;; (not-times? (last x))))
;; (define (multiplier p)
;; (define m1 (takef p not-times?))
;; (if (= (length m1) 1) (first m1) m1))
;; (define (multiplicand p)
;; (define m2 (rest (dropf p not-times?)))
;; (if (= (length m2) 1) (first m2) m2))
;; (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)]))
;; (deriv '(x + 3 * (x + y + 2)) 'x)
;; ;; 4
;; (deriv '(x + 3 * (x + y + 2)) 'y)
;; ;; 3
;; (deriv '(x * (y + 2 * z)) 'x)
;; ;; '(y + 2 * z)
;; (deriv '(x * (y + 2 * z)) 'y)
;; ;; 'x
;; (deriv '(x * (y + 2 * z)) 'z)
;; ;; '(x * 2)
Comments