符号求导，scheme实现

sicp练习2.57

(define variable? symbol?)
(define (same-variable? a b)
  (and (variable? a)
       (variable? b)
       (eq? a b)))

(define (sum-exp? exp)
  (and (pair? exp)
       (eq? (car exp) '+)))

(define (product-exp? exp)
  (and (pair? exp)
       (eq? (car exp) '*)))

(define (expon-exp? exp)
  (and (pair? exp)
       (eq? (car exp )'**)))

(define (** x n)
  (exp (* n (log x))))

(define (make-sum lst)
  (let ((num (foldl + 0 (filter number? lst)))
        (sym (filter (lambda (x) (not (number? x))) lst)))
    (if (= 0 num)
        (cond ((= (length sym) 0) 0)
              ((= (length sym) 1) (car sym))
              (else (cons '+ sym)))
        (if (= (length sym) 0)
            num
            (cons '+ (cons num sym))))))

;(make-sum '(0 0))
;(make-sum '(2 -2 3 -3 a b))
;(make-sum '(2 3))
;(make-sum '(2 -2 3 a 4 b))
;(make-sum '((+ a b) (+ b d)))
;(make-sum '((* a 0) (* 1 (+ 0 b x))))
;(make-sum '( (* a b) ) )
;(make-sum '(a b) )

(define (make-product lst)
  (let ((num (foldl * 1 (filter number? lst)))
        (sym (filter (lambda (x) (not (number? x))) lst)))
    (cond ((= num 0) 0)
          ((= num 1) (if (= (length sym) 1)
                         (car sym)
                         (cons '* sym)))
          (else (cons '* (cons num sym)))
          )))

;(make-product '(0 1 2))
;(make-product '(0 a b 1 c))
;(make-product '(0.5 2 a))
;(make-product '(0.5 2 a c (+ a c)))
;(make-product '(a b 1 3 -1 (* f va)))

(define (make-expon x n)
  (cond ((eq? n 0) 1)
        ((eq? x 0) 0)
        (else  (list '** x n))
        ))

;(make-expon 0 'a)
;(make-expon 0 0)
;(make-expon 'a 0)
;(make-expon 'a 'b)
;(make-expon 2 3)

(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var)
             1
             0))

        ((sum-exp? exp)
         (make-sum  
          (map 
           (lambda (x) (deriv x var))
           (cdr exp))))

        ((product-exp? exp)
         (let ((first (cadr exp))
               (second (make-product (cddr exp))))
           (make-sum (list 
                      (make-product (list first (deriv second var)))
                      (make-product (list (deriv first var)  second ))))
           ))

        ((expon-exp? exp)
         (let ((base (cadr exp))
               (n (caddr exp)))
           (make-product (list n 
                               (make-expon base (make-sum (list n -1))) 
                               (deriv base var) ))
           ))
        ))

(deriv '(+ a (+ a a) b a) 'a) ;4
(deriv 'a 'b) ;0
(deriv '(* a b x) 'a) ;(* b x)
(deriv '(* (+ (* a b) (* a c)) d) 'a) ;(* (+ b c) d)
(deriv '(* (+ a b c) (* a b b)) 'a) ;(+ (* (+ a b c) (* b b)) (* a b b))
(deriv '(** x n) 'x) ;(* n (** x (+ -1 n)))
(deriv '(** (* 3 a ) n) 'a) ;(* n (** (* 3 a) (+ -1 n)) (* 3))