Programming Praxis

We’re going to have some fun with this exercise, and do a little bit more work than we really need. We start with this function to calculate the list of sets:

(define (fs n s)
  (if (or (<= n 0) (<= s 0)) (list)
    (append (if (= n s) (list (list n))
              (map (lambda (xs) (cons n xs))
                   (fs (- n 1) (- s n))))
            (fs (- n 1) s))))

> (fs 10 10)
((10) (9 1) (8 2) (7 3) (7 2 1) (6 4) (6 3 1) (5 4 1) (5 3 2) (4 3 2 1))

That’s a straight forward recursion that stops when either n or s is zero, adding a new coin to each set in the s − n set and appending the n − 1 sets; notice the special handling when n equals s. Function f is similar, but counts sets instead of listing them:

(define (f n s)
  (if (or (<= s 0) (<= n 0)) 0
    (+ (if (= n s) 1
         (f (- n 1) (- s n)))
       (f (- n 1) s))))

> (f 10 10)
10
> (time (f 100 100)
(time (f 100 ...))
    no collections
    1254 ms elapsed cpu time
    1435 ms elapsed real time
    0 bytes allocated
444793

That’s quite slow; it would be intolerable to evaluate (f 1000 1000), as the algorithm is exponential. The problem is the same as with the naive fibonacci algorithm; the same sub-problems are re-computed again and again.

A common solution to that problem is memoization. Fortunately, we are programming in Scheme, which makes it easy to encapsulate memoization in a macro:

(define-syntax define-memoized
  (syntax-rules ()
    ((_ (f args ...) body ...)
      (define f
        (let ((results (make-hash hash equal? #f 997)))
          (lambda (args ...)
            (let ((result (results 'lookup (list args ...))))
              (or result
                  (let ((result (begin body ...)))
                    (results 'insert (list args ...) result)
                    result)))))))))

We use hash tables from the Standard Prelude and the universal hash function from a previous exercise. Then it is a simple matter to write the memoized version of the function:

(define-memoized (f n s)
  (if (or (<= s 0) (<= n 0)) 0
    (+ (if (= n s) 1
         (f (- n 1) (- s n)))
      (f (- n 1) s))))

Isn’t that pretty? The only change is the addition of -memoized in the definition of the function; all of the parameters and the body of the function are the same. But the performance improves greatly:

> (time (f 100 100))
(time (f 100 ...))
    no collections
    62 ms elapsed cpu time
    104 ms elapsed real time
    1028376 bytes allocated
444793

That’s an order-of-magnitude improvement with virtually no effort.

But that’s not all. Since we know that the problem has “optimal substructure” we can use dynamic programming. Memoization works top-down, and must suspend the current level of recursion, compute (either directly or by lookup) the lower-level solution, then resume computation in the current level of recursion. Dynamic programming, on the other hand, works bottom-up, so sub-solutions are always available when they are needed. Here’s the dynamic programming version of our function:

(define (f n s)
  (let ((fs (make-matrix (+ n 1) (+ s 1) 0)))
    (do ((i 1 (+ i 1))) ((< n i))
      (do ((j 1 (+ j 1))) ((< s j))
        (matrix-set! fs i j
          (+ (if (= i j)
                 1
                 (matrix-ref fs (- i 1) (max (- j i) 0)))
             (matrix-ref fs (- i 1) j)))))
    (matrix-ref fs n s)))

We used the matrix functions of the Standard Prelude. That’s more work than just adding -memoized to an existing function, but the payoff is another order-of-magnitude reduction in run time:

> (time (f 100 100))
(time (f 100 ...))
    no collections
    4 ms elapsed cpu time
    4 ms elapsed real time
    41624 bytes allocated
444793
> (time (f 1000 1000))
(time (f 1000 ...))
    3 collections
    649 ms elapsed cpu time, including 103 ms collecting
    698 ms elapsed real time, including 132 ms collecting
    15982928 bytes allocated, including 10846336 bytes reclaimed
8635565795744155161506

We’ve gone from 1254ms to 4ms, which is a rather astonishing range of improvement; the final program is O(ns). You can run the program at http://programmingpraxis.codepad.org/Y70sHPc0.

For the Scheme programmers reading this, here is another version of the define-memoization macro. It uses a-lists rather than hash tables, so it’s very much slower than the version given above, but when the underlying computation is time-consuming, and you just want a simple way to improve it, this may be just what you need:

(define-syntax define-memoized
  (syntax-rules ()
    ((define-memoized (f arg ...) body ...)
      (define f
        (let ((cache (list)))
          (lambda (arg ...)
            (cond ((assoc `(,arg ...) cache) => cdr)
            (else (let ((val (begin body ...)))
                    (set! cache (cons (cons `(,arg ...) val) cache))
                    val)))))))))

This is a good use of quasi-quotation and the => operator in a cond clause for those who are just learning Scheme. I can’t remember when I wrote that function — I’ve had it laying around for years — but it has saved me many times when I just needed a quick-and-dirty memoization and didn’t care to worry about hash tables and universal hash functions.

Pages: 1 2