Breadth-first Numbering: A Solution

Now that we’ve built an efficient functional queue, we can finally put it to work in a breadth-first numbering solution.

First, let’s define a few trees up front for testing. The first is the example given in the introduction of the paper. The other two are a little trickier, and the twelve-node tree is not binary.

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

(define example-tree '("A" ("B" "leaf"
                                ("C" "leaf"
                                     "leaf"))
                           ("D" "leaf"
                            "leaf")))

(define five-nodes '("A" ("B" ("D" "leaf"
                                   "leaf")
                              ("E" "leaf"
                                   "leaf"))
                         ("C" "leaf"
                              "leaf")))

(define twelve-nodes '("A" ("B" "leaf")
                           ("C" "leaf"
                                ("D" ("F" "leaf"
                                          "leaf")
                                     ("G" ("I" "leaf"
                                               "leaf")
                                          "leaf")
                                     ("H" ("J" "leaf"
                                               "leaf"
                                               "leaf")
                                          ("K" "leaf")
                                          ("L" "leaf")))
                                ("E" "leaf"))))

To calculate the visit order, we can perform a simple breadth-first traversal of the tree. Now that we have a queue, the solution is pretty close to the pseudocode: Start with the root node in the queue, and assign it a number. Then recur with three new parameters: A queue with this node’s children inserted, a list with this node’s number consed on, and an incremented node number. When the queue is empty, we’re done:

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

(define visit-order
  (lambda (tree)
    (define bfs-iter
      (lambda (queue visited n)
        (if (null? (rem queue)) visited
            (let ((node  (car (rem queue)))
                  (new-q (car (cdr (rem queue)))))
              (if (equal? "leaf" node)
                  (bfs-iter new-q visited n)
                  (bfs-iter (ins-items (cdr node) new-q)
                            (cons (cons (car node) n) visited)
                            (+ 1 n)))))))
  (bfs-iter (ins tree empty-q) '() 1)))

(check-equal?  (visit-order example-tree)
              '(("C" . 4) ("D" . 3) ("B". 2) ("A" . 1))
              "Visit-order searches a tree breadth-first and returns a
              list of nodes and their numbers.")

(check-equal?  (visit-order five-nodes)
              '(("E" . 5) ("D" . 4) ("C" . 3) ("B" . 2) ("A" . 1)))

(check-equal?   (visit-order twelve-nodes)
               '(("L" . 12) ("K" . 11) ("J" . 10) ("I" . 9) ("H" . 8) ("G" . 7) ("F" . 6)
                 ("E" . 5)  ("D" . 4)  ("C" . 3)  ("B" . 2) ("A" . 1))
               "Visit-order works on non-binary trees.")

It’s possible to map a visit queue back to a binary tree (check out Michael’s concise Haskell solution), but I wanted a solution that would work for all trees. In the end, I settled for performing a second depth-first traversal to label nodes. This walk-map function works like a recursive map, traversing a nested structure and applying a function to every element that’s not a list:

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

(define walk-map
  (lambda (func items)
    (define apply-or-map
      (lambda (item)
        (cond ((null? item) '())
              ((pair? item) (map apply-or-map item))
              (else (func item)))))
    (map apply-or-map items)))

(check-equal?  (walk-map (lambda (i) (cond ((= i 1) "one") ((= i 2) "two") ((= i 3) "three") ))
              '(1 2 (1 1 2 (3 (1 (2) 2) 1 3))))
              '("one" "two" ("one" "one" "two" ("three" ("one" ("two")"two") "one" "three"))))

Here’s a convenience function to store node order in a hash set:

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

(define make-label-map
  (lambda (labels)
    (let ((label-map (make-hash)))
      (define add-labels
        (lambda (labels)
          (if (null? labels)
              label-map
              (let ((node   (car  (car labels)))
                    (number (cdr (car labels))))
                (hash-set! label-map node number)
                (add-labels (cdr labels))))))
      (add-labels labels))))

(let ((label-map (make-label-map (visit-order example-tree))))
  (check-equal? (hash-ref label-map "A") 1)
  (check-equal? (hash-ref label-map "B") 2)
  (check-equal? (hash-ref label-map "C") 4)
  (check-equal? (hash-ref label-map "D") 3))

And at long last, a solution for breadth-first numbering: calculate node order, then map over the tree to apply the labels:

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

(define number-tree
  (lambda (tree)
    (let ((label-map (make-label-map (visit-order tree))))
      (walk-map (lambda (node) (if (equal? "leaf" node)
                                   "leaf"
                               (hash-ref label-map node)))
                tree))))

(check-equal? (number-tree example-tree) '(1 (2 "leaf" (4 "leaf" "leaf")) (3 "leaf" "leaf")))
(check-equal? (number-tree five-nodes) '(1 (2 (4 "leaf" "leaf") (5 "leaf" "leaf")) (3 "leaf" "leaf")))
(check-equal? (number-tree twelve-nodes) '(1
                                           (2 "leaf")
                                           (3
                                              "leaf"
                                              (4
                                                (6 "leaf"
                                                   "leaf")
                                                (7 (9     "leaf"
                                                          "leaf")
                                                   "leaf")
                                                (8 (10    "leaf"
                                                          "leaf"
                                                          "leaf")
                                                   (11    "leaf")
                                                   (12    "leaf")))
                                              (5   "leaf"))))

On the plus side, this solution generalizes to non-binary trees, and is built almost entirely out of Scheme primitives. It’s not as concise or efficient as I’d like, but I’m happy with my lazy lists and functional queue, even if the implementation is a little long. You can find an edited version of my solution here, and all the code from these posts as a Gist here.

Comments