scheme 符号求导部分 练习2.57-2.58

练习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))))