August 28, 2012 9:00 AM
The datatype Rlist is a list of (int * α Tree), where an α Tree is either a Leaf of α or a Node of (α * α Tree * α Tree). We provide the following structures, where an item is a single element of an Rlist:
(define-structure leaf x)
(define-structure node x t1 t2)
(define-structure item w t)
The empty Rlist is trivial:
(define empty (list))
(define empty? null?)
The cons function, which we spell kons to distinguish it from the built-in function on normal lists, adds a new item if the Rlist is empty or singleton, otherwise it builds a new Node from the first two Items in the Rlist:
(define (kons x ts)
(if (or (empty? ts) (empty? (cdr ts)))
(cons (make-item 1 (make-leaf x)) ts)
(let ((w1 (item-w (car ts))) (w2 (item-w (cadr ts)))
(t1 (item-t (car ts))) (t2 (item-t (cadr ts))))
(if (= w1 w2)
(cons (make-item (+ 1 w1 w2) (make-node x t1 t2)) (cddr ts))
(cons (make-item 1 (make-leaf x)) ts)))))
The head and tail functions look at the first item in the Rlist and branch on whether it is a Leaf or a Node. Both functions are careful to report an error if handed an empty list. Note the “impossible” conditions, which were, sadly, very valuable during development of the functions:
(define (head ts)
(cond ((empty? ts) (error 'head "empty list"))
((leaf? (item-t (car ts)))
(if (= (item-w (car ts)) 1)
(leaf-x (item-t (car ts)))
(error 'head "impossible")))
((node? (item-t (car ts)))
(node-x (item-t (car ts))))
(else (error 'head "impossible"))))
(define (tail ts)
(cond ((empty? ts) (error 'tail "empty list"))
((leaf? (item-t (car ts)))
(if (= (item-w (car ts)) 1)
(cdr ts)
(error 'tail "impossible")))
((node? (item-t (car ts)))
(let* ((w (item-w (car ts))) (w2 (quotient w 2))
(t (item-t (car ts))) (ts (cdr ts))
(t1 (node-t1 t)) (t2 (node-t2 t)))
(cons (make-item w2 t1) (cons (make-item w2 t2) ts))))
(else (error 'tail "impossible"))))
That dispenses with the normal list functions of the random access lists, so it is a good time to stop and test what we have done:
> (define x (kons 7 empty))
> (set! x (kons 6 x))
> (set! x (kons 5 x))
> (set! x (kons 4 x))
> (set! x (kons 3 x))
> (set! x (kons 2 x))
> (set! x (kons 1 x))
> (set! x (kons 0 x))
> (head x)
0
> (head (tail x))
1
> (head (tail (tail x)))
2
Now we can continue with the random access part of the data structure. The lookup function is similar to the list-ref function of Scheme; it first finds the right item in the Rlist (which takes O(log n) time, since that’s the length of the Rlist), then the auxiliary function lookup-tree determines if the item is a Leaf or Node and responds appropriately. Note that lookup and update! both check that subscripts are in range:
(define (lookup i ts)
(define (lookup-tree w i t)
(cond ((and (= w 1) (zero? i) (leaf? t))
(leaf-x t))
((and (= w 1) (leaf? t))
(error 'lookup-tree "subscript out of range"))
((and (zero? i) (node? t))
(node-x t))
((node? t)
(let ((w2 (quotient w 2)) (t1 (node-t1 t)) (t2 (node-t2 t)))
(if (<= i w2)
(lookup-tree w2 (- i 1) t1)
(lookup-tree w2 (- i 1 w2) t2))))
(else (error 'lookup-tree "impossible"))))
(cond ((empty? ts) (error 'lookup "subscript out of range"))
((< i (item-w (car ts)))
(let ((w (item-w (car ts))) (t (item-t (car ts))))
(lookup-tree w i t)))
(else (let ((w (item-w (car ts))))
(lookup (- i w) (cdr ts))))))
Update! is similar to lookup, except that it returns a newly-allocated Rlist that shares items with its input:
(define (update! i y ts)
(define (update-tree w i y t)
(cond ((and (= w 1) (zero? i) (leaf? t))
(make-leaf y))
((and (= w 1) (leaf? t))
(error 'update-tree "subscript out of range"))
((and (zero? i) (node? t))
(make-node y (node-t1 t) (node-t2 t)))
((node? t)
(let ((w2 (quotient w 2)) (x (node-x t))
(t1 (node-t1 t)) (t2 (node-t2 t)))
(if (<= i w2)
(make-node x (update-tree w2 (- i 1) y t1) t2)
(make-node x t1 (update-tree w2 (- i 1 w2) y t2)))))
(else (error 'update-tree "impossible"))))
(cond ((empty? ts) (error 'update! "subscript out of range"))
((< i (item-w (car ts)))
(let ((w (item-w (car ts))) (t (item-t (car ts))))
(cons (make-item w (update-tree w i y t)) (cdr ts))))
(else (let* ((t (car ts)) (ts (cdr ts)) (w (item-w t)))
(cons t (update! (- i w) y ts))))))
It’s time for some more testing:
> (lookup 2 x)
2
> (set! x (update 2 12 x))
> (lookup 2 x)
12
> (head (tail (tail x)))
12
We used define-structure from the Standard Prelude. The code is collected at http://programmingpraxis.codepad.org/CDtlf2Sy, but I couldn’t make it run; it runs fine on my machine at home, but something about the macros provided by MzScheme in the codepad system doesn’t work with this code.
Posted by programmingpraxis
Categories: Exercises
Tags:
Mobile Site | Full Site
Get a free blog at WordPress.com Theme: WordPress Mobile Edition by Alex King.
Your link appears to be broken (as in the page loads, but the PDF link from there doesn’t work), but you can get a copy here
By JP on August 28, 2012 at 5:37 PM
Hmmm. Works for me.
By programmingpraxis on August 28, 2012 at 5:41 PM
Ah, oops. The direct link ([www.cs.columbia.edu]) doesn’t work (for me), but the PDF link () works fine.
By JP on August 28, 2012 at 5:54 PM
(There was supposed to be an image there, but it got stripped out. Just imagine a black and white PDF icon.)
By JP on August 28, 2012 at 5:56 PM
I expect CONS, CAR and CDR to be O(1), not O(n)…
By Axio on August 29, 2012 at 7:50 AM
[…] Pages: 1 2 […]
By Random Access Lists | On scalable, RPC-based network emulators on August 29, 2012 at 10:23 AM
A Haskell implementation: http://hamberg.no/erlend/posts/2012-08-29-purely-functional-random-access-list.html
By erλend (@ehamberg) on August 29, 2012 at 11:11 AM
In this data structure, cons, car and cdr are O(1), not O(n). I’ve fixed the incorrect comment. Thanks.
By programmingpraxis on August 29, 2012 at 11:18 AM
[…] time around, Programming Praxis had a challenge to take the algorithm presented in Chris Okasaki’s 1995 paper Purely Functional Random-Access […]
By Random Access Lists | jverkamp.com on August 30, 2012 at 1:28 PM
After all that noise above, I figured that I should actually go about implementing it. I’ve got a version here that is pretty much a direct translation from the paper’s ML (I think) to Scheme. I’m strongly reminded of skip lists, just with a better way for dynamically resizing.
By JP on August 30, 2012 at 4:50 PM
My implementation in Common Lisp
By cage on September 9, 2012 at 11:40 AM