练习2.57 扩充求导程序，使其能处理任意项的和与乘积
点击查看代码
;原求导程序
(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))))(else (error "unknown expression type" exp))))
;对sum的修改
(define (make-sum-list lst)(define (make-sum-impl a1 a2)(cond ((=number? a1 0) a2)((=number? a2 0) a1)((and (number? a1) (number? a2) (+ a1 a2)))(else (list '+ a1 a2))))(if (= (length lst) 2)(make-sum-impl (car lst) (cadr lst))(make-sum-impl (car lst) (make-sum-list (cdr lst)))))
(define (make-sum a1 a2)(make-sum-list (list a1 a2)))
(define (sum? x)(and (pair? x) (eq? (car x) '+)))
(define (addend s) (cadr s))
(define (augend s)(let ((lst (cddr s)))(if (= (length lst) 1)(car lst)(make-sum-list lst))))
;对乘法的修改
(define (make-product-list lst)(define (make-product-impl 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))))(if (= (length lst) 2)(make-product-impl (car lst) (cadr lst))(make-product-impl (car lst) (make-product-list (cdr lst)))))
(define (make-product a1 a2)(make-product-list (list a1 a2)))
(define (product? x)(and (pair? x) (eq? (car x) '*)))
(define (multiplier s) (cadr s))
(define (multiplicand s)(let ((lst (cddr s)))(if (= (length lst) 1)(car lst)(make-product-list lst))))
练习2.58 将前缀表达式修改为中缀表达式
点击查看代码
(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 (deriv (multiplier exp) var)(multiplicand exp))))(else(error "unknown expression type -- DERIV" exp))))
(define nil '())
(define (variable? s) (symbol? s))
(define (=number? exp num) (and (number? exp)(= exp num)))
(define (same-variable? v1 v2) (and (variable? v1)(variable? v2)(eq? v1 v2)))
;加法部分
(define (sum? x) (and (pair? x) (eq? (find-symbol x) '+)))
(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 (find-symbol x)(cond ((memq '+ x) '+)((memq '* x) '*)(else 'unknown )))
(define (take-until symbol x)(cond ((null? x) nil)((equal? (car x) symbol) nil)(else (cons (car x) (take-until symbol (cdr x))))))
(define (simplify lst)(if (and (pair? lst)(= (length lst) 1))(car lst)lst))
(define (addend x)(simplify (take-until '+ x)))
(define (augend x)(simplify (cdr (memq '+ x))))
;乘法部分
(define (product? x)(and (pair? x)(eq? (find-symbol x) '*)))
(define (make-product a1 a2)(cond ((=number? a1 1) a2)((=number? a2 1) a1)((and (number? a1)(number? a2)) * a1 a2)(else (list a1 '* a2))))
(define (multiplier x)(simplify (take-until '* x)))
(define (multiplicand x)(simplify (cdr (memq '* x))))