adrianwong programmer · retired coal miner

SICP section 2.4 - multiple representations for abstract data

Selected exercises

Exercise 2.73

Note: to test our code, we can look ahead to section 3.3.3 - representing tables to borrow the implementations of put and get:

(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!))

Part (a): the procedures number? and variable? are predicates whose behaviours do not change based on operator type. Assimilating them into the data-directed dispatch therefore serves no purpose.

Part (b):

(define (install-derivative-package)
  ; Internal procedures
  (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 (addend a) (car a))
  (define (augend a) (cadr a))
  (define (deriv-sum exp var)
    (make-sum (deriv (addend exp) var)
              (deriv (augend exp) var)))

  (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 (multiplier p) (car p))
  (define (multiplicand p) (cadr p))
  (define (deriv-product exp var)
    (make-sum (make-product
               (multiplier exp)
               (deriv (multiplicand exp) var))
              (make-product
               (deriv (multiplier exp) var)
               (multiplicand exp))))

  ; Interface to the rest of the system
  (put 'deriv '+ deriv-sum)
  (put 'deriv '* deriv-product))

Part (c): add the following to the (install-derivative-package) definition:

; Internal procedures
(define (make-exponentiation x y)
  (cond ((=number? y 0) 1)
        ((=number? y 1) x)
        (else (list '** x y))))
(define (base x) (car x))
(define (exponent x) (cadr x))
(define (deriv-exponentiation exp var)
  (make-product (exponent exp)
                (make-product
                 (make-exponentiation (base exp)
                                      (make-sum (exponent exp) -1))
                 (deriv (base exp) var))))

; Interface to the rest of the system
(put 'deriv '** deriv-exponentiation)

Part (d): all that is required is to swap the order of arguments to put.

Exercise 2.74

Parts (a) and (b): the question puts forward the scenario where a conglomerate company “Insatiable Enterprises, Inc.” has to implement a set of procedures that are applicable to any of its divisions’ files, where each file is likely to have been implemented using varying data structures.

Let’s solve parts (a) and (b) by testing against two very creatively named divisions div1 and div2. Their files are structured (with slight differences) as follows:

((john 1000) (anna 2000))   ; div1
((bob (4000)) (mia (3000))) ; div2

We first provide the make-div-file procedure, which tags a file with its division name. This procedure is analogous to attach-tag from section 2.4.2, sans error-checking only because I’m lazy:

(define (make-div-file div f) (cons div f))
(define (division f) (car f))
(define (file f) (cdr f))

We then provide the generic selectors get-record and get-salary:

(define (apply-generic op f name)
  (let ((proc (get (division f) op)))
    (if proc
        (proc name (file f))
        (error "No method for these types: APPLY-GENERIC"))))

(define (get-record f name) (apply-generic 'get-record f name))
(define (get-salary f name) (apply-generic 'get-salary f name))

…and the packages for both divisions:

(define (install-div1-package)
  (define (record name f)
    (cond ((null? f) '())
          ((equal? (car (car f)) name) (car f))
          (else (record name (cdr f)))))
  (define (salary name f)
    (cond ((null? f) '())
          ((equal? (car (car f)) name) (cadr (car f)))
          (else (salary name (cdr f)))))
  (put 'div1 'get-record record)
  (put 'div1 'get-salary salary))

(define (install-div2-package)
  (define (record name f)
    (cond ((null? f) '())
          ((equal? (car (car f)) name) (car f))
          (else (record name (cdr f)))))
  (define (salary name f)
    (cond ((null? f) '())
          ((equal? (car (car f)) name) (caadr (car f)))
          (else (salary name (cdr f)))))
  (put 'div2 'get-record record)
  (put 'div2 'get-salary salary))

Testing the generic selectors:

(define div1-file (make-div-file 'div1 '((john 1000) (anna 2000))))
(define div2-file (make-div-file 'div2 '((bob (4000)) (mia (3000)))))

(install-div1-package)
(install-div2-package)

(get-record div1-file 'anna) ; '(anna 2000)
(get-record div2-file 'mia)  ; '(mia (3000))

(get-salary div1-file 'anna) ; 2000
(get-salary div2-file 'mia)  ; 3000

Part (c):

(define (find-employee-record f name)
  (if (null? f)
      '()
      (let ((record (get-record (car f) name))
            (next-file (find-employee-record (cdr f) name)))
        (if (null? record)
            next-file
            (cons record next-file)))))

Testing this procedure. Note the inclusion of a duplicate 'anna, which is a plausible scenario when a company has a “large number of independent divisions located all over the world”:

(define div1-file (make-div-file 'div1 '((john 1000) (anna 2000))))
(define div2-file (make-div-file 'div2 '((bob (4000)) (anna (3000)))))

(find-employee-record (list div1-file div2-file) 'bob)
; '((bob (4000)))

(find-employee-record (list div1-file div2-file) 'anna)
; '((anna 2000) (anna (3000)))

Part (d): install a new package, providing the appropriate procedures to retrieve the record and salary of a specified employee.

Exercise 2.75

(define (make-from-mag-ang r a)
  (define (dispatch op)
    (cond ((eq? op 'real-part) (* r (cos a)))
          ((eq? op 'imag-part) (* r (sin a)))
          ((eq? op 'magnitude) r)
          ((eq? op 'angle) a)
          (else (error "Unknown op: MAKE-FROM-MAG-ANG" op))))
  dispatch)

Exercise 2.76

Strategy New types New operations
Generic operations with explicit dispatch Existing operations need to be updated to handle new types No changes to existing code
Data-directed New types (columns) can be added to the table of operations without changing existing code New operations (rows) can be added to the table of operations without changing existing code
Message-passing No changes to existing code Existing types need to be updated to handle new operations