Section-2.3.2;Ex-2.56,2.57,2.58

This section is dedicated to create a symbolic differentiation program that demonstrates the concept of data-abstraction. The main derivation algorithm works on the abstract objects such as sum, variable and product with no knowledge of how they are represented, so we can change their representation any time without touching derivation algorithm.
Another thing to notice is the power of the lisp-notation, author first describes the rules of derivation and then translates them into scheme using cond and that translation into scheme just looks straight forward. What I'm saying is that how easy it was to convert math rules into working scheme program.

;code from book  to run the examples
(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (make-sum a1 a2) (list '+ a1 a2))
(define (make-product m1 m2) (list '* m1 m2))
(define (sum? x)
  (and (pair? x) (eq? (car x) '+)))
(define (addend s) (cadr s))
(define (augend s) (caddr s))
(define (product? x)
  (and (pair? x) (eq? (car x) '*)))
(define (multiplier p) (cadr p))
(define (multiplicand p) (caddr p))
(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 (=number? exp num)
  (and (number? exp) (= exp num)))
(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)))) 

;Ex-2.56

(define (make-exponentiation base exponent)
  (cond
   ((= exponent 0) 1)
   ((= exponent 1) base)
   (else
    (list '** base exponent))))
(define (exponentiation? exp)
  (eq? (car exp) '**))
(define (base exp)
  (cadr exp))
(define (exponent exp)
  (caddr exp))

(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))))
        ((exponentiation? exp)
         (make-product
          (exponent exp)
          (make-product
           (make-exponentiation (base exp)
                                (- (exponent exp) 1))
           (deriv (base exp) var))))
        (else
         (error "unknown expression type -- DERIV" exp))))

;Ex-2.57

(define (make-sum a1 a2 . a)
  ;find sum of all the numbers in given args
  (define (number-sum args sum)
    (cond
     ((null? args) sum)
     ((number? (car args))
      (number-sum (cdr args) (+ sum (car args))))
     (else (number-sum (cdr args) sum))))
  ;list only the symbols from given list of args
  (define (symbols-only args)
    (filter (lambda (x) (not (number? x))) args))
  
  (let ((sum (number-sum (cons a1 (cons a2 a)) 0))
        (symbols (symbols-only (cons a1 (cons a2 a)))))
    (cond
     ((and (= 0 sum)
           (= 0 (length symbols))) 0)
     ((and (= 0 sum)
           (= 1 (length symbols))) (car symbols))
     ((and (= 0 sum)
           (apply list (cons '+ symbols))))
     ((= (length symbols) 0) sum)
     (else (apply list (cons '+ (cons sum symbols)))))))

(define (addend exp)
  (cadr exp))
(define (augend exp)
  (if (> (length (cddr exp)) 1)
      (apply make-sum (cddr exp))
      (caddr exp)))
;tests for make-sum
(make-sum 1 2) ;3
(make-sum 1 'a) ;(+ 1 a)
(make-sum 1 -1 'a) ;a
(make-sum 1 -1) ;0
(make-sum 1 -2 'a 'b)  ;(+ -1 a b)
(make-sum 1 'a 'b 'c '3) ;(+ 4 a b c)

(define (make-product a1 a2 . a)
  ;find sum of all the numbers in given args
  (define (number-prod args prod)
    (cond
     ((null? args) prod)
     ((number? (car args))
      (number-prod (cdr args) (* prod (car args))))
     (else (number-prod (cdr args) prod))))
  ;list only the symbols from given list of args
  (define (symbols-only args)
    (filter (lambda (x) (not (number? x))) args))
  
  (let ((prod (number-prod (cons a1 (cons a2 a)) 1))
        (symbols (symbols-only (cons a1 (cons a2 a)))))
    (cond
     ((= prod 0) 0)
     ((and (= 1 prod)
           (= 0 (length symbols))) 1)
     ((and (= 1 prod)
           (= 1 (length symbols))) (car symbols))
     ((and (= 1 prod)
           (apply list (cons '* symbols))))
     ((= 0 (length symbols)) prod)
     (else
      (apply list (cons '* (cons prod symbols)))))))

(define (multiplier exp)
  (cadr exp))
(define (multiplicand exp)
  (if (> (length (cddr exp)) 1)
      (apply make-product (cddr exp))
      (caddr exp)))
;tests for make-product
(make-product 1 2) ;2
(make-product 1 'a) ;a
(make-product 1 -1 'a) ;(* -1 a)
(make-product 1 -1 'a 'b) ;(* -1 a b)
(make-product 1 'a 'b 'c 3) ;(* 3 a b c)
(make-product 1 'a 'b 'c 3 0) 0 

;Ex-2.58
;a

(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 (=number? exp num)
  (and (number? exp) (= exp num)))
(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 (sum? x)
  (and (pair? x)
       (pair? (cdr x))
       (eq? (cadr x) '+)))
(define (addend s) (car s))
(define (augend s) (caddr s))
(define (product? x)
  (and (pair? x)
       (pair? (cdr x))
       (eq? (cadr x) '*)))
(define (multiplier p) (car p))
(define (multiplicand p) (caddr p))

;b - TODO