# SICP Goodness - Data Directed Programming (III)

Is this polymorphism?

Do you think Computer Science

equalsbuilding websites and mobile apps?Are you feeling that you are doing

repetitiveandnot so intelligentwork?Are you feeling a bit

sickaboutreading manualsandcopy-pastingcode and keeppoking arounduntil it worksall day long?Do you want to understand the

soulofComputer Science?If yes,

read SICP!!!

# A Table to the Rescue

In previous article, we see that it becomes quite annoying that each and every one of the generic selectors of the complex number has to do a `cond`

on the types.

This is a symptom of lacking the right abstraction in our system. Actually, we can better organize this by using a table, shown as below:

Data-directed programming is the technique of designing programs to work with such a table directly.

Wait, this looks a lot like virtual table in C++ ?

How to use this table is obvious. For example, to call `real-part`

on a complex number object, first we get the type of the complex number, say it is in rectangular form. Then we just look up the table by `real-part`

and `Rectangular`

, and find the real procedure to use.

We also need ways to put procedures into the table.

# Implementation of the table

Here are the two procedures `put`

and `get`

:

```
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
;; Helper functions --- implementation of two dimensional table
(define (assoc key records)
(cond ((null? records) false)
((equal? key (caar records)) (car records))
(else (assoc key (cdr records)))))
(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))
```

Take a look at my previous post on how to implement a two dimensional table using pairs.

# Install rectangular and polar packages

Install packages sounds like fancy concept, but it is really just put procedures in the table.

```
(define (install-rectangular-package)
;; internal procedures
(define (real-part z) (car z))
(define (imag-part z) (cdr z))
(define (make-from-real-imag x y) (cons x y))
(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))))
'done)
(define (install-polar-package)
;; internal procedures
(define (magnitude z) (car z))
(define (angle z) (cdr z))
(define (make-from-mag-ang r a) (cons r a))
(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))))
'done)
```

To install a package, first define the internal procedures to be put into the table, then put them in the table under some indexes.

# Apply generic operations

Now we have the table ready, let’s use it to replace the `cond`

s in each generic operations. Basically now we need to be able to get the real procedure from the table based on the indexes and then apply that to the complex number object.

```
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(error
"No method for these types -- APPLY_GENERICS"
(list op type-tags))))))
```

Using `apply-generic`

, we can define our generic operations as follows:

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

# Constructors

We can now define the generic constructors as follows:

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

Now we have seen a full example of data directed programming. I have to say this is like hand made polymorphism to me.

I think this will put a smile on you face next time you hear people say “OO’s big advantage over FP is polymorphism”.

## Share this post

Twitter

Google+

Facebook

Reddit

LinkedIn

StumbleUpon

Email