Coin Change, Part 3

May 24, 2013

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 sn 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.

About these ads

Pages: 1 2

4 Responses to “Coin Change, Part 3”

  1. Josh said
    >>> from itertools import combinations
    >>> def coins(s, n):
    ...     for i in xrange(n):
    ...         for comb in combinations(xrange(1, n + 1), i):
    ...             if sum(comb) == n:
    ...                 yield comb
    ... 
    >>> combs = list(coins(10, 10))
    >>> print 'Combinations: %d\n' % len(combs), '\n'.join(str(c) for c in combs)
    Combinations: 10
    (10,)
    (1, 9)
    (2, 8)
    (3, 7)
    (4, 6)
    (1, 2, 7)
    (1, 3, 6)
    (1, 4, 5)
    (2, 3, 5)
    (1, 2, 3, 4)
    >>> 
    
  2. Colin said

    Memoized/dynamic programming solution, in clojure, should use O(sn) space and time:

    (ns coins3)
    
    ; what ways to pay "s" with exactly one of each coin from 1 to n?
    (def pay (memoize (fn [s n]
      (cond
        (zero? s) '(())     ; only one way to pay 0
        (< s n) (recur s s) ; can't use any coin larger than s
        :else               ; pay part, then pay the remainder with smaller coins
          (mapcat (fn [c] (map #(conj % c) (pay (- s c) (dec c))))
                  (range n 0 -1)))))) ; try big coins first, to match output
    
  3. Colin said

    Hm. Looking at it again, “recur” in line 7 above could “dodge” the memoization; should replace that with “pay” instead.
    It’s more space-efficient yet to extract the “else” clause into a mutually-recursive function and memoize it separately, or, as in the sample solution, to explicitly solve via dynamic programming.

  4. cosmin said

    An O(S*N) time and O(S) space solution that counts the number of ways the sum can be obtained:

    def countSum(n, s):
    	count = (s+1) * [0]
    	count[0] = 1
    	for i in xrange(1, n+1):
    		for x in xrange(s - i, -1, -1):
    			count[x+i] += count[x]
    	return count[s]
    
    print countSum(10, 10)
    

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 617 other followers

%d bloggers like this: