countdown

Recently, I've been going to a Coding Dojo to practice my programming chops. One of the problems presented so far has been the Countdown program from RubyQuiz. I thought I might give it a shot, and cooked up a solution in Scheme, and it wasn't too bad.

I'll try to give an write-up on how one might attack the problem starting from scratch, and rather than just give a perfect solution, I'll go at this iteratively. (And make accidental mistakes along the way!)

The idea behind the countdown problem is that we are doing exhaustive "brute-force" search for all arithmetic expressions. For example, if we limit ourselves to the numbers 3, 4, and 5, and the only operations are addition and multiplication, here's a conceptual trace of what expressions we'll be brutishly looking at:

3
4
5

That the first phase. Then we take pairs of numbers here, and build new expressions:

3 + 4
3 + 5
4 + 5
3 * 4
3 * 5
4 * 5

Ok, now we take pairs again, combining stuff from previous phases and the phase we just generated:

3 + (4 + 5)
3 + (4 * 5)
4 + (3 + 5)
4 + (3 * 5)
5 + (3 + 4)
5 + (3 * 5)
3 * (4 + 5)
3 * (4 * 5)
4 * (3 + 5)
4 * (3 * 5)
5 * (3 + 4)
5 * (3 * 5)

Whew! Even with three numbers, this gets a bit long.

I should be more formal for a moment. By an expression, I mean either a number, or something that involves two smaller expressions and a number. In Backus-Naur Form, that's:

        expression = number
                   | expression op expression

Let's create a data definition in Scheme for this.

(module countdown mzscheme
 (provide (all-defined))
 ;; An expression is either a
 ;;     (make-num n)
 ;; where n is a number, or
 ;;     (make-comb l o r)
 ;; where l and r are expressions, and op is an operator.
 (define-struct num (n))
 (define-struct comb (left op right)))

Ok, we have our expression data definition. We should also make a quick-and-dirty helper function to help us visually read expressions; let's call this expression->string:

(module countdown mzscheme
 (require (lib "plt-match.ss"))

 ;; [data definition omitted]

 ;; expression->string: expression -> string
 ;; Makes a nice human-readable expression.
 (define (expression->string an-expr)
   (define (operator->string an-op)
     (cond
       [(eq? an-op +) "+"]
       [(eq? an-op *) "*"]))
 
   (match an-expr
     [(struct num (n)) (format "~a" n)]
     [(struct comb (l o r))
      (format "(~a ~a ~a)"
              (expression->string l)
              (operator->string o)
              (expression->string r))]))

Ok, now that we've got this, let's exercise the code.

> (expression->string (make-comb (make-num 3) + (make-num 4)))
"(3 + 4)"

Good. But I'm feeling guilty; we should really make this a unit test. Let's pull in SchemeUnit, the unit testing framework for Scheme.

(module countdown mzscheme
  (require ;; [other packages omitted]
           (planet "test.ss" ("schematics" "schemeunit.plt" 2))
           (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))
  
  ;; [code omitted]

  (define countdown-tests
    (test-suite
     "tests for countdown"
     (test-equal?
      "expression->string simple test"
      (expression->string (make-comb (make-num 3) + (make-num 4)))
      "(3 + 4)")))

  (test/text-ui countdown-tests))

If we run this module, we see:

1 success(es) 0 failure(s) 0 error(s) 1 test(s) run
> 

Very good.

Now let's see if we can build new expressions from old ones. The idea is that, if we have an existing collection of expressions, we want to pair two of them up together and do something with them. We might do this naively:

  ;; for-each-pairs: (X X -> void) (listof x) -> void
  ;; Calls f on distinct ordered pairs in the collection.
  (define (for-each-pairs f collection)
    (let outer-loop ([i 0])
      (when (< i (length collection))
        (let inner-loop ([j (add1 i)])
          (when (< j (length collection))
            (f (list-ref collection i) (list-ref collection j))
            (inner-loop (add1 j))))
        (outer-loop (add1 i)))))

Does this work?

> (for-each-pairs (lambda (x y) (printf "~a ~a~n" x y)) '(red blue green))
red blue
red green
blue green

Looks reasonable. Of course, now we want to use this to collect up all the pairs and build an addition and a multiplication from x and y. Let's call this build-next-generation. Oh, let's write our unit test first:

     (test-equal?
      "build-next-generation simple"
      (map expression->string
           (build-next-generation (list (make-num 3)
                                        (make-num 4))))
      (list "(3 + 4)" "(3 * 4)"))

Ok, let's roll up our sleeves and do it.

  ;; build-next-generation: (listof expression) -> (listof expression)
  ;; Constructs new expressions from pairs of old ones.
  (define (build-next-generation expressions)
    (define next-gen '())
    
    (define (collect! an-expr)
      (set! next-gen (cons an-expr next-gen)))
    
    (define (visit-pair e1 e2)
      (collect! (make-comb e1 + e2))
      (collect! (make-comb e1 * e2)))
    
    (for-each-pairs visit-pair expressions)
    (reverse! next-gen)
    next-gen)

Ok, should work. On every pair, we combine two expressions, and collect them. We do a reverse! to put things in the order expected by the test case. (Although that might be a little silly.) Let's rerun our unit tests.

tests for countdown > build-next-generation simple
build-next-generation simple has a FAILURE
name: check-equal?
location: #:67:5
params: (("(3 * 4)") ("(3 + 4)" "(3 * 4)"))
actual: ("(3 * 4)")
expected: ("(3 + 4)" "(3 * 4)")
1 success(es) 1 failure(s) 0 error(s) 2 test(s) run

What?! Yes, there's something wrong here.

It turns out that I've misused reverse! here: I should just take the result of reverse! and return it directly.

  (define (build-next-generation expressions)
    (define next-gen '())
    
    (define (collect! an-expr)
      (set! next-gen (cons an-expr next-gen)))
    
    (define (visit-pair e1 e2)
      (collect! (make-comb e1 + e2))
      (collect! (make-comb e1 * e2)))
    
    (for-each-pairs visit-pair expressions)
    (reverse! next-gen))

Hurrah for unit tests. But maybe we shouldn't do the reverse after all. Let me just fix up the test case to expect the paired expressions in a different order. Since I've made so many changes, let's show what the code looks like now:

(module countdown mzscheme
  (provide (all-defined))
  (require (lib "plt-match.ss")
           (planet "test.ss" ("schematics" "schemeunit.plt" 2))
           (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))
  
  ;; An expression is either a
  ;;     (make-num n)
  ;; where n is a number, or
  ;;     (make-comb l o r)
  ;; where l and r are expressions, and op is an operator.
  (define-struct num (n))
  (define-struct comb (left op right))
  
  
  ;; expression->string: expression -> string
  ;; Makes a nice human-readable expression.
  (define (expression->string an-expr)
    (define (operator->string an-op)
      (cond
        [(eq? an-op +) "+"]
        [(eq? an-op *) "*"]))
    
    (match an-expr
      [(struct num (n)) (format "~a" n)]
      [(struct comb (l o r))
       (format "(~a ~a ~a)"
               (expression->string l)
               (operator->string o)
               (expression->string r))]))
  
  ;; for-each-pairs: (X X -> void) (listof x) -> void
  ;; Calls f on distinct ordered pairs in the collection.
  (define (for-each-pairs f collection)
    (let outer-loop ([i 0])
      (when (< i (length collection))
        (let inner-loop ([j (add1 i)])
          (when (< j (length collection))
            (f (list-ref collection i) (list-ref collection j))
            (inner-loop (add1 j))))
        (outer-loop (add1 i)))))
  
  
  ;; build-next-generation: (listof expression) -> (listof expression)
  ;; Constructs new expressions from pairs of old ones.
  (define (build-next-generation expressions)
    (define next-gen '())
    
    (define (collect! an-expr)
      (set! next-gen (cons an-expr next-gen)))
    
    (define (visit-pair e1 e2)
      (collect! (make-comb e1 + e2))
      (collect! (make-comb e1 * e2)))
    
    (for-each-pairs visit-pair expressions)
    next-gen)
  
  
  (define countdown-tests
    (test-suite
     "tests for countdown"
     (test-equal?
      "expression->string simple test"
      (expression->string (make-comb (make-num 3) + (make-num 4)))
      "(3 + 4)")
     (test-equal?
      "build-next-generation simple"
      (map expression->string
           (build-next-generation (list (make-num 3)
                                        (make-num 4))))
      (list "(3 * 4)" "(3 + 4)"))))
  
  (test/text-ui countdown-tests))

Ok! Does this do what we'll need for brute-forcing the countdown problem?

> (define expressions (list (make-num 3)
                            (make-num 4)
                            (make-num 5)))
> (define generation-1 (append expressions (build-next-generation expressions)))
> (define generation-2 (append generation-1 (build-next-generation generation-1)))
> (map expression->string generation-2)
("3"
 "4"
 "5"
 "(4 * 5)"
 "(4 + 5)"
 "(3 * 5)"
 "(3 + 5)"
 "(3 * 4)"
 "(3 + 4)"
 "((3 * 4) * (3 + 4))"
 "((3 * 4) + (3 + 4))"
 "((3 + 5) * (3 + 4))"
 ;; ... a LOT of output omitted
 "(3 * (4 * 5))"
 "(3 + (4 * 5))"
 "(3 * 5)"
 "(3 + 5)"
 "(3 * 4)"
 "(3 + 4)")

It's a beginning. It's not quite right, but it's getting there. Since this post is getting long, I'll split this up with another blog post later.