diff options
Diffstat (limited to 'shared')
| -rw-r--r-- | shared/lists.rkt | 1 | ||||
| -rw-r--r-- | shared/symbolic-differentiation.rkt | 85 |
2 files changed, 86 insertions, 0 deletions
diff --git a/shared/lists.rkt b/shared/lists.rkt index f8d96d0..8437fcb 100644 --- a/shared/lists.rkt +++ b/shared/lists.rkt @@ -6,6 +6,7 @@ flatmap enumerate-interval enumerate-windows) + (define (append list1 list2) (if (null? list1) list2 diff --git a/shared/symbolic-differentiation.rkt b/shared/symbolic-differentiation.rkt new file mode 100644 index 0000000..d76a7d1 --- /dev/null +++ b/shared/symbolic-differentiation.rkt @@ -0,0 +1,85 @@ +#lang racket +(provide make-deriv + variable? + same-variable? + =number?) + +(define (variable? x) (symbol? x)) +(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y))) + +(define (=number? x num) + (and (number? x) (= x num))) +(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 (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)))) +(define (make-exponent e p) + (cond ((=number? p 0) 1) + ((=number? p 1) e) + (else (list '** e p)))) + +(define (sum? x) + (and (pair? x) (eq? (car x) '+))) +(define (addend s) (cadr s)) +(define (augend s) + (cond ((null? (cdddr s)) (caddr s)) + (else (cons '+ (cddr s))))) + +(define (product? x) + (and (pair? x) (eq? (car x) '*))) +(define (multiplier p) + (cadr p)) +(define (multiplicand p) + (cond ((null? (cdddr p)) + (caddr p)) + (else (cons '* (cddr p))))) + +(define (exponent? x) + (and (pair? x) (eq? (car x) '**))) +(define (base expo) + (cadr expo)) +(define (exponent expo) + (caddr expo)) + + +(define (make-deriv + make-sum + sum? + addend + augend + make-product + product? + multiplier + multiplicand) + (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)))) + ((exponent? expr) + (make-product + (deriv (base expr) var) + (make-product + (exponent expr) + (make-exponent (base expr) (- (exponent expr) 1))))) + (else + (error "unkown expression type -- DERIV" expr)))) + deriv) |
