chickadee » random-access-lists

Outdated egg!

This is an egg for CHICKEN 4, the unsupported old release. You're almost certainly looking for the CHICKEN 5 version of this egg, if it exists.

If it does not exist, there may be equivalent functionality provided by another egg; have a look at the egg index. Otherwise, please consider porting this egg to the current version of CHICKEN.

Random-access-lists

Random-access-lists combine the advantages of vectors (fast access) and linked-lists (fast insertions). They can be implemented on the basis of skiplists.

Whereas an ordinary skiplist-node consists of an item and a vector of next nodes, whose length is computed randomly in such a way, that the number of nodes with length n are in the average one half of the number of nodes with length (- n 1), a random-access-list-node must have an additional vector of same length containing the jumps, i.e. numbers indicating how far the node is moved when following the next nodes at a given level. Following a node at level n describes a fast lane across the random-access-list, where the jumps at level n are in the average twice as long as the jumps at the level below.

In our implementation of random-access-lists we store a vector of nodes, called cursors, and a vector of positions, called places, which are updated along the movement accross the list. Moving cursors and places to a given position, pos, works as follows: One starts at the highest level and follows the next link at that level adding the jump at that level to the place at that level until the latter is less than pos but a further movement at that level would be greater or equal pos. Then one saves cursor and place and restarts the same movement process at the level below, starting with the values saved in the level above. Eventually one reaches level 0 and stops at a place one less than pos. The stored cursors can than be used to insert or remove an item, as well as getting or setting pos' item. Note, that in the latter case we only need to step down until a level where the next place is equal to pos. Since this cursor and place movement is O(log n), so are all the fundamental random-access-list operations, insert!, remove!, ref and set!

The other supplied operators like map, filter split and join work only at a fixed level, whence are ordinary linked list operators, which perform as O(n).

Some additional remarks are in order.

We described the process with a width of two, i.e. increasing the level of movement doubles the jumps of next nodes in the average. A higher value than two for the width is possible as well, trading performance against space.

We said nothing about the maximal length of the nodes, i.e. of the maximal height of the random-access-list. Our default is 10, but this can be changed in the constructor. This should be appropriate in most cases. But note, that the highest actual, i.e. computed, node height might be smaller, so it must be updated in the list, so that the cursor knows where to start.

Documentation

In this implementation random-access-lists are implemented in the Design by Contract style, i.e. using the dbc module. A corollary of this is, that the documentation is included in one of the two modules in form of a procedure with the module's name. Apart from this documentation procedure the two modules, %random-access-lists and random-access-lists, have the same interface. The first module contains the raw implementations of the procedures, the second imports the first with prefix % and wraps those prefixed routines with contracts.

random-access-lists

(random-access-lists [symbol|string])procedure

returns all available routines of the module when called without an argument. When called with one of these routines as a symbol, returns its contract. When called with a string, writes a file with name of string containing rudimentary wiki documentation.

make-ral

make-ral item? #!rest argsprocedure

function (result)
requires (and ((list-of? (lambda (arg) (and (fixnum? arg) (fx> arg 1)))) args)
              (procedure? item?) "(item? item)")
ensures  (ral? result)

ral->list

ral->list lsprocedure

ral->list ls levelprocedure

function (result)
requires (and (ral? ls) (fixnum? level)
              (fx<= 0 level) (fx< level (ral-height ls)))
         ; default (fx= level 0)
ensures  ((list-of? (ral-item? ls)) result)

ral-add!

ral-add! ls item #!rest itemsprocedure

command ((oldcount newcount (lambda (ls item . items) (ral-count ls))))
requires (and (ral? ls) ((ral-item? ls) item)
              ((list-of? (ral-item? ls)) items))
ensures  (fx= newcount (fx+ (length (cons item items)) oldcount))

ral-add-left!

ral-add-left! ls item #!rest itemsprocedure

command ((oldcount newcount (lambda (ls item . items) (ral-count ls))))
requires (and (ral? ls) ((ral-item? ls) item)
              ((list-of? (ral-item? ls)) items))
ensures  (fx= newcount (fx+ (length (cons item items)) oldcount))

ral-clear!

ral-clear! lsprocedure

command ((oldcount newcount ral-count) (oldheight newheight ral-height))
requires (ral? ls)
ensures  (and (fx= 0 newcount) (fx= 1 newheight))

ral-count

ral-count lsprocedure

function (result)
requires (ral? ls)
ensures  (and (fixnum? result) (fx>= result 0))

ral-cursor-jump

ral-cursor-jump ls kprocedure

function (result)
requires (and (ral? ls) (fixnum? k)
              (fx>= k 0) (fx< k (ral-height ls)))
ensures  (and (fixnum? result)
              (fx> result 0) (fx<= result (ral-count ls)))

ral-cursor-next

ral-cursor-next ls kprocedure

function (result)
requires (and (ral? ls) (fixnum? k)
              (fx>= k 0) (fx< k (ral-height ls)))
ensures  (or (null? result) (ral-node? result))

ral-eq?

ral-eq? ls0 ls1procedure

function (result)
requires (and (ral? ls0) (ral? ls1))
ensures  (boolean? result)

ral-eql?

ral-eql? eql? ls0 ls1procedure

function (result)
requires (and (procedure? eql?) "(eql? item0 item1)"
              (ral? ls0) (ral? ls1))
ensures  (boolean? result)

ral-equal?

ral-equal? ls0 ls1procedure

function (result)
requires (and (ral? ls0) (ral? ls1))
ensures  (boolean? result)

ral-eqv?

ral-eqv? ls0 ls1procedure

function (result)
requires (and (ral? ls0) (ral? ls1))
ensures  (boolean? result)

ral-filter

ral-filter ls ok?procedure

function (result)
requires (and (ral? ls) (procedure? ok?) "(ok? item)")
ensures  (and (ral? result)
              (fx<= (ral-count result) (ral-count ls)))

ral-for-each

ral-for-each ls procprocedure

command ((old new (constantly #t)))
requires (and (ral? ls) (procedure? proc) "(proc item)")
ensures  new

ral-from-upto

ral-from-upto ls from uptoprocedure

function (result)
requires (and (ral? ls) (fixnum? from) (fixnum? upto)
              (fx>= from 0) (fx>= upto from)
              (fx<= upto (ral-count ls)))
ensures  (and (ral? result)
              (fx= (ral-count result) (fx- upto from)))

ral-height

ral-height lsprocedure

function (result)
requires (ral? ls)
ensures  (and (fixnum? result) (fx> result 0))

ral-insert!

ral-insert! ls place itemprocedure

command ((oldcount newcount (lambda (ls place item) (ral-count ls)))
         (olditem newitem (lambda (ls place item) (ral-ref ls place))))
requires (and (ral? ls) ((ral-item? ls) item)
              (fixnum? place) (fx>= place 0) (fx<= place (ral-count ls)))
ensures  (and (fx= newcount (fx+ 1 oldcount)) (equal? newitem item))

ral-item?

ral-item? lsprocedure

function (result)
requires (ral? ls)
ensures  (procedure? result)

ral-join

ral-join head tailprocedure

function (result)
requires (and (ral? head) (ral? tail)
              (eq? (ral-item? head) (ral-item? tail)))
ensures  (and (ral? result)
              (fx= (ral-count result)
                   (fx+ (ral-count head) (ral-count tail))))

ral-level

ral-level lsprocedure

function (result)
requires (ral? ls)
ensures  (and (fixnum? result) (fx> result 0)
              (fx< result (ral-height ls)))

ral-map

ral-map ls fnprocedure

ral-map ls fn item?procedure

function (result)
requires (and (ral? ls) (procedure? fn) "(fn item)"
              (procedure? item?) "(item? item)")
         ; default (eq? item? ral-item?)
ensures  (and (ral? result) (fx= (ral-count result) (ral-count ls))
              (eq? item? (ral-item? result)))

ral-max-height

ral-max-height lsprocedure

function (result)
requires (ral? ls)
ensures  (and (fixnum? result) (fx> result 0))

ral-node?

ral-node? xprprocedure

function (result)
requires #t
ensures  (boolean? result)

ral-null?

ral-null? lsprocedure

function (result)
requires (ral? ls)
ensures  (boolean? result)

ral-place

ral-place ls kprocedure

function (result)
requires (and (ral? ls) (fixnum? k)
              (fx>= k 0) (fx< k (ral-height ls)))
ensures  (and (fixnum? result) (fx>= result -1)
              (fx< result (ral-count ls)))

ral-place-next

ral-place-next ls kprocedure

function (result)
requires (and (ral? ls) (fixnum? k)
              (fx>= k 0) (fx< k (ral-height ls)))
ensures  (and (fixnum? result) (fx>= result 0)
              (fx<= result (ral-count ls)))

ral-print

ral-print lsprocedure

command ((old new (constantly #t)))
requires (ral? ls)
ensures  new

ral-ref

ral-ref ls placeprocedure

function (result)
requires (and (ral? ls) (fixnum? place)
              (fx>= place 0) (fx< place (ral-count ls)))
ensures  ((ral-item? ls) result)

ral-remove!

ral-remove! ls placeprocedure

command ((oldcount newcount (lambda (ls place) (ral-count ls))))
requires (ral? ls)
ensures  (and (fx= newcount (fx- oldcount 1)))

ral-restructure

ral-restructure ls widthprocedure

ral-restructure ls width max-heightprocedure

function (result)
requires (and (ral? ls) (fixnum? width)
              (fx> width 1) (fixnum? max-height) (fx> max-height 1))
         ; default (fx= max-height (ral-max-height ls))
ensures  (and (ral? result) (fx= (ral-count ls) (ral-count result))
              (fx= (ral-width result) width)
              (fx= (ral-max-height result) max-height))

ral-set!

ral-set! ls place itemprocedure

command ((old new (lambda (ls place item) (ral-ref ls place))))
requires (and (ral? ls) ((ral-item? ls) item)
              (fixnum? place) (fx>= place 0)
              (fx< place (ral-count ls)))
ensures  (equal? new item)

ral-split

ral-split ls placeprocedure

function (head tail)
requires (and (ral? ls) (fixnum? place)
              (fx>= place 0) (fx< place (ral-count ls)))
ensures  (and (ral? head) (ral? tail)
              (fx= (ral-count head) place)
              (fx= (ral-count tail) (fx- (ral-count ls) place)))

ral-start

ral-start lsprocedure

function (result)
requires (ral? ls)
ensures  (ral-node? result)

ral-width

ral-width lsprocedure

function (result)
requires (ral? ls)
ensures  (and (fixnum? result) (fx> result 1))

ral?

ral? xprprocedure

function (result)
requires #t
ensures  (boolean? result)

Examples

;an empty ral of integers
(define ls (make-ral integer?))
(ral? ls)
(ral-null? ls)
(fx= (ral-height ls) 1)

;populate it at the right end
(ral-add! ls 0 1 2 3 4)
(fx= (ral-count ls) 5)
(equal? (ral->list ls) '(0 1 2 3 4))

;remove some items
(ral-remove! ls 2)
(fx= (ral-count ls) 4)
(equal? (ral->list ls) '(0 1 3 4))
(ral-remove! ls (fx- (ral-count ls) 1))
(fx= (ral-count ls) 3)
(equal? (ral->list ls) '(0 1 3))
(ral-remove! ls 0)
(fx= (ral-count ls) 2)
(equal? (ral->list ls) '(1 3))

;insert an item
(ral-insert! ls 1 2)
(fx= (ral-ref ls 1) 2)
(fx= (ral-count ls) 3)
(equal? (ral->list ls) '(1 2 3))

;reset ral
(ral-clear! ls)
(ral-null? ls)

;populate ral again
(do ((k 0 (fx+ 1 k)))
  ((fx= k 100))
  (ral-add! ls k))
(fx= (ral-count ls) 100)

;split, join and subral
(ral-eql? fx=
          ls
          (receive (head tail) (ral-split ls 50)
            (ral-join head tail)))
(equal?
  (ral->list (ral-from-upto ls 20 70))
  (let loop ((k 69) (result '()))
    (if (fx= k 19)
      result
      (loop (fx- k 1) (cons k result)))))

;inspect and change an item in the middle
(fx= (ral-ref ls 50) 50)
(ral-set! ls 50 500)
(fx= (ral-ref ls 50) 500)

;change item back again
(ral-set! ls 50 50)
(fx= (ral-ref ls 50) 50)

;change items at the ends and back again
(ral-set! ls 0 1000)
(fx= (ral-ref ls 0) 1000)
(ral-set! ls 0 0)
(fx= (ral-ref ls 0) 0)
(ral-set! ls 99 1000)
(fx= (ral-ref ls 99) 1000)
(ral-set! ls 99 99)
(fx= (ral-ref ls 99) 99)

;insert at left end
(ral-add-left! ls -1 -2 -3)
(fx= (ral-ref ls 0) -3)
(fx= (ral-ref ls 1) -2)
(fx= (ral-ref ls 2) -1)

;remove them again
(ral-remove! ls 0)
(ral-remove! ls 0)
(ral-remove! ls 0)
(fx= (ral-ref ls 0) 0)
(fx= (ral-count ls) 100)

;insert at right end and remove it again
(ral-add! ls 100 101)
(fx= (ral-ref ls (fx- (ral-count ls) 1)) 101)
(ral-remove! ls (fx- (ral-count ls) 1))
(ral-remove! ls (fx- (ral-count ls) 1))
(fx= (ral-ref ls (fx- (ral-count ls) 1)) 99)

;insert in the middle and remove it again
(ral-insert! ls 20 200)
(fx= (ral-ref ls 20) 200)
(fx= (ral-ref ls 21) 20)
(fx= (ral-count ls) 101)
(ral-remove! ls 20)
(fx= (ral-ref ls 20) 20)
(fx= (ral-count ls) 100)

;restructure
(define lsr (ral-restructure ls 4 20))
(ral-eql? fx= ls lsr)
(fx= (ral-width lsr) 4)
(fx= (ral-max-height lsr) 20)

;map and filter
(equal? (ral->list (ral-map ls add1))
        (let loop ((k 100) (result '()))
          (if (fx= k 0)
            result
            (loop (fx- k 1) (cons k result)))))
(equal? (ral->list (ral-filter ls odd?))
        (let loop ((k 99) (result '()))
          (if (fx< k 0)
            result
            (loop (fx- k 2) (cons k result)))))

Requirements

dbc

Last update

Nov 27, 2013

Author

Juergen Lorenz

License

Copyright (c) 2012-2013, Juergen Lorenz
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
Neither the name of the author nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission. 
  
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Version History

0.1.2

tests updated

0.1.1

tests updated

0.1

initial import