# source:project/wiki/eggref/4/skiplists@30431

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

docu of skiplists updated

File size: 17.3 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
69function (result)
70
71trivial numerical comparison operator to allow for duplicates
72
73<enscript highlight=scheme>
74
75(_ x y)
76requires (and ((skiplist-item? sls) x) ((skiplist-item? sls) y))
77ensures  (fx= result 0)
78
79</enscript>
80
81==== skiplist
82
83<procedure>(skiplist width max-height item? order . orders)</procedure>
84<procedure>(skiplist max-height item? order . orders)</procedure>
85<procedure>(skiplist item? order . orders))</procedure>
86
87function (result)
88
89<enscript highlight=scheme>
90
91(_ width max-height item? order . orders)
92requires (and (fixnum? width)
93              (fx> width 1)
94              (fixnum? max-height)
95              (fx> max-height 1)
96              (procedure? item?)
97              (item? item)
98              (procedure? order)
99              "(fixnum? (order item? item?))"
100              ((list-of? procedure?) orders)
101              " like order, last one might be dups")
102ensures  (%skiplist? result)
103
104(_ max-height item? order . orders)
105"width defaults to 2"
106requires (and (fixnum? max-height)
107              (fx> max-height 1)
108              (procedure? item?)
109              (item? item)
110              (procedure? order)
111              "(fixnum? (order item? item?))"
112              ((list-of? procedure?) orders)
113              " like order, last one might be dups")
114ensures  (%skiplist? result)
115
116(_ item? order . orders)
117"width defaults to 2, max-height to 10"
118requires (and (procedure? item?)
119              (item? item)
120              (procedure? order)
121              "(fixnum? (order item? item?))"
122              ((list-of? procedure?) orders)
123              " like order, last one might be dups")
124ensures  (%skiplist? result)
125
126</enscript>
127
128==== skiplist->list
129
130<procedure>(or (skiplist->list sls) (skiplist->list sls level))</procedure>
131
132function (result)
133
134<enscript highlight=scheme>
135
136(_ sls)
137requires (%skiplist? sls)
138ensures  ((list-of? (%skiplist-item? sls)) result)
139
140(_ sls level)
141requires (and (%skiplist? sls)
142              (fixnum? level)
143              (fx<= 0 level)
144              (fx< level (%skiplist-height sls)))
145ensures  ((list-of? (%skiplist-item? sls)) result)
146
147</enscript>
148
149==== skiplist-clear!
150
151<procedure>(skiplist-clear! sls)</procedure>
152
153command ((oldcount newcount %skiplist-count) (oldheight newheight %skiplist-height))
154
155<enscript highlight=scheme>
156
157(_ sls)
158requires (%skiplist? sls)
159ensures  (and (fx= 0 newcount) (fx= 1 newheight))
160
161</enscript>
162
163==== skiplist-compare
164
165<procedure>(skiplist-compare sls)</procedure>
166
167function (result)
168
169<enscript highlight=scheme>
170
171(_ sls)
172requires (%skiplist? sls)
173ensures  (and (procedure? result) "(fixnum? (result x y))")
174
175</enscript>
176
177==== skiplist-count
178
179<procedure>(skiplist-count sls)</procedure>
180
181function (result)
182
183<enscript highlight=scheme>
184
185(_ sls)
186requires (%skiplist? sls)
187ensures  (and (fixnum? result) (fx>= result 0))
188
189</enscript>
190
191==== skiplist-dups?
192
193<procedure>(skiplist-dups? sls)</procedure>
194
195function (result)
196
197<enscript highlight=scheme>
198
199(_ sls)
200requires (%skiplist? sls)
201ensures  (boolean? result)
202
203</enscript>
204
205==== skiplist-filter
206
207<procedure>(skiplist-filter sls ok?)</procedure>
208
209function (result)
210
211<enscript highlight=scheme>
212
213(_ sls ok?)
214requires (and (%skiplist? sls) (procedure? ok?) "(boolean? (ok? x))")
215ensures  (%skiplist? result)
216
217</enscript>
218
219==== skiplist-for-each
220
221<procedure>(skiplist-for-each sls proc)</procedure>
222
223command ((old new (constantly #t)))
224
225<enscript highlight=scheme>
226
227(_ sls proc)
228requires (and (%skiplist? sls) (procedure? proc))
229ensures  new
230
231</enscript>
232
233==== skiplist-found
234
235<procedure>(skiplist-found sls)</procedure>
236
237function (result)
238
239<enscript highlight=scheme>
240
241(_ sls)
242requires (%skiplist? sls)
243ensures  ((list-of? (%skiplist-item? sls)) result)
244
245</enscript>
246
247==== skiplist-found?
248
249<procedure>(skiplist-found? sls item)</procedure>
250
251function (result)
252
253<enscript highlight=scheme>
254
255(_ sls item)
256requires (and (%skiplist? sls) ((%skiplist-item? sls) item))
257ensures  (boolean? result)
258
259</enscript>
260
261==== skiplist-height
262
263<procedure>(skiplist-height sls)</procedure>
264
265function (result)
266
267<enscript highlight=scheme>
268
269(_ sls)
270requires (%skiplist? sls)
271ensures  (and (fixnum? result) (fx> result 0))
272
273</enscript>
274
275==== skiplist-insert!
276
277<procedure>(skiplist-insert! sls item . items)</procedure>
278
279command ((oldcount newcount (lambda (sls . items) (%skiplist-count sls)))
280         (oldfound newfound (lambda (sls . items)
281                              (%skiplist-search! sls (car items))
282                              (%skiplist-found sls))))
283
284<enscript highlight=scheme>
285
286(_ sls item . items)
287requires (and (%skiplist? sls)
288              ((list-of? (%skiplist-item? sls)) (cons item items)))
289ensures  (and (fx>= newcount oldcount) (member item newfound))
290
291</enscript>
292
293==== skiplist-item?
294
295<procedure>(skiplist-item? sls)</procedure>
296
297function (result)
298
299<enscript highlight=scheme>
300
301(_ sls)
302requires (%skiplist? sls)
303ensures  (procedure? result)
304
305</enscript>
306
307==== skiplist-map
308
309<procedure>(or (skiplist-map sls fn)
310               (skiplist-map sls fn order . orders)
311               (skiplist-map sls fn width)
312               (skiplist-map sls fn width order . orders))
313</procedure>
314
315function (result)
316
317<enscript highlight=scheme>
318
319(_ sls fn)
320requires (and (%skiplist? sls)
321              (procedure? fn)
322              "((skiplist-item? sls) (fn x))")
323ensures  (%skiplist? result)
324
325(_ sls fn item? order . orders)
326requires (and (%skiplist? sls)
327              (procedure? fn)
328              (procedure? item?)
329              (((list-of? procedure?) (cons order orders))))
330ensures  (%skiplist? result)
331
332</enscript>
333
334==== skiplist-max
335
336<procedure>(skiplist-max sls)</procedure>
337
338function (result)
339
340<enscript highlight=scheme>
341
342(_ sls)
343requires (%skiplist? sls)
344ensures  ((list-of? (%skiplist-item? sls)) result)
345
346</enscript>
347
348==== skiplist-max-height
349
350<procedure>(skiplist-max-height sls)</procedure>
351
352function (result)
353
354<enscript highlight=scheme>
355
356(_ sls)
357requires (%skiplist? sls)
358ensures  (and (fixnum? result) (fx> result 1))
359
360</enscript>
361
362==== skiplist-min
363
364<procedure>(skiplist-min sls)</procedure>
365
366function (result)
367
368<enscript highlight=scheme>
369
370(_ sls)
371requires (%skiplist? sls)
372ensures  ((list-of? (%skiplist-item? sls)) result)
373
374</enscript>
375
376==== skiplist-null?
377
378<procedure>(skiplist-null? sls)</procedure>
379
380function (result)
381
382<enscript highlight=scheme>
383
384(_ sls)
385requires (%skiplist? sls)
386ensures  (boolean? result)
387
388</enscript>
389
390==== skiplist-orders
391
392<procedure>(skiplist-orders sls)</procedure>
393
394function (result)
395
396<enscript highlight=scheme>
397
398(_ sls)
399requires (%skiplist? sls)
400ensures  ((list-of? procedure?) result)
401
402</enscript>
403
404==== skiplist-remove!
405
406<procedure>(skiplist-remove! sls item . items)</procedure>
407
408command ((oldcount newcount (lambda (sls . items)
409                              (%skiplist-count sls))))
410
411<enscript highlight=scheme>
412
413(_ sls item . items)
414requires (and (%skiplist? sls)
415              ((list-of? (%skiplist-item? sls)) (cons item items)))
416ensures  (fx<= newcount oldcount)
417
418</enscript>
419
420==== skiplist-reorder
421
422<procedure>(skiplist-reorder sls order . orders)</procedure>
423
424function (result)
425
426<enscript highlight=scheme>
427
428(_ sls order . orders)
429requires (and (%skiplist? sls)
430              ((list-of? procedure?) (cons order orders))
431              "each (fixnum? (order x y))")
432ensures  (%skiplist? result)
433
434</enscript>
435
436==== skiplist-restructure
437
438<procedure>(skiplist-restructure sls width max-height)</procedure>
439
440function (result)
441
442<enscript highlight=scheme>
443
444(_ sls width max-height)
445requires (and (%skiplist? sls) (fixnum? width) (fx> width 1)
446              (fixnum? max-height) (fx> max-height 1))
447ensures  (%skiplist? result)
448
449</enscript>
450
451==== skiplist-search!
452
453<procedure>(skiplist-search! sls item)</procedure>
454
455command ((oldlevel newlevel (lambda (sls item)
456                              (%skiplist-search-level sls)))
457         (oldfound newfound (lambda (sls item) (%skiplist-found sls))))
458
459<enscript highlight=scheme>
460
461(_ sls item)
462requires (and (%skiplist? sls)
463              ((%skiplist-item? sls) item))
464ensures  (and (fx>= newlevel 0)
465              (fx< newlevel (%skiplist-height sls))
466              ((list-of? (%skiplist-item? sls)) newfound)
467              ((list-of? zero?)
468               (map (lambda (x) ((%skiplist-compare sls) item x))
469                    newfound)))
470
471</enscript>
472
473==== skiplist-search-level
474
475<procedure>(skiplist-search-level sls)</procedure>
476
477function (result)
478
479<enscript highlight=scheme>
480
481(_ sls)
482requires (%skiplist? sls)
483ensures  (and (fixnum? result) (fx>= result 0) (fx< result (skiplist-height sls)))
484
485</enscript>
486
487==== skiplist-width
488
489<procedure>(skiplist-width sls)</procedure>
490
491function (result)
492
493<enscript highlight=scheme>
494
495(_ sls)
496requires (%skiplist? sls)
497ensures  (and (fixnum? result) (fx> result 1))
498
499</enscript>
500
501==== skiplist?
502
503<procedure>(skiplist? xpr)</procedure>
504
505function (result)
506
507<enscript highlight=scheme>
508
509(_ xpr)
510requires #t
511ensures  (boolean? result)
512
513</enscript>
514
515=== Examples
516
517A skiplist with primary and secondary search order, allowing duplicates
518
519<enscript highlight=scheme>
520
521;; some constructors
522
523  (define sls1 (skiplist 15 fixnum? -))
524  (fx= (skiplist-width sls1) 2)
525  (fx= (skiplist-max-height sls1) 15)
526  (not (skiplist-dups? sls1))
527
528  (define sls2 (skiplist 4 20 fixnum? - dups))
529  (fx= (skiplist-width sls2) 4)
530  (fx= (skiplist-max-height sls2) 20)
531  (skiplist-dups? sls2)
532
533;; create ...
534
535  (define item-type (lambda (x)
536                      (and ((list-of? integer?) x) (> (length x) 2))))
537
538  (define primary-order (lambda (x y) (- (car x) (car y))))
539
541
542  (define sls3 (skiplist 3
543                         15
544                         item-type
545                         primary-order
546                         secondary-order
547                         dups))
548
549;; and populate ...
550
551  (define lst1
552          (let loop ((k 0) (lst '()))
553            (if (= k 100)
554              lst
555              (loop (+ k 1) (cons (random 10) lst)))))
556
557  (define lst2
558          (let loop ((k 0) (lst '()))
559            (if (= k 100)
560              lst
561              (loop (+ k 1) (cons (random 10) lst)))))
562
563  (define lst3
564          (let loop ((k 0) (lst '()))
565            (if (= k 100)
566              lst
567              (loop (+ k 1) (cons (random 100) lst)))))
568
569  (apply skiplist-insert! sls3
570         (map (lambda (x y z) (list x y z))
571              lst1 lst2 lst3))
572
573  (= (skiplist-count sls3) 100)
574
575  (= (skiplist-width sls3) 3)
576
577;; inserting item and removing all with same key ...
578
579  ((skiplist-item? sls3) '(1 2 3))
580
581  (skiplist-search! sls3 '(1 2 3))
582
583  (if (skiplist-found? sls3 '(1 2 3))
584    (apply skiplist-remove! sls3 (skiplist-found sls3)))
585
586  (skiplist-insert! sls3 '(1 2 3))
587
588  (skiplist-search! sls3 '(1 2 3))
589
590  (member '(1 2 3) (skiplist-found sls3))
591
592  (apply skiplist-remove! sls3 (skiplist-found sls3))
593
594  (skiplist-search! sls3 '(1 2 3))
595
596  (null? (skiplist-found sls3))
597
598;; produce duplicates at the ends ...
599
600  (skiplist-insert! sls3 '(-1 2 3) '(-1 2 3 4))
601
602  (equal? (skiplist-min sls3) '((-1 2 3 4) (-1 2 3)))
603
604  (skiplist-insert! sls3 '(10 1 2) '(10 1 2 3) '(10 1 3))
605
606  (equal? (skiplist-found sls3) '((10 1 3) (10 1 2 3) (10 1 2)))
607
608  (equal? (skiplist-max sls3) '((10 1 3) (10 1 2 3) (10 1 2)))
609
610;; and remove them again ...
611
612  (skiplist-search! sls3 '(-1 2 3 4))
613
614  (apply skiplist-remove! sls3 (skiplist-found sls3))
615
616  (skiplist-search! sls3 '(-1 2 3 4))
617
618  (null? (skiplist-found sls3))
619
620  (skiplist-search! sls3 '(10 1 3))
621
622  (apply skiplist-remove! sls3 (skiplist-found sls3))
623
624  (null? (skiplist-found sls3))
625
626;; reorder removing all dups ...
627
628  (apply <= (map car
629                 (skiplist->list
630                   (skiplist-reorder sls3 primary-order secondary-order))))
631
632  (<= (skiplist-count (skiplist-reorder sls3 primary-order secondary-order))
633      (skiplist-count sls3))
634
635;; reorder using only secondary order ...
636
638                (skiplist->list
639                  (skiplist-reorder sls3 secondary-order))))
640
641  (>= 10 (skiplist-count
642           (skiplist-reorder sls3 secondary-order)))
643
644;; restructure ...
645
646  (equal? (skiplist->list sls3)
647          (skiplist->list (skiplist-restructure sls3 2 10)))
648
649;; filter ...
650
652                        (skiplist->list
653                          (skiplist-filter sls3 (lambda (x) (odd? (caddr x)))))))
654
655;; map ...
656
657  (let ((fn (lambda (x) (* 2 x))))
658    (equal?
659      (map fn (skiplist->list sls3))
660      (skiplist->list (skiplist-map sls3 fn))))
661
662</enscript>
663
664== Requirements
665
666[[dbc]]
667
668== Last update
669
670Feb 06, 2014
671
672== Author
673
674[[/users/juergen-lorenz|Juergen Lorenz]]
675
677
678 Copyright (c) 2012-2014, Juergen Lorenz
680
681 Redistribution and use in source and binary forms, with or without
682 modification, are permitted provided that the following conditions are
683 met:
684
685 Redistributions of source code must retain the above copyright
686 notice, this list of conditions and the following disclaimer.
687
688 Redistributions in binary form must reproduce the above copyright
689 notice, this list of conditions and the following disclaimer in the
690 documentation and/or other materials provided with the distribution.
691 Neither the name of the author nor the names of its contributors may be
692 used to endorse or promote products derived from this software without
693 specific prior written permission.
694
695 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
696 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
697 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
698 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
699 HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
700 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
701 TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
702 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
703 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
704 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
705 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
706
707== Version History
708
709; 1.1.4 : bug in contract of skiplist-map fixed
710; 1.1.3 : tests updated
711; 1.1.2 : tests updated
712; 1.1 : skiplist-max-height added, constructor now accepts max-height argument (default is 10), width argument may be omitted (defaults to 2)
713; 1.0 : complete rewrite, dependency changed to dbc, prefixes changed to skiplist, only one constructor remained
714; 0.7 : dependency on records removed, define-record-type and define-record-printer used instead
715; 0.6 : code restructured into two modules
716; 0.4 : assert call corrected
717; 0.3 : added skip-orders, skip-reorder, skip-filter
718; 0.2 : skip-map removed, skip-insert!, skip-remove! and skip-remove-all! now accept multiple item arguments
719; 0.1 : initial import
Note: See TracBrowser for help on using the repository browser.