Breadth-first Numbering: A Lazy Functional Queue

On the way to a breadth-first numbering solution, I’ve built a simple functional queue and created lazy lists from Scheme primitives (and a couple handy macros). In this post, I’ll bring the pieces together to create an improved queue. (And yes, I promise I’ll actually start numbering trees sometime soon).

Our simple queue consisted of two lists: one for the head of the queue, and a reversed one for the tail:

1

'((1 2 3) (5 4))

Our improved queue makes two changes: lazy lists and incremental reversal. It will look like this:

1
2

'(((1 . #<procedure:...me/bfs/queue.scm:106:6>) . 3)
  ((5 . #<procedure:...me/bfs/queue.scm:106:6>) . 2))

This looks a little complicated, but just like the simple queue, it’s also a list of a head and reversed tail, with each side storing the length of the associated list. This equivalent is a little simpler:

1

'((llist '(1 2 3)) . 3) (llist '(5 4)) . 2))

To start implementing the improvements, we need to update the selectors to get the lists and lengths from both sides:

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
29

(define empty-q (list (cons '() 0) (cons '() 0)))

(define five-items (list (cons (llist '(1 2)) 2) (cons (llist '(3 4 5)) 3)))

(define lhs-len
  (lambda (queue)
    (cdr (left-side queue))))

(check-equal? (lhs-len five-items) 2
              "Our lazy queue stores the length of the lists on each side.")

(define rhs-len
  (lambda (queue)
    (cdr (right-side queue))))

(check-equal? (rhs-len five-items) 3
              "Our lazy queue stores the length of the lists on each side.")

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

(check-equal? (lcar (lhs-list five-items)) (lcar (llist '(1 2))))

(define rhs-list
  (lambda (queue)
    (car (right-side queue))))

(check-equal? (lcar (rhs-list five-items)) (lcar (llist '(3 4 5))))

Now we can write an updated insert function:

1
2
3
4
5
6
7
8
9
10
11

(define ins
  (lambda (item queue)
    (list (left-side queue)
          (cons (lcons item (rhs-list queue))
                (+ 1 (rhs-len queue))))))

(let ((three-items (ins 3 (ins 2 (ins 1 empty-q))))
      (six-items (ins 6 (ins 5 (ins 4 (ins 3 (ins 2 (ins 1 empty-q))))))))
      (check-equal? (take-n 3 (rhs-list three-items)) '(3 2 1))
      (check-equal? (take-n 3 (rhs-list six-items)) '(6 5 4)
                    "Ins adds elements to the right side."))

Remove is a little more complicated. In the simple queue, we simply swapped and reversed the right side. We want our improved queue to avoid reversing long right side lists. The solution is incremental reversal: rebalance the queue every time an element is removed.

In Okasaki’s implementation, this is done with functions called make-queue and rotate. Below are my Scheme translations.

Rotate reverses the right side list and concatenates it to the left. It’s similar to the simple queue implementation, but it uses lazy list operators and it’s designed to work incrementally:

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

(define rotate
  (lambda (left right)
    (define rotate-recur
      (lambda (left right accumulator)
        (if (null? left)
            (lcons (lcar right) accumulator)
            (lcons (lcar left) (rotate-recur (lcdr left)
                                             (lcdr right)
                                             (lcons (lcar right) accumulator))))))
        (rotate-recur left right '())))

(let ((rotated (rotate (lhs-list five-items) (rhs-list five-items))))
     (check-equal? (take-n 5 rotated) '(1 2 5 4 3)
                    "Rotate reverses the right side list and concatenates it to the left."))

Make-queue implements the incremental reversal logic. Now, we no longer wait until the head list is empty to swap and reverse. Instead, we rotate the queue as soon as the tail list contains one more element than the head. This keeps the queue balanced, and ensures that we won’t run into an expensive reversal:

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

(define make-queue
  (lambda (left right)
    (if (<= (cdr right) (cdr left))
        (list left right)
        (list (cons (rotate (car left)
                            (car right))
                    (+ (cdr left) (cdr right)))
              (cons '() 0)))))

(let ((rebalanced (make-queue (left-side five-items)
                              (right-side five-items))))
 (check-equal? (take-n 5 (lhs-list rebalanced)) '(1 2 5 4 3))
 (check-equal? (rhs-list rebalanced) '()
               "Make-queue rebalances the queue when the right side is longer than the left."))

To maintain a balanced queue, we’ll want to call make-queue on insertion and removal. Here’s an improved insert, and a new remove:

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
29

(define ins
  (lambda (item queue)
    (make-queue (left-side queue)
                (cons (lcons item (rhs-list queue))
                      (+ 1 (rhs-len queue))))))

(let ((three-items (ins 3 (ins 2 (ins 1 empty-q))))
      (six-items (ins 6 (ins 5 (ins 4 (ins 3 (ins 2 (ins 1 empty-q))))))))
  (check-equal? (take-n 3 (lhs-list three-items)) '(1 2 3))
  (check-equal? (take-n 3 (lhs-list six-items)) '(1 2 3))
  (check-equal? (take-n 3 (rhs-list six-items)) '(6 5 4)
                "Ins adds elements to the right side and 
                 rebalances if it's longer than the left."))

(define rem
  (lambda (queue)
    (if (and (null? (lhs-list queue)) (null? (rhs-list queue)))
        '()
        (list (lcar (lhs-list queue))
              (make-queue (cons (lcdr (car (left-side queue)))
                                      (- (lhs-len queue) 1))
                          (right-side queue))))))

(let ((removed (rem (ins 4 (ins 3 (ins 2 (ins 1 empty-q)))))))
  (check-equal? (car removed) 1)
  (check-equal? (take-n 2 (lhs-list (cadr removed))) '(2 3))
  (check-equal? (take-n 1 (rhs-list (cadr removed))) '(4)
                "Rem returns a pair: the element removed
                 from the queue and the new queue."))

Finally, let’s add a couple convenience functions to insert and remove multiple items:

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 ins-items
  (lambda (items queue)
    (if (null? items)
        queue
        (ins-items (cdr items) (ins (car items) queue)))))

(let ((seven-items (ins-items '(1 2 3 4 5 6 7) empty-q)))
  (check-equal? (take-n 7 (lhs-list seven-items)) '(1 2 3 4 5 6 7)
                "Ins-items adds multiple items to the queue."))

(define rem-n
  (lambda (n queue)
    (define rem-n-iter
      (lambda (n queue items)
        (if (= 0 n)
            (cons (reverse items) queue)
            (rem-n-iter (- n 1)
                        (car  (cdr (rem queue)))
                        (cons (car (rem queue)) items)))))
    (rem-n-iter n queue '())))

(let ((remove-four (rem-n 4 (ins-items '(1 2 3 4 5 6 7) empty-q))))
  (check-equal? (car remove-four) '(1 2 3 4))
  (check-equal? (+ (lhs-len (cdr remove-four))
                   (rhs-len (cdr remove-four))) 3
                "Rem-n returns a list of removed items and the new queue."))

Next time, we’ll finally bring everything together to solve the breadth-first numbering problem.

Comments