source: project/wiki/eggref/4/skiplists @ 31103

Last change on this file since 31103 was 31103, checked in by juergen, 6 years ago

docu of skiplists and random-access-lists improved

File size: 16.1 KB
Line 
1[[tags: egg]]
2[[toc:]]
3
4
5== Skiplists
6
7Skiplists are data-types, which can replace balanced search-trees. They
8are invented by Pugh. The idea is as follows:
9
10Contrary to listnodes, which are pairs of an item and a next pointer,
11skipnodes are pairs of an item and a vector of next pointers. The
12length' of these vectors depend on each skipnode itself. They are
13choosen randomly in such a way, that, in the average, the number of
14nodes with at least k links is half the number of links with at least
15k-1 links, for k>1. Following the next pointers at a fixed link-level,
16k say, one skips all nodes with less than k pointers.
17
18Inserting an item into a skiplist now works as follows.
19First one packages the item into a skipnode, where the number of links
20is generated randomly as described above.
21Second, one follows the skiplist along the highest occupied number of
22links as long as the skiplist's nodes point to items less then the item
23of the node to be inserted.
24Third, one steps down one level and continues following the skiplist's
25nodes at this new smaller level.
26Repeating this process until level 0 is reached we eventually find the
27place where our new node is to be inserted.
28
29Some additional remarks are in order.
30
31We described the process with a width of two, i.e. at each level in the
32average one node of the level below is skipped.  A higher value than two
33for the width is possible as well, trading performance against space.
34
35We have to decide, what to do with duplicates. We choose the following
36approach: The skiplist itself stores a list of either one or several numerical
37comparison operators. Only if the last of those operators is the special
38comparison operator dups (which returns constantly 0, i.e. it compares
39nothing) duplicates are allowed. Moreover, we arrage matters in such a
40way, that all nodes of duplicates with the same key have the same
41height, so that a search for the item which was inserted last will be
42found first.
43
44=== Documentation
45
46In this implementation skiplists are implemented in the Design by
47Contract style, i.e. using the dbc module. A corollary of this is,
48that the documentation is included in one of the two modules in form of
49a procedure with the module's name. Apart from this documentation
50procedure the two modules, %skiplists and skiplists, have the same
51interface.  The first module contains the raw implementations of the
52procedures, the second imports the first with prefix % and wraps those
53prefixed routines with contracts.
54
55==== skiplists
56
57<procedure>(skiplists [symbol|string])</procedure>
58
59returns all available routines of the module when called without an
60argument.
61When called with one of these routines as a symbol, returns its contract.
62When called with a string, writes a file with name of string containing
63rudimentary wiki documentation.
64
65==== dups
66
67<procedure>(dups x y)</procedure>
68
69trivial numerical comparison operator to allow for duplicates
70
71<enscript highlight=scheme>
72function (result)
73requires (and ((skiplist-item? sls) x) ((skiplist-item? sls) y))
74ensures  (fx= result 0)
75</enscript>
76
77==== skiplist
78
79<procedure>(skiplist width max-height item? order . orders)</procedure>
80<procedure>(skiplist max-height item? order . orders)</procedure>
81<procedure>(skiplist item? order . orders))</procedure>
82
83<enscript highlight=scheme>
84function (result)
85requires (and (fixnum? width)
86              (fx> width 1) ; default (fx= width 2)
87              (fixnum? max-height) ; default (fx= max-height 10)
88              (fx> max-height 1)
89              (procedure? item?)
90              (item? item)
91              (procedure? order)
92              "(fixnum? (order item? item?))"
93              ((list-of? procedure?) orders)
94              " like order, last one might be dups")
95ensures  (skiplist? result)
96</enscript>
97
98==== skiplist->list
99
100<procedure>(skiplist->list sls)</procedure>
101<procedure>(skiplist->list sls level)</procedure>
102
103<enscript highlight=scheme>
104requires (and (skiplist? sls)
105              (fixnum? level)
106              (fx<= 0 level) ; default (fx= level 0)
107              (fx< level (skiplist-height sls)))
108ensures  ((list-of? (skiplist-item? sls)) result)
109</enscript>
110
111==== skiplist-clear!
112
113<procedure>(skiplist-clear! sls)</procedure>
114
115<enscript highlight=scheme>
116command ((oldcount newcount skiplist-count) (oldheight newheight skiplist-height))
117requires (skiplist? sls)
118ensures  (and (fx= 0 newcount) (fx= 1 newheight))
119</enscript>
120
121==== skiplist-compare
122
123<procedure>(skiplist-compare sls)</procedure>
124
125<enscript highlight=scheme>
126function (result)
127requires (skiplist? sls)
128ensures  (and (procedure? result) "(fixnum? (result x y))")
129</enscript>
130
131==== skiplist-count
132
133<procedure>(skiplist-count sls)</procedure>
134
135<enscript highlight=scheme>
136function (result)
137requires (skiplist? sls)
138ensures  (and (fixnum? result) (fx>= result 0))
139</enscript>
140
141==== skiplist-dups?
142
143<procedure>(skiplist-dups? sls)</procedure>
144
145<enscript highlight=scheme>
146function (result)
147requires (skiplist? sls)
148ensures  (boolean? result)
149</enscript>
150
151==== skiplist-filter
152
153<procedure>(skiplist-filter sls ok?)</procedure>
154
155<enscript highlight=scheme>
156function (result)
157requires (and (skiplist? sls) (procedure? ok?) "(boolean? (ok? x))")
158ensures  (skiplist? result)
159</enscript>
160
161==== skiplist-for-each
162
163<procedure>(skiplist-for-each sls proc)</procedure>
164
165<enscript highlight=scheme>
166command ((old new (constantly #t)))
167requires (and (skiplist? sls) (procedure? proc))
168ensures  new
169</enscript>
170
171==== skiplist-found
172
173<procedure>(skiplist-found sls)</procedure>
174
175<enscript highlight=scheme>
176function (result)
177requires (skiplist? sls)
178ensures  ((list-of? (skiplist-item? sls)) result)
179</enscript>
180
181==== skiplist-found?
182
183<procedure>(skiplist-found? sls item)</procedure>
184
185<enscript highlight=scheme>
186function (result)
187requires (and (skiplist? sls) ((skiplist-item? sls) item))
188ensures  (boolean? result)
189</enscript>
190
191==== skiplist-height
192
193<procedure>(skiplist-height sls)</procedure>
194
195<enscript highlight=scheme>
196function (result)
197requires (skiplist? sls)
198ensures  (and (fixnum? result) (fx> result 0))
199</enscript>
200
201==== skiplist-insert!
202
203<procedure>(skiplist-insert! sls item . items)</procedure>
204
205<enscript highlight=scheme>
206command ((oldcount newcount (lambda (sls . items) (skiplist-count sls)))
207         (oldfound newfound (lambda (sls . items)
208                              (skiplist-search! sls (car items))
209                              (skiplist-found sls))))
210requires (and (skiplist? sls)
211              ((list-of? (skiplist-item? sls)) (cons item items)))
212ensures  (and (fx>= newcount oldcount) (member item newfound))
213</enscript>
214
215==== skiplist-item?
216
217<procedure>(skiplist-item? sls)</procedure>
218
219<enscript highlight=scheme>
220function (result)
221requires (skiplist? sls)
222ensures  (procedure? result)
223</enscript>
224
225==== skiplist-map
226
227<procedure>(skiplist-map sls fn)</procedure>
228<procedure>(skiplist-map sls fn order . orders)</procedure>
229<procedure>(skiplist-map sls fn width)</procedure>
230<procedure>(skiplist-map sls fn width order . orders)</procedure>
231
232<enscript highlight=scheme>
233function (result)
234requires (and (skiplist? sls)
235              (procedure? fn)
236              "((skiplist-item? sls) (fn x))")
237ensures  (skiplist? result)
238
239(skiplist-map sls fn item? order . orders)
240requires (and (skiplist? sls)
241              (procedure? fn)
242              (procedure? item?)
243              (((list-of? procedure?) (cons order orders))))
244ensures  (skiplist? result)
245</enscript>
246
247==== skiplist-max
248
249<procedure>(skiplist-max sls)</procedure>
250
251<enscript highlight=scheme>
252function (result)
253requires (skiplist? sls)
254ensures  ((list-of? (skiplist-item? sls)) result)
255</enscript>
256
257==== skiplist-max-height
258
259<procedure>(skiplist-max-height sls)</procedure>
260
261<enscript highlight=scheme>
262function (result)
263requires (skiplist? sls)
264ensures  (and (fixnum? result) (fx> result 1))
265</enscript>
266
267==== skiplist-min
268
269<procedure>(skiplist-min sls)</procedure>
270
271<enscript highlight=scheme>
272function (result)
273requires (skiplist? sls)
274ensures  ((list-of? (skiplist-item? sls)) result)
275</enscript>
276
277==== skiplist-null?
278
279<procedure>(skiplist-null? sls)</procedure>
280
281<enscript highlight=scheme>
282function (result)
283requires (skiplist? sls)
284ensures  (boolean? result)
285</enscript>
286
287==== skiplist-orders
288
289<procedure>(skiplist-orders sls)</procedure>
290
291<enscript highlight=scheme>
292function (result)
293requires (skiplist? sls)
294ensures  ((list-of? procedure?) result)
295</enscript>
296
297==== skiplist-remove!
298
299<procedure>(skiplist-remove! sls item . items)</procedure>
300
301<enscript highlight=scheme>
302command ((oldcount newcount (lambda (sls . items)
303                              (skiplist-count sls))))
304requires (and (skiplist? sls)
305              ((list-of? (skiplist-item? sls)) (cons item items)))
306ensures  (fx<= newcount oldcount)
307</enscript>
308
309==== skiplist-reorder
310
311<procedure>(skiplist-reorder sls order . orders)</procedure>
312
313<enscript highlight=scheme>
314function (result)
315requires (and (skiplist? sls)
316              ((list-of? procedure?) (cons order orders))
317              "each (fixnum? (order x y))")
318ensures  (skiplist? result)
319</enscript>
320
321==== skiplist-restructure
322
323<procedure>(skiplist-restructure sls width max-height)</procedure>
324
325<enscript highlight=scheme>
326function (result)
327requires (and (skiplist? sls) (fixnum? width) (fx> width 1)
328              (fixnum? max-height) (fx> max-height 1))
329ensures  (skiplist? result)
330</enscript>
331
332==== skiplist-search!
333
334<procedure>(skiplist-search! sls item)</procedure>
335
336<enscript highlight=scheme>
337command ((oldlevel newlevel (lambda (sls item)
338                              (skiplist-search-level sls)))
339         (oldfound newfound (lambda (sls item) (skiplist-found sls))))
340requires (and (skiplist? sls)
341              ((skiplist-item? sls) item))
342ensures  (and (fx>= newlevel 0)
343              (fx< newlevel (skiplist-height sls))
344              ((list-of? (skiplist-item? sls)) newfound)
345              ((list-of? zero?)
346               (map (lambda (x) ((skiplist-compare sls) item x))
347                    newfound)))
348</enscript>
349
350==== skiplist-search-level
351
352<procedure>(skiplist-search-level sls)</procedure>
353
354<enscript highlight=scheme>
355function (result)
356requires (skiplist? sls)
357ensures  (and (fixnum? result) (fx>= result 0) (fx< result (skiplist-height sls)))
358</enscript>
359
360==== skiplist-width
361
362<procedure>(skiplist-width sls)</procedure>
363
364<enscript highlight=scheme>
365function (result)
366requires (skiplist? sls)
367ensures  (and (fixnum? result) (fx> result 1))
368</enscript>
369
370==== skiplist?
371
372<procedure>(skiplist? xpr)</procedure>
373
374<enscript highlight=scheme>
375function (result)
376requires #t
377ensures  (boolean? result)
378</enscript>
379
380=== Examples
381
382A skiplist with primary and secondary search order, allowing duplicates
383
384<enscript highlight=scheme>
385
386;; some constructors
387
388  (define sls1 (skiplist 15 fixnum? -))
389  (fx= (skiplist-width sls1) 2)
390  (fx= (skiplist-max-height sls1) 15)
391  (not (skiplist-dups? sls1))
392
393  (define sls2 (skiplist 4 20 fixnum? - dups))
394  (fx= (skiplist-width sls2) 4)
395  (fx= (skiplist-max-height sls2) 20)
396  (skiplist-dups? sls2)
397
398;; create ...
399
400  (define item-type (lambda (x)
401                      (and ((list-of? integer?) x) (> (length x) 2))))
402
403  (define primary-order (lambda (x y) (- (car x) (car y))))
404
405  (define secondary-order (lambda (x y) (- (cadr x) (cadr y))))
406
407  (define sls3 (skiplist 3
408                         15
409                         item-type
410                         primary-order
411                         secondary-order
412                         dups))
413
414;; and populate ...
415
416  (define lst1
417          (let loop ((k 0) (lst '()))
418            (if (= k 100)
419              lst
420              (loop (+ k 1) (cons (random 10) lst)))))
421
422  (define lst2
423          (let loop ((k 0) (lst '()))
424            (if (= k 100)
425              lst
426              (loop (+ k 1) (cons (random 10) lst)))))
427
428  (define lst3
429          (let loop ((k 0) (lst '()))
430            (if (= k 100)
431              lst
432              (loop (+ k 1) (cons (random 100) lst)))))
433
434  (apply skiplist-insert! sls3
435         (map (lambda (x y z) (list x y z))
436              lst1 lst2 lst3))
437
438  (= (skiplist-count sls3) 100)
439
440  (= (skiplist-width sls3) 3)
441
442;; inserting item and removing all with same key ...
443
444  ((skiplist-item? sls3) '(1 2 3))
445
446  (skiplist-search! sls3 '(1 2 3))
447
448  (if (skiplist-found? sls3 '(1 2 3))
449    (apply skiplist-remove! sls3 (skiplist-found sls3)))
450
451  (skiplist-insert! sls3 '(1 2 3))
452
453  (skiplist-search! sls3 '(1 2 3))
454
455  (member '(1 2 3) (skiplist-found sls3))
456
457  (apply skiplist-remove! sls3 (skiplist-found sls3))
458
459  (skiplist-search! sls3 '(1 2 3))
460
461  (null? (skiplist-found sls3))
462
463;; produce duplicates at the ends ...
464
465  (skiplist-insert! sls3 '(-1 2 3) '(-1 2 3 4))
466
467  (equal? (skiplist-min sls3) '((-1 2 3 4) (-1 2 3)))
468
469  (skiplist-insert! sls3 '(10 1 2) '(10 1 2 3) '(10 1 3))
470
471  (equal? (skiplist-found sls3) '((10 1 3) (10 1 2 3) (10 1 2)))
472
473  (equal? (skiplist-max sls3) '((10 1 3) (10 1 2 3) (10 1 2)))
474
475;; and remove them again ...
476
477  (skiplist-search! sls3 '(-1 2 3 4))
478
479  (apply skiplist-remove! sls3 (skiplist-found sls3))
480
481  (skiplist-search! sls3 '(-1 2 3 4))
482
483  (null? (skiplist-found sls3))
484
485  (skiplist-search! sls3 '(10 1 3))
486
487  (apply skiplist-remove! sls3 (skiplist-found sls3))
488
489  (null? (skiplist-found sls3))
490
491;; reorder removing all dups ...
492
493  (apply <= (map car
494                 (skiplist->list
495                   (skiplist-reorder sls3 primary-order secondary-order))))
496
497  (<= (skiplist-count (skiplist-reorder sls3 primary-order secondary-order))
498      (skiplist-count sls3))
499
500;; reorder using only secondary order ...
501
502  (apply < (map cadr
503                (skiplist->list
504                  (skiplist-reorder sls3 secondary-order))))
505
506  (>= 10 (skiplist-count
507           (skiplist-reorder sls3 secondary-order)))
508
509;; restructure ...
510
511  (equal? (skiplist->list sls3)
512          (skiplist->list (skiplist-restructure sls3 2 10)))
513
514;; filter ...
515
516  ((list-of? odd?) (map caddr
517                        (skiplist->list
518                          (skiplist-filter sls3 (lambda (x) (odd? (caddr x)))))))
519
520;; map ...
521
522  (let ((fn (lambda (x) (* 2 x))))
523    (equal?
524      (map fn (skiplist->list sls3))
525      (skiplist->list (skiplist-map sls3 fn))))
526
527</enscript>
528
529== Requirements
530
531[[dbc]]
532
533== Last update
534
535Feb 06, 2014
536
537== Author
538
539[[/users/juergen-lorenz|Juergen Lorenz]]
540
541== License
542
543 Copyright (c) 2012-2014, Juergen Lorenz
544 All rights reserved.
545
546 Redistribution and use in source and binary forms, with or without
547 modification, are permitted provided that the following conditions are
548 met:
549 
550 Redistributions of source code must retain the above copyright
551 notice, this list of conditions and the following disclaimer.
552 
553 Redistributions in binary form must reproduce the above copyright
554 notice, this list of conditions and the following disclaimer in the
555 documentation and/or other materials provided with the distribution.
556 Neither the name of the author nor the names of its contributors may be
557 used to endorse or promote products derived from this software without
558 specific prior written permission.
559   
560 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
561 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
562 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
563 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
564 HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
565 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
566 TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
567 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
568 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
569 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
570 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
571
572== Version History
573
574; 1.1.4 : bug in contract of skiplist-map fixed
575; 1.1.3 : tests updated
576; 1.1.2 : tests updated
577; 1.1 : skiplist-max-height added, constructor now accepts max-height argument (default is 10), width argument may be omitted (defaults to 2)
578; 1.0 : complete rewrite, dependency changed to dbc, prefixes changed to skiplist, only one constructor remained
579; 0.7 : dependency on records removed, define-record-type and define-record-printer used instead
580; 0.6 : code restructured into two modules
581; 0.4 : assert call corrected
582; 0.3 : added skip-orders, skip-reorder, skip-filter
583; 0.2 : skip-map removed, skip-insert!, skip-remove! and skip-remove-all! now accept multiple item arguments
584; 0.1 : initial import
Note: See TracBrowser for help on using the repository browser.