learning-sicp

My embarrassing half assed SICP run.
git clone https://kaka.farm/~git/learning-sicp
Log | Files | Refs

exercise-56.scm (3276B)

      1 (define-library (sicp solutions chapter-2 exercise-56)
      2   (import (scheme base)
      3           (scheme cxr))
      4   (export
      5    =number?
      6    base
      7    deriv
      8    exponands
      9    exponent
     10    exponentiation?
     11    make-exponentiation
     12    make-product
     13    make-sum
     14    multiplicand
     15    multiplier
     16    product?
     17    same-variable?
     18    sum?
     19    variable?
     20    augend
     21    addend
     22    )
     23 
     24   (begin
     25 
     26     ;; Exercise 2.56
     27 
     28     ;; Original:
     29     ;; (define (make-sum a1 a2)
     30     ;;   (list '+ a1 a2))
     31 
     32 
     33     (define (=number? exp num)
     34       (and (number? exp)
     35            (= exp num)))
     36 
     37     ;; Simplificating make-sum:
     38 
     39     (define (make-sum a1 a2)
     40       (cond
     41        ((=number? a1 0) a2)
     42        ((=number? a2 0) a1)
     43        ((and (number? a1)
     44              (number? a2))
     45         (+ a1 a2))
     46        ((and (symbol? a1)
     47              (symbol? a2)
     48              (eq? a1 a2))
     49         (list '+ 2 a1))
     50        (else (list '+ a1 a2))))
     51 
     52     (define (sum? x)
     53       (and (pair? x)
     54            (eq? (car x)
     55                 '+)))
     56 
     57     (define (addend s)
     58       (cadr s))
     59 
     60     (define (augend s)
     61       (caddr s))
     62 
     63     ;; Original:
     64     ;; (define (make-product m1 m2)
     65     ;;   (list '* m1 m2))
     66 
     67     ;; Simplificating make-product:
     68 
     69     (define (make-product m1 m2)
     70       (cond
     71        ((or (=number? m1 0)
     72             (=number? m2 0))
     73         0)
     74        ((=number? m1 1) m2)
     75        ((=number? m2 1) m1)
     76        ((and (number? m1)
     77              (number? m2))
     78         (* m1 m2))
     79        ((and (symbol? m1)
     80              (symbol? m2)
     81              (eq? m1 m2))
     82         (make-exponentiation m1 2))
     83        (else (list '* m1 m2))))
     84 
     85     (define (product? x)
     86       (and (pair? x)
     87            (eq? (car x)
     88                 '*)))
     89 
     90     (define (multiplier p)
     91       (cadr p))
     92 
     93     (define (multiplicand p)
     94       (caddr p))
     95 
     96     (define (make-exponentiation b e)
     97       (cond
     98        ((=number? e 0) 1)
     99        ((=number? e 1) b)
    100        ((=number? b 1) 1)
    101        (else (list '** b e))))
    102 
    103     ;; Exercise 2.56
    104 
    105     (define (exponentiation? e)
    106       (and (pair? e)
    107            (eq? (car e)
    108                 '**)))
    109 
    110     (define (base e)
    111       (cadr e))
    112 
    113     (define (exponent e)
    114       (caddr e))
    115 
    116     (define (variable? x)
    117       (symbol? x))
    118 
    119     (define (same-variable? v1 v2)
    120       (and (variable? v1)
    121            (variable? v2)
    122            (eq? v1 v2)))
    123 
    124     (define (deriv exp var)
    125       (cond
    126        ((number? exp) 0)
    127        ((variable? exp)
    128         (if (same-variable? exp
    129                             var)
    130             1
    131             0))
    132        ((sum? exp)
    133         (make-sum (deriv (addend exp)
    134                          var)
    135                   (deriv (augend exp)
    136                          var)))
    137        ((product? exp)
    138         (make-sum
    139          (make-product (multiplier exp)
    140                        (deriv (multiplicand exp)
    141                               var))
    142          (make-product (deriv (multiplier exp)
    143                               var)
    144                        (multiplicand exp))))
    145        ;; Exercise 2.56
    146        ((exponentiation? exp)
    147         ;; d(x**n)/dx = n*x**(n-1)
    148         (make-product (exponent exp)
    149                       (make-exponentiation (base exp)
    150                                            (make-sum (exponent exp)
    151                                                      -1))))
    152        (else (error "Unknown expression
    153                  type: DERIV" exp))))))