Breadth-first Numbering: Functional Queues

I spent some time this weekend (okay fine, most of Saturday and Sunday afternoon) on an exercise Michael Baker shared on our “geeks” mailing list. The problem is a functional pearl from Chris Okasaki: given a binary tree, reproduce a structurally identical tree with its nodes numbered in breadth-first order.

For example, numbering this tree:

1
2
3
4
5
6
7
8

_       a
       / \
      /   \
    b       d
   / \     / \
  .   c   .   .
     / \
    .   .

Should yield this tree:

1
2
3
4
5
6
7
8

_       1
       / \
      /   \
    2       3
   / \     / \
  .   4   .   .
     / \
    .   .

If you’ve ever solved a search problem, this might sound stupid easy. But getting the details of a functional solution right can be a challenge. As Okasaki puts it in the paper:

…I presented the problem to many other functional programmers and was continually amazed at the baroque solutions I received in reply. With only a single exception, everyone who came near a workable answer went in a very different direction from my solution right from the very beginning of the design process. I gradually realized that I was witnessing some sort of mass mental block, a communal blind spot, that was steering programmers away from what seemed to be a very natural solution.

Before you read my baroque solution, you might want to try for yourself. I’ll wait.

Although I love Clojure, using built-in queues and lazy seqs felt like cheating. So I chose to use Racket with Rackunit, and tried to use as many primitives as possible.

Breadth-first traversal is easy with a queue, but an efficient functional queue can be tricky. Consing an element to the front of a Scheme list is cheap, but appending is expensive—it requires “cdring down” over all the elements. One solution (cribbed from Okasaki himself) is to represent a queue as a pair of lists. The list on the left is the head of the queue, so elements can be popped of in O(1) time. The right side represents the rest of the elements in reverse, so elements can be pushed on to the end in constant time. Here are the first steps towards an implementation: an empty queue with left and right selectors.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

(define simple-q '((1 2 3) (6 5 4)))

(define empty-queue '(()()))

(check-equal? empty-queue '(() ())
              "An empty queue is a list containing two empty lists.")

(define right-side (lambda (queue) (car (cdr queue))))

(check-equal? (right-side simple-q) '(6 5 4)
              "The right side of a queue is the second list.")

(define left-side (lambda  (queue) (car queue)))

(check-equal? (left-side simple-q) '(1 2 3)
              "The left side of a queue is the first list.")

Inserting an item conses it on to the right-side list:

1
2
3
4
5
6
7

(define insert
  (lambda (item queue)
    (list (left-side queue) (cons item (right-side queue)))))

(check-equal? (insert 7 simple-q) '((1 2 3) (7 6 5 4))
              "Inserting an element adds it to the beginning of the
              right side list.")

To dequeue an item, “remove” it from the left side with car, and return a new queue, with the cdr of the left side list:

1
2
3
4
5
6
7
8

(define remove
 (lambda (queue)
  (list (car (left-side queue))
        (list (cdr (left-side queue)) (right-side queue)))))

(check-equal? (remove simple-q) '(1 ((2 3) (6 5 4)))
              "Removing an element returns a pair: the removed
               element and the new queue.")

When the left side is out of elements, reverse the right side list, and swap it with the left. Here’s the buildup to swap-and-reverse-car:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

(define swap
  (lambda (queue) (list (right-side queue) (left-side queue))))

(check-equal? (swap simple-q) '((6 5 4) (1 2 3))
              "The right side and left side can be swapped.")

(define reverse
  (lambda (items)
    (if (null? (cdr items))
        items
        (append (reverse (cdr items)) (list (car items))))))

(check-equal? (reverse (right-side simple-q)) (list 4 5 6)
              "A list's elements can be reversed.")

(define reverse-car
  (lambda (items)
    (cons (reverse (car items)) (cdr items))))

(check-equal? (reverse-car '((1 2) (3 4))) '((2 1) (3 4))
              "The first item in a list can be reversed.")

(define swap-and-reverse-car
  (lambda (queue) (reverse-car (swap queue))))

(check-equal? (swap-and-reverse-car '(() (6 5 4))) '((4 5 6) ())
              "Swap and reverse-car can be composed to swap sides,
              then reverse the left.")

Now we can write a dequeue function that really works:

1
2
3
4
5
6
7
8
9
10
11
12
13
14

(define remove
   (lambda (queue)
     (if (null? (left-side queue))
         (remove (swap-and-reverse-car queue))
         (list (car (left-side queue))
               (list (cdr (left-side queue)) (right-side queue))))))

(check-equal? (remove '(() (6 5 4))) '(4 ((5 6) ()))
              "To remove an element when the left side is empty, swap
              and reverse, then try again.")

(check-equal? (remove simple-q) '(1 ((2 3) (6 5 4)))
              "Removing an element returns a pair: the removed element
              and the new queue.")

That’s all it takes to build a simple functional queue. Unfortunately, it’s not very efficient. Reversing a list is the kind of O(n) operation we built our queue to avoid in the first place, but if many more items are inserted than removed, we’ll end up reversing and swapping a lot. We can do better—and I’ll explain how in my next post.

Comments