# 2.4 Multiple Representations for Abstract Data⁠

# 2.4.1 Representations for Complex Numbers⁠

(define (add-complex z1 z2)
  (make-from-real-imag
   (+ (real-part z1) (real-part z2))
   (+ (imag-part z1) (imag-part z2))))
(define (sub-complex z1 z2)
  (make-from-real-imag
   (- (real-part z1) (real-part z2))
   (- (imag-part z1) (imag-part z2))))
(define (mul-complex z1 z2)
  (make-from-mag-ang
   (* (magnitude z1) (magnitude z2))
   (+ (angle z1) (angle z2))))
(define (div-complex z1 z2)
  (make-from-mag-ang
   (/ (magnitude z1) (magnitude z2))
   (- (angle z1) (angle z2))))

Ben’s representation (rectangular form):

(define real-part car)
(define imag-part cdr)
(define (magnitude z)
  (sqrt (+ (square (real-part z))
           (square (imag-part z)))))
(define (angle z)
  (atan (imag-part z) (real-part z)))
(define make-from-real-imag cons)
(define (make-from-mag-ang r a)
  (cons (* r (cos a)) (* r (sin a))))

Rectangular form can give exact answers for addition and subtraction.

(define z1 (add-complex (make-from-real-imag 1 2) (make-from-real-imag 3 4)))
(define z2 (mul-complex (make-from-mag-ang 5 1) (make-from-mag-ang 6 2)))
(real-part z1) => 4
(imag-part z1) => 6
(magnitude z2) ~> 30
(angle z2) ~> 3

Alyssa’s representation (polar form):

(define (real-part z) (* (magnitude z) (cos (angle z))))
(define (imag-part z) (* (magnitude z) (sin (angle z))))
(define magnitude car)
(define angle cdr)
(define (make-from-real-imag x y)
  (cons (sqrt (+ (square x) (square y)))
        (atan y x)))
(define make-from-mag-ang cons)

Polar form can give exact answers for multiplication and division.

(define z1 (add-complex (make-from-real-imag 1 2) (make-from-real-imag 3 4)))
(define z2 (mul-complex (make-from-mag-ang 5 1) (make-from-mag-ang 6 2)))
(real-part z1) ~> 4
(imag-part z1) ~> 6
(magnitude z2) => 30
(angle z2) => 3

# 2.4.2 Tagged Data⁠

(define (attach-tag type-tag contents)
  (cons type-tag contents))
(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error 'type-tag "bad tagged datum" datum)))
(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      (error 'contents "bad tagged datum" datum)))
(define (rectangular? z) (eq? (type-tag z) 'rectangular))
(define (polar? z) (eq? (type-tag z) 'polar))

Ben’s representation (rectangular form):

(define real-part-rectangular car)
(define imag-part-rectangular cdr)
(define (magnitude-rectangular z)
  (sqrt (+ (square (real-part-rectangular z))
           (square (imag-part-rectangular z)))))
(define (angle-rectangular z)
  (atan (imag-part-rectangular z)
        (real-part-rectangular z)))
(define (make-from-real-imag-rectangular x y)
  (attach-tag 'rectangular (cons x y)))
(define (make-from-mag-ang-rectangular r a)
  (attach-tag 'rectangular
              (cons (* r (cos a))
                    (* r (sin a)))))

Alyssa’s representation (polar form):

(define (real-part-polar z)
  (* (magnitude-polar z) (cos (angle-polar z))))
(define (imag-part-polar z)
  (* (magnitude-polar z) (sin (angle-polar z))))
(define magnitude-polar car)
(define angle-polar cdr)
(define (make-from-real-imag-polar x y)
  (attach-tag 'polar
              (cons (sqrt (+ (square x) (square y)))
                    (atan y x))))
(define (make-from-mag-ang-polar r a)
  (attach-tag 'polar (cons r a)))

Generic selectors:

(define (real-part z)
  (cond ((rectangular? z)
         (real-part-rectangular (contents z)))
        ((polar? z)
         (real-part-polar (contents z)))
        (else (error 'real-part "unknown type" z))))
(define (imag-part z)
  (cond ((rectangular? z)
         (imag-part-rectangular (contents z)))
        ((polar? z)
         (imag-part-polar (contents z)))
        (else (error 'imag-part "unknown type" z))))
(define (magnitude z)
  (cond ((rectangular? z)
         (magnitude-rectangular (contents z)))
        ((polar? z)
         (magnitude-polar (contents z)))
        (else (error 'magnitude "unknown type" z))))
(define (angle z)
  (cond ((rectangular? z)
         (angle-rectangular (contents z)))
        ((polar? z)
         (angle-polar (contents z)))
        (else (error 'angle "unknown type" z))))

Generic constructors:

(define make-from-real-imag make-from-real-imag-rectangular)
(define make-from-mag-ang make-from-mag-ang-polar)

Generic operations:

(paste (:2.4.1 add-complex div-complex mul-complex sub-complex))

Now we can get exact answers for all operations:

(define z1 (add-complex (make-from-real-imag 1 2) (make-from-real-imag 3 4)))
(define z2 (mul-complex (make-from-mag-ang 5 1) (make-from-mag-ang 6 2)))
z1 => (make-from-real-imag 4 6)
z2 => (make-from-mag-ang 30 3)

# 2.4.3 Data-Directed Programming and Additivity⁠

The textbook calls these procedures install-rectangular-package and install-polar-package. I shorten them to rectangular-pkg and polar-pkg since there are many of these procedures and the long names tend to bloat import lists.

(define (rectangular-pkg)
  ;; Internal procedures
  (define real-part car)
  (define imag-part cdr)
  (define make-from-real-imag cons)
  (define (magnitude z)
    (sqrt (+ (square (real-part z))
             (square (imag-part z)))))
  (define (angle z)
    (atan (imag-part z) (real-part z)))
  (define (make-from-mag-ang r a)
    (cons (* r (cos a)) (* r (sin a))))

  ;; Interface to the rest of the system
  (define (tag x) (attach-tag 'rectangular x))
  (put 'real-part '(rectangular) real-part)
  (put 'imag-part '(rectangular) imag-part)
  (put 'magnitude '(rectangular) magnitude)
  (put 'angle '(rectangular) angle)
  (put 'make-from-real-imag 'rectangular
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'rectangular
       (lambda (r a) (tag (make-from-mag-ang r a)))))

(define (polar-pkg)
  ;; Internal procedures
  (define magnitude car)
  (define angle cdr)
  (define make-from-mag-ang cons)
  (define (real-part z)
    (* (magnitude z) (cos (angle z))))
  (define (imag-part z)
    (* (magnitude z) (sin (angle z))))
  (define (make-from-real-imag x y)
    (cons (sqrt (+ (square x) (square y)))
          (atan y x)))

  ;; Interface to the rest of the system
  (define (tag x) (attach-tag 'polar x))
  (put 'real-part '(polar) real-part)
  (put 'imag-part '(polar) imag-part)
  (put 'magnitude '(polar) magnitude)
  (put 'angle '(polar) angle)
  (put 'make-from-real-imag 'polar
       (lambda (x y) (tag (make-from-real-imag x y))))
  (put 'make-from-mag-ang 'polar
       (lambda (r a) (tag (make-from-mag-ang r a)))))

Helpers to apply generic operations:

(define (apply-generic op . args)
  (let* ((type-tags (map type-tag args))
         (proc (get op type-tags)))
    (if proc
        (apply proc (map contents args))
        (error 'apply-generic "no method for argument types" op type-tags))))

(define (apply-specific op type . args)
  (let ((proc (get op type)))
    (if proc
        (apply proc args)
        (error op "no method for type" op type))))

Generic selectors:

(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))

Generic constructors:

(define (make-from-real-imag x y)
  (apply-specific 'make-from-real-imag 'rectangular x y))
(define (make-from-mag-ang r a)
  (apply-specific 'make-from-mag-ang 'polar r a))

Generic operations:

(paste (:2.4.1 add-complex div-complex mul-complex sub-complex))

Helper procedure to run installers with a clean slate:

(define (using . installers)
  (reset)
  (for-each (lambda (f) (f)) installers))

Putting it all together:

(using rectangular-pkg polar-pkg)

(define z1 (add-complex (make-from-real-imag 1 2) (make-from-real-imag 3 4)))
(define z2 (mul-complex (make-from-mag-ang 5 1) (make-from-mag-ang 6 2)))
z1 => (make-from-real-imag 4 6)
z2 => (make-from-mag-ang 30 3)

# Exercise 2.73⁠

(define (deriv expr var)
  (cond ((number? expr) 0)
        ((variable? expr) (if (same-variable? expr var) 1 0))
        (else (apply-specific 'deriv (operator expr) (operands expr) var))))
(define operator car)
(define operands cdr)

1. We rewrote deriv to dispatch based on the operator of the expression. However, it still uses explicit case analysis for numbers and variables. We can’t assimilate those into the data-directed dispatch because they have nothing that can be used as a type tag. Scheme only provides predicates like number?, not a procedure like (type expr) that could return 'number. We can write our own, but this just moves the case anaylsis somewhere else:

   (define (type expr)
     (cond ((number? expr) 'number)
           ((variable? expr) 'variable)
           (else (operator expr))))

2. Packages for sum and product differentiation:

   (define (sum-pkg)
     (define (deriv-sum terms var)
       (accumulate make-sum 0 (map (lambda (t) (deriv t var)) terms)))
     (put 'deriv '+ deriv-sum))
   
   (define (product-pkg)
     (define multiplier car)
     (define (multiplicand product)
       (accumulate make-product 1 (cdr product)))
     (define (deriv-product product var)
       (make-sum (make-product (multiplier product)
                               (deriv (multiplicand product) var))
                 (make-product (deriv (multiplier product) var)
                               (multiplicand product))))
     (put 'deriv '* deriv-product))

   Note that we can’t reuse the selectors multiplier and multiplicand from Exercise 2.57 because they assume the list includes the operator.

3. Package for power differentiation:

   (define (power-pkg)
     (define base car)
     (define exponent cadr)
     (define (deriv-power power var)
       (make-product
        (make-product (exponent power)
                      (make-exponentiation
                       (base power)
                       (make-sum (exponent power) -1)))
        (deriv (base power) var)))
     (put 'deriv '** deriv-power))

   Note that we can’t reuse the selectors base and exponent from Exercise 2.56 because they assume the list includes the operator.

4. If we wanted to index the procedures in the opposite way, we would simply need to swap the first two arguments to put in all the package installation procedures.

Let’s test the new system:

(using sum-pkg product-pkg power-pkg)

(deriv '(+ x 3) 'x) => 1
(deriv '(* x y) 'x) => 'y
(deriv '(* (* x y) (+ x 3)) 'x) => '(+ (* x y) (* y (+ x 3)))
(deriv '(* 3 (** x 5)) 'x) => '(* 3 (* 5 (** x 4)))

# Exercise 2.74⁠

1. Each division should tag their file with a symbol such as 'marketing, and install an implementation of get-record that deals with their internal record structure.

   (define (get-record file employee-name)
     (let* ((tag (type-tag file))
            (record
             (apply-specific 'get-record tag (contents file) employee-name)))
       (and record (attach-tag tag record))))

2. Since our generic get-record reattaches the division tag to the returned record, there is no need for divisions to tag records or do anything special. They just need to install an implementation of get-salary.

   (define (get-salary record)
     (apply-specific 'get-salary (type-tag record) (contents record)))

3. Procedure to find an employee’s record across all files:

   (define (find-employee-record employee-name files)
     (if (null? files)
         #f
         (or (get-record (car files) employee-name)
             (find-employee-record employee-name (cdr files)))))

4. When they take over a new company, they must tag its file and install implementations of get-record and get-salary for it.

Here is an example of a company with two divisions:

(define files
  (list (attach-tag 'marketing
                    '("Alice" "Bob"))
        (attach-tag 'sales
                    '(("Joe" 40) ("Jane" 60)))))

(define (company-pkg)
  (define (get-record-marketing records name)
    (cond ((null? records) #f)
          ((equal? (car records) name) name)
          (else (get-record-marketing (cdr records) name))))
  (define (get-salary-marketing record) 50)
  (define (get-record-sales records name)
    (cond ((null? records) #f)
          ((equal? (caar records) name) (car records))
          (else (get-record-sales (cdr records) name))))
  (define get-salary-sales cadr)
  (put 'get-record 'marketing get-record-marketing)
  (put 'get-salary 'marketing get-salary-marketing)
  (put 'get-record 'sales get-record-sales)
  (put 'get-salary 'sales get-salary-sales))

(using company-pkg)

(find-employee-record "Nobody" files) => #f
(get-salary (find-employee-record "Alice" files)) => 50
(get-salary (find-employee-record "Bob" files)) => 50
(get-salary (find-employee-record "Joe" files)) => 40
(get-salary (find-employee-record "Jane" files)) => 60

# 2.4.3.1 Message passing

(define (make-from-real-imag x y)
  (lambda (op)
    (cond ((eq? op 'real-part) x)
          ((eq? op 'imag-part) y)
          ((eq? op 'magnitude) (sqrt (+ (square x) (square y))))
          ((eq? op 'angle) (atan y x))
          (else (error 'make-from-real-imag "unknown op" op)))))

(define (apply-generic op arg) (arg op))

(apply-generic 'real-part (make-from-real-imag 3 4)) => 3
(apply-generic 'magnitude (make-from-real-imag 0 1)) ~> 1

# Exercise 2.75⁠

(define (make-from-mag-ang r a)
  (lambda (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 'make-from-mag-ang "unknown op" op)))))

(apply-generic 'magnitude (make-from-mag-ang 15 0.5)) => 15
(apply-generic 'imag-part (make-from-mag-ang 1 0)) ~> 0

# Exercise 2.76⁠

• Generic operations with explicit dispatch
  • New type
    • Add a new clause to all generic procedures.
  • New operation
    • Write a generic procedure that handles all types.
• Data-directed style
  • New type
    • Install implementations of every operation.
  • New operation
    • Install implementations for every type.
    • Write a wrapper that invokes apply-generic.
• Message-passing style
  • New type
    • Write a procedure that handles all operations.
  • New operation
    • Add a new clause to the method dispatch of all types.

All three styles allow adding new types and operations, but they are optimized for different use cases. Generic operations with explicit dispatch is best when mostly adding new operations, while message passing is best when mostly adding new types. In each case, you can implement the new functionality in a self-contained piece of code, whereas using the other system requires editing many disparate pieces of code.

The data-directed style is best when adding a mix of types and operations, since it works equally well for both. It can also be used all the time instead of the other two systems. Its main drawback is the complexity of global mutable state (discussed more in Chapter 3) used for the table. Without knowing the contents of the table, you cannot be sure what will happen when invoking a generic procedure in the data-directed style.