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.

Skiplists

Skiplists are data-types, which can replace balanced search-trees. They are invented by Pugh. The idea is as follows:

Contrary to listnodes, which are pairs of an item and a next pointer, skipnodes are pairs of an item and a vector of next pointers. The length' of these vectors depend on each skipnode itself. They are choosen randomly in such a way, that, in the average, the number of nodes with at least k links is half the number of links with at least k-1 links, for k>1. Following the next pointers at a fixed link-level, k say, one skips all nodes with less than k pointers.

Inserting an item into a skiplist now works as follows. First one packages the item into a skipnode, where the number of links is generated randomly as described above. Second, one follows the skiplist along the highest occupied number of links as long as the skiplist's nodes point to items less then the item of the node to be inserted. Third, one steps down one level and continues following the skiplist's nodes at this new smaller level. Repeating this process until level 0 is reached we eventually find the place where our new node is to be inserted.

Some additional remarks are in order.

We described the process with a width of two, i.e. at each level in the average one node of the level below is skipped. A higher value than two for the width is possible as well, trading performance against space.

We have to decide, what to do with duplicates. We choose the following approach: The skiplist itself stores a list of either one or several numerical comparison operators. Only if the last of those operators is the special comparison operator dups (which returns constantly 0, i.e. it compares nothing) duplicates are allowed. Moreover, we arrage matters in such a way, that all nodes of duplicates with the same key have the same height, so that a search for the item which was inserted last will be found first.

Documentation

In this implementation skiplists 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, %skiplists and skiplists, 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.

skiplists

[procedure] (skiplists [symbol|string])

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.

dups

[procedure] (dups x y)

trivial numerical comparison operator to allow for duplicates

function (result)
requires (and ((skiplist-item? sls) x) ((skiplist-item? sls) y))
ensures  (fx= result 0)

skiplist

[procedure] (skiplist width max-height item? order . orders)
[procedure] (skiplist max-height item? order . orders)
[procedure] (skiplist item? order . orders))

function (result)
requires (and (fixnum? width)
              (fx> width 1) ; default (fx= width 2)
              (fixnum? max-height) ; default (fx= max-height 10)
              (fx> max-height 1)
              (procedure? item?)
              (item? item)
              (procedure? order)
              "(fixnum? (order item? item?))"
              ((list-of? procedure?) orders)
              " like order, last one might be dups")
ensures  (skiplist? result)

skiplist->list

[procedure] (skiplist->list sls)
[procedure] (skiplist->list sls level)

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

skiplist-clear!

[procedure] (skiplist-clear! sls)

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

skiplist-compare

[procedure] (skiplist-compare sls)

function (result)
requires (skiplist? sls)
ensures  (and (procedure? result) "(fixnum? (result x y))")

skiplist-count

[procedure] (skiplist-count sls)

function (result)
requires (skiplist? sls)
ensures  (and (fixnum? result) (fx>= result 0))

skiplist-dups?

[procedure] (skiplist-dups? sls)

function (result)
requires (skiplist? sls)
ensures  (boolean? result)

skiplist-filter

[procedure] (skiplist-filter sls ok?)

function (result)
requires (and (skiplist? sls) (procedure? ok?) "(boolean? (ok? x))")
ensures  (skiplist? result)

skiplist-for-each

[procedure] (skiplist-for-each sls proc)

command ((old new (constantly #t)))
requires (and (skiplist? sls) (procedure? proc))
ensures  new

skiplist-found

[procedure] (skiplist-found sls)

function (result)
requires (skiplist? sls)
ensures  ((list-of? (skiplist-item? sls)) result)

skiplist-found?

[procedure] (skiplist-found? sls item)

function (result)
requires (and (skiplist? sls) ((skiplist-item? sls) item))
ensures  (boolean? result)

skiplist-height

[procedure] (skiplist-height sls)

function (result)
requires (skiplist? sls)
ensures  (and (fixnum? result) (fx> result 0))

skiplist-insert!

[procedure] (skiplist-insert! sls item . items)

command ((oldcount newcount (lambda (sls . items) (skiplist-count sls)))
         (oldfound newfound (lambda (sls . items)
                              (skiplist-search! sls (car items))
                              (skiplist-found sls))))
requires (and (skiplist? sls)
              ((list-of? (skiplist-item? sls)) (cons item items)))
ensures  (and (fx>= newcount oldcount) (member item newfound))

skiplist-item?

[procedure] (skiplist-item? sls)

function (result)
requires (skiplist? sls)
ensures  (procedure? result)

skiplist-map

[procedure] (skiplist-map sls fn)
[procedure] (skiplist-map sls fn order . orders)
[procedure] (skiplist-map sls fn width)
[procedure] (skiplist-map sls fn width order . orders)

function (result)
requires (and (skiplist? sls)
              (procedure? fn)
              "((skiplist-item? sls) (fn x))")
ensures  (skiplist? result)

(skiplist-map sls fn item? order . orders)
requires (and (skiplist? sls)
              (procedure? fn)
              (procedure? item?)
              (((list-of? procedure?) (cons order orders))))
ensures  (skiplist? result)

skiplist-max

[procedure] (skiplist-max sls)

function (result)
requires (skiplist? sls)
ensures  ((list-of? (skiplist-item? sls)) result)

skiplist-max-height

[procedure] (skiplist-max-height sls)

function (result)
requires (skiplist? sls)
ensures  (and (fixnum? result) (fx> result 1))

skiplist-min

[procedure] (skiplist-min sls)

function (result)
requires (skiplist? sls)
ensures  ((list-of? (skiplist-item? sls)) result)

skiplist-null?

[procedure] (skiplist-null? sls)

function (result)
requires (skiplist? sls)
ensures  (boolean? result)

skiplist-orders

[procedure] (skiplist-orders sls)

function (result)
requires (skiplist? sls)
ensures  ((list-of? procedure?) result)

skiplist-remove!

[procedure] (skiplist-remove! sls item . items)

command ((oldcount newcount (lambda (sls . items)
                              (skiplist-count sls))))
requires (and (skiplist? sls)
              ((list-of? (skiplist-item? sls)) (cons item items)))
ensures  (fx<= newcount oldcount)

skiplist-reorder

[procedure] (skiplist-reorder sls order . orders)

function (result)
requires (and (skiplist? sls)
              ((list-of? procedure?) (cons order orders))
              "each (fixnum? (order x y))")
ensures  (skiplist? result)

skiplist-restructure

[procedure] (skiplist-restructure sls width max-height)

function (result)
requires (and (skiplist? sls) (fixnum? width) (fx> width 1)
              (fixnum? max-height) (fx> max-height 1))
ensures  (skiplist? result)

skiplist-search!

[procedure] (skiplist-search! sls item)

command ((oldlevel newlevel (lambda (sls item)
                              (skiplist-search-level sls)))
         (oldfound newfound (lambda (sls item) (skiplist-found sls))))
requires (and (skiplist? sls)
              ((skiplist-item? sls) item))
ensures  (and (fx>= newlevel 0)
              (fx< newlevel (skiplist-height sls))
              ((list-of? (skiplist-item? sls)) newfound)
              ((list-of? zero?)
               (map (lambda (x) ((skiplist-compare sls) item x))
                    newfound)))

skiplist-search-level

[procedure] (skiplist-search-level sls)

function (result)
requires (skiplist? sls)
ensures  (and (fixnum? result) (fx>= result 0) (fx< result (skiplist-height sls)))

skiplist-width

[procedure] (skiplist-width sls)

function (result)
requires (skiplist? sls)
ensures  (and (fixnum? result) (fx> result 1))

skiplist?

[procedure] (skiplist? xpr)

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

Examples

A skiplist with primary and secondary search order, allowing duplicates


;; some constructors

  (define sls1 (skiplist 15 fixnum? -))
  (fx= (skiplist-width sls1) 2)
  (fx= (skiplist-max-height sls1) 15)
  (not (skiplist-dups? sls1))

  (define sls2 (skiplist 4 20 fixnum? - dups))
  (fx= (skiplist-width sls2) 4)
  (fx= (skiplist-max-height sls2) 20)
  (skiplist-dups? sls2)

;; create ...

  (define item-type (lambda (x)
                      (and ((list-of? integer?) x) (> (length x) 2))))

  (define primary-order (lambda (x y) (- (car x) (car y))))

  (define secondary-order (lambda (x y) (- (cadr x) (cadr y))))

  (define sls3 (skiplist 3
                         15
                         item-type
                         primary-order
                         secondary-order
                         dups))

;; and populate ...

  (define lst1
          (let loop ((k 0) (lst '()))
            (if (= k 100)
              lst
              (loop (+ k 1) (cons (random 10) lst)))))

  (define lst2
          (let loop ((k 0) (lst '()))
            (if (= k 100)
              lst
              (loop (+ k 1) (cons (random 10) lst)))))

  (define lst3
          (let loop ((k 0) (lst '()))
            (if (= k 100)
              lst
              (loop (+ k 1) (cons (random 100) lst)))))

  (apply skiplist-insert! sls3
         (map (lambda (x y z) (list x y z))
              lst1 lst2 lst3)) 

  (= (skiplist-count sls3) 100)

  (= (skiplist-width sls3) 3)

;; inserting item and removing all with same key ...

  ((skiplist-item? sls3) '(1 2 3))

  (skiplist-search! sls3 '(1 2 3))

  (if (skiplist-found? sls3 '(1 2 3))
    (apply skiplist-remove! sls3 (skiplist-found sls3)))

  (skiplist-insert! sls3 '(1 2 3))

  (skiplist-search! sls3 '(1 2 3))

  (member '(1 2 3) (skiplist-found sls3))

  (apply skiplist-remove! sls3 (skiplist-found sls3))

  (skiplist-search! sls3 '(1 2 3))

  (null? (skiplist-found sls3))

;; produce duplicates at the ends ...

  (skiplist-insert! sls3 '(-1 2 3) '(-1 2 3 4)) 

  (equal? (skiplist-min sls3) '((-1 2 3 4) (-1 2 3)))

  (skiplist-insert! sls3 '(10 1 2) '(10 1 2 3) '(10 1 3))

  (equal? (skiplist-found sls3) '((10 1 3) (10 1 2 3) (10 1 2)))

  (equal? (skiplist-max sls3) '((10 1 3) (10 1 2 3) (10 1 2)))

;; and remove them again ...

  (skiplist-search! sls3 '(-1 2 3 4))

  (apply skiplist-remove! sls3 (skiplist-found sls3))

  (skiplist-search! sls3 '(-1 2 3 4))

  (null? (skiplist-found sls3))

  (skiplist-search! sls3 '(10 1 3))

  (apply skiplist-remove! sls3 (skiplist-found sls3))

  (null? (skiplist-found sls3))

;; reorder removing all dups ...

  (apply <= (map car
                 (skiplist->list
                   (skiplist-reorder sls3 primary-order secondary-order))))

  (<= (skiplist-count (skiplist-reorder sls3 primary-order secondary-order))
      (skiplist-count sls3))

;; reorder using only secondary order ...

  (apply < (map cadr
                (skiplist->list
                  (skiplist-reorder sls3 secondary-order))))

  (>= 10 (skiplist-count
           (skiplist-reorder sls3 secondary-order)))

;; restructure ...

  (equal? (skiplist->list sls3)
          (skiplist->list (skiplist-restructure sls3 2 10)))

;; filter ...

  ((list-of? odd?) (map caddr
                        (skiplist->list
                          (skiplist-filter sls3 (lambda (x) (odd? (caddr x)))))))

;; map ...

  (let ((fn (lambda (x) (* 2 x))))
    (equal?
      (map fn (skiplist->list sls3))
      (skiplist->list (skiplist-map sls3 fn))))

Copyright (c) 2012-2017, 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

1.1.5: add missing skiplist-max-height
1.1.4: bug in contract of skiplist-map fixed
1.1.3: tests updated
1.1.2: tests updated
1.1: skiplist-max-height added, constructor now accepts max-height argument (default is 10), width argument may be omitted (defaults to 2)
1.0: complete rewrite, dependency changed to dbc, prefixes changed to skiplist, only one constructor remained
0.7: dependency on records removed, define-record-type and define-record-printer used instead
0.6: code restructured into two modules
0.4: assert call corrected
0.3: added skip-orders, skip-reorder, skip-filter
0.2: skip-map removed, skip-insert!, skip-remove! and skip-remove-all! now accept multiple item arguments
0.1: initial import