λ2.4節

問題 2.73  問題 2.74  問題 2.75  問題 2.76 

問題 2.73
(define (make-table)
  (let ((local-table (list '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable))))
              (if record
                  (cdr record)
                  false))
            false)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable))))
              (if record
                  (set-cdr! record value)
                  (set-cdr! subtable
                            (cons (cons key-2 value)
                                  (cdr subtable)))))
            (set-cdr! local-table
                      (cons (list key-1
                                  (cons key-2 value))
                            (cdr local-table)))))
      'ok)    
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc!) insert!)
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))

(define operation-table (make-table))

(define get (operation-table 'lookup-proc))

(define put (operation-table 'insert-proc!))

(define (deriv exp var)
   (cond ((number? exp) 0)
         ((variable? exp) (if (same-variable? exp var) 1 0))
         (else (let ((op (get 'deriv (operator exp))))
           (cond (op (op (operands exp) var))
                 (else (error "unkown expression -- DERIV" exp)))))))

(define (operator exp) (car exp))

(define (operands exp) (cdr exp))

(define (deriv-package)
  (define (deriv-sum exp var)
(newline)(display (list 'deriv-sum exp var))
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var)))
  (define (deriv-prod exp var)
(newline)(display (list 'deriv-prod exp var))
         (make-sum
           (make-product (multiplier exp)
                         (deriv (multiplicand exp) var))
           (make-product (deriv (multiplier exp) var)
                         (multiplicand exp))))
  (put 'deriv '+ deriv-sum)
  (put 'deriv '* deriv-prod))

(define (variable? x) (symbol? x))

(define (same-variable? v1 v2) (and (variable? v1) (variable? v2) 
(eq? v1 v2)))

(define (addend s) (car s))  ;operandsが引数なので, dがひとつ少なくなる. 
                                ; cadr → car 
(define (augend s) (cadr s))

(define (multiplier p) (car p))

(define (multiplicand p) (cadr p))

(define (make-sum a1 a2) (list '+ a1 a2))

(define (make-product m1 m2) (list '* m1 m2))

(deriv-package)

(deriv '(* (* x y) (+ x 3)) 'x)

;-> (+ (* (* x y) (+ 1 0)) (* (+ (* x 0) (* 1 y)) (+ x 3)))

;a. numberやvariableにはタグがないので, データ主導にできない. 

問題 2.75
(define (make-from-mag-ang x y)
  (define (dispatch op)
    (cond ((eq? op 'real-part) (* x (cos y)))
          ((eq? op 'imag-part) (* x (sin y)))
          ((eq? op 'magnitude) x)
          ((eq? op 'angle) y)
          (else
           (error "Unknown op -- MAKE-FROM-MAG-ANG" op))))
  dispatch)