source: project/wiki/eggref/4/random-access-lists @ 30140

Last change on this file since 30140 was 30140, checked in by juergen, 7 years ago

treaps, skiplists,random-access-lists,lazy-lists,continuations: tests updated

File size: 17.5 KB
Line 
1[[tags: egg]]
2[[toc:]]
3
4
5== Random-access-lists
6
7Random-access-lists combine the advantages of vectors (fast access) and
8linked-lists (fast insertions). They can be implemented on the basis of
9skiplists.
10
11Whereas an ordinary skiplist-node consists of an item and a vector of
12next nodes, whose length is computed randomly in such a way, that the
13number of nodes with length n are in the average one half of the number
14of nodes with length (- n 1), a random-access-list-node must have an
15additional vector of same length containing the jumps, i.e. numbers
16indicating how far the node is moved when following the next nodes at a
17given level. Following a node at level n describes a fast lane across
18the random-access-list, where the jumps at level n are in the average
19twice as long as the jumps at the level below.
20
21In our implementation of random-access-lists we store a vector of nodes,
22called cursors, and a vector of positions, called places, which are
23updated along the movement accross the list. Moving cursors and places
24to a given position, pos, works as follows: One starts at the highest
25level and follows the next link at that level adding the jump at that
26level to the place at that level until the ladder is less than pos but
27a further movement at that level would be greater or equal pos. Then
28one saves cursor and place and restarts the same movement process at
29the level below, starting with the values saved in the level above.
30Eventually one reaches level 0 and stops at a place one less than pos.
31The stored cursors can than be used to insert or remove an item, as
32well as getting or setting pos' item. Note, that in the latter case we
33only need to step down until a level where the next place is equal to
34pos. Since this cursor and place movement is O(log n), so are all the
35fundamental random-access-list operations, insert!, remove!, ref and set!
36
37The other supplied operators like map, filter split and join work only
38at a fixed level, whence are ordinary linked list operators, which
39perform as O(n).
40
41Some additional remarks are in order.
42
43We described the process with a width of two, i.e. increasing the level
44of movement doubles the jumps of next nodes in the average.  A higher
45value than two for the width is possible as well, trading performance
46against space.
47
48We said nothing about the maximal length of the nodes, i.e. of the
49maximal height of the random-access-list. Our default is 10, but this
50can be changed in the constructor. This should be appropriate in most
51cases. But note, that the highest actual, i.e. computed, node height
52might be smaller, so it must be updated in the list, so that the cursor
53knows where to start.
54
55=== Documentation
56
57In this implementation random-access-lists are implemented in the Design
58by Contract style, i.e. using the dbc module. A corollary of this is,
59that the documentation is included in one of the two modules in form of
60a procedure with the module's name. Apart from this documentation
61procedure the two modules, %random-access-lists and random-access-lists,
62have the same interface.  The first module contains the raw
63implementations of the procedures, the second imports the first with
64prefix % and wraps those prefixed routines with contracts.
65
66==== random-access-lists
67
68<procedure>(random-access-lists [symbol|string])</procedure>
69
70returns all available routines of the module when called without an
71argument.
72When called with one of these routines as a symbol, returns its contract.
73When called with a string, writes a file with name of string containing
74rudimentary wiki documentation.
75
76==== make-ral
77
78<procedure>(make-ral item? . args)</procedure>
79
80function (result)
81
82<enscript highlight=scheme>
83
84(_ item? . args)
85requires (and ((list-of? (lambda (arg) (and (fixnum? arg) (fx> arg 1)))) args)
86              (procedure? item?) "(item? item)")
87ensures  (%ral? result)
88
89</enscript>
90
91==== ral->list
92
93<procedure>(or (ral->list ls) (ral->list ls level))</procedure>
94
95function (result)
96
97<enscript highlight=scheme>
98
99(_ ls)
100requires (%ral? ls)
101ensures  ((list-of? (%ral-item? ls)) result)
102
103(_ ls level)
104requires (and (%ral? ls) (fixnum? level)
105              (fx<= 0 level) (fx< level (%ral-height ls)))
106ensures  ((list-of? (%ral-item? ls)) result)
107
108</enscript>
109
110==== ral-add!
111
112<procedure>(ral-add! ls item . items)</procedure>
113
114command ((oldcount newcount (lambda (ls item . items) (%ral-count ls))))
115
116<enscript highlight=scheme>
117
118(_ ls item . items)
119requires (and (%ral? ls) ((%ral-item? ls) item)
120              ((list-of? (%ral-item? ls)) items))
121ensures  (fx= newcount (fx+ (length (cons item items)) oldcount))
122
123</enscript>
124
125==== ral-add-left!
126
127<procedure>(ral-add-left! ls item . items)</procedure>
128
129command ((oldcount newcount (lambda (ls item . items) (%ral-count ls))))
130
131<enscript highlight=scheme>
132
133(_ ls item . items)
134requires (and (%ral? ls) ((%ral-item? ls) item)
135              ((list-of? (%ral-item? ls)) items))
136ensures  (fx= newcount (fx+ (length (cons item items)) oldcount))
137
138</enscript>
139
140==== ral-clear!
141
142<procedure>(ral-clear! ls)</procedure>
143
144command ((oldcount newcount %ral-count) (oldheight newheight %ral-height))
145
146<enscript highlight=scheme>
147
148(_ ls)
149requires (%ral? ls)
150ensures  (and (fx= 0 newcount) (fx= 1 newheight))
151
152</enscript>
153
154==== ral-count
155
156<procedure>(ral-count ls)</procedure>
157
158function (result)
159
160<enscript highlight=scheme>
161
162(_ ls)
163requires (%ral? ls)
164ensures  (and (fixnum? result) (fx>= result 0))
165
166</enscript>
167
168==== ral-cursor-jump
169
170<procedure>(ral-cursor-jump ls k)</procedure>
171
172function (result)
173
174<enscript highlight=scheme>
175
176(_ ls k)
177requires (and (%ral? ls) (fixnum? k)
178              (fx>= k 0) (fx< k (%ral-height ls)))
179ensures  (and (fixnum? result)
180              (fx> result 0) (fx<= result (%ral-count ls)))
181
182</enscript>
183
184==== ral-cursor-next
185
186<procedure>(ral-cursor-next ls k)</procedure>
187
188function (result)
189
190<enscript highlight=scheme>
191
192(_ ls k)
193requires (and (%ral? ls) (fixnum? k)
194              (fx>= k 0) (fx< k (%ral-height ls)))
195ensures  (or (null? result) (%ral-node? result))
196
197</enscript>
198
199==== ral-eq?
200
201<procedure>(ral-eq? ls0 ls1)</procedure>
202
203function (result)
204
205<enscript highlight=scheme>
206
207(_ ls0 ls1)
208requires (and (%ral? ls0) (%ral? ls1))
209ensures  (boolean? result)
210
211</enscript>
212
213==== ral-eql?
214
215<procedure>(ral-eql? eql? ls0 ls1)</procedure>
216
217function (result)
218
219<enscript highlight=scheme>
220
221(_ eql? ls0 ls1)
222requires (and (procedure? eql?) "(eql? item0 item1)"
223              (%ral? ls0) (%ral? ls1))
224ensures  (boolean? result)
225
226</enscript>
227
228==== ral-equal?
229
230<procedure>(ral-equal? ls0 ls1)</procedure>
231
232function (result)
233
234<enscript highlight=scheme>
235
236(_ ls0 ls1)
237requires (and (%ral? ls0) (%ral? ls1))
238ensures  (boolean? result)
239
240</enscript>
241
242==== ral-eqv?
243
244<procedure>(ral-eqv? ls0 ls1)</procedure>
245
246function (result)
247
248<enscript highlight=scheme>
249
250(_ ls0 ls1)
251requires (and (%ral? ls0) (%ral? ls1))
252ensures  (boolean? result)
253
254</enscript>
255
256==== ral-filter
257
258<procedure>(ral-filter ls ok?)</procedure>
259
260function (result)
261
262<enscript highlight=scheme>
263
264(_ ls ok?)
265requires (and (%ral? ls) (procedure? ok?) "(ok? item)")
266ensures  (and (%ral? result)
267              (fx<= (%ral-count result) (%ral-count ls)))
268
269</enscript>
270
271==== ral-for-each
272
273<procedure>(ral-for-each ls proc)</procedure>
274
275command ((old new (constantly #t)))
276
277<enscript highlight=scheme>
278
279(_ ls proc)
280requires (and (%ral? ls) (procedure? proc) "(proc item)")
281ensures  new
282
283</enscript>
284
285==== ral-from-upto
286
287<procedure>(ral-from-upto ls from upto)</procedure>
288
289function (result)
290
291<enscript highlight=scheme>
292
293(_ ls from upto)
294requires (and (%ral? ls) (fixnum? from) (fixnum? upto)
295              (fx>= from 0) (fx>= upto from)
296              (fx<= upto (%ral-count ls)))
297ensures  (and (%ral? result)
298              (fx= (%ral-count result) (fx- upto from)))
299
300</enscript>
301
302==== ral-height
303
304<procedure>(ral-height ls)</procedure>
305
306function (result)
307
308<enscript highlight=scheme>
309
310(_ ls)
311requires (%ral? ls)
312ensures  (and (fixnum? result) (fx> result 0))
313
314</enscript>
315
316==== ral-insert!
317
318<procedure>(ral-insert! ls place item)</procedure>
319
320command ((oldcount newcount (lambda (ls place item) (%ral-count ls)))
321         (olditem newitem (lambda (ls place item) (%ral-ref ls place))))
322
323<enscript highlight=scheme>
324
325(_ ls place item)
326requires (and (%ral? ls) ((%ral-item? ls) item)
327              (fixnum? place) (fx>= place 0) (fx<= place (%ral-count ls)))
328ensures  (and (fx= newcount (fx+ 1 oldcount)) (equal? newitem item))
329
330</enscript>
331
332==== ral-item?
333
334<procedure>(ral-item? ls)</procedure>
335
336function (result)
337
338<enscript highlight=scheme>
339
340(_ ls)
341requires (%ral? ls)
342ensures  (procedure? result)
343
344</enscript>
345
346==== ral-join
347
348<procedure>(ral-join head tail)</procedure>
349
350function (result)
351
352<enscript highlight=scheme>
353
354(_ head tail)
355requires (and (%ral? head) (%ral? tail)
356              (eq? (%ral-item? head) (%ral-item? tail)))
357ensures  (and (%ral? result)
358              (fx= (%ral-count result)
359                   (fx+ (%ral-count head) (%ral-count tail))))
360
361</enscript>
362
363==== ral-level
364
365<procedure>(ral-level ls)</procedure>
366
367function (result)
368
369<enscript highlight=scheme>
370
371(_ ls)
372requires (%ral? ls)
373ensures  (and (fixnum? result) (fx> result 0)
374              (fx< result (%ral-height ls)))
375
376</enscript>
377
378==== ral-map
379
380<procedure>(or (ral-map ls fn) (ral-map ls fn item?))</procedure>
381
382function (result)
383
384<enscript highlight=scheme>
385
386(_ ls fn)
387requires (and (%ral? ls) (procedure? fn) "(fn item)")
388ensures  (and (%ral? result)
389              (fx= (%ral-count result) (%ral-count ls)))
390
391(_ ls fn item?)
392requires (and (%ral? ls) (procedure? fn) "(fn item)"
393              (procedure? item?) "(item? item)")
394ensures  (and (%ral? result) (fx= (%ral-count result) (%ral-count ls))
395              (eq? item? (%ral-item? result)))
396
397</enscript>
398
399==== ral-max-height
400
401<procedure>(ral-max-height ls)</procedure>
402
403function (result)
404
405<enscript highlight=scheme>
406
407(_ ls)
408requires (%ral? ls)
409ensures  (and (fixnum? result) (fx> result 0))
410
411</enscript>
412
413==== ral-node?
414
415<procedure>(ral-node? xpr)</procedure>
416
417function (result)
418
419<enscript highlight=scheme>
420
421(_ xpr)
422requires #t
423ensures  (boolean? result)
424
425</enscript>
426
427==== ral-null?
428
429<procedure>(ral-null? ls)</procedure>
430
431function (result)
432
433<enscript highlight=scheme>
434
435(_ ls)
436requires (%ral? ls)
437ensures  (boolean? result)
438
439</enscript>
440
441==== ral-place
442
443<procedure>(ral-place ls k)</procedure>
444
445function (result)
446
447<enscript highlight=scheme>
448
449(_ ls k)
450requires (and (%ral? ls) (fixnum? k)
451              (fx>= k 0) (fx< k (%ral-height ls)))
452ensures  (and (fixnum? result) (fx>= result -1)
453              (fx< result (%ral-count ls)))
454
455</enscript>
456
457==== ral-place-next
458
459<procedure>(ral-place-next ls k)</procedure>
460
461function (result)
462
463<enscript highlight=scheme>
464
465(_ ls k)
466requires (and (%ral? ls) (fixnum? k)
467              (fx>= k 0) (fx< k (%ral-height ls)))
468ensures  (and (fixnum? result) (fx>= result 0)
469              (fx<= result (%ral-count ls)))
470
471</enscript>
472
473==== ral-print
474
475<procedure>(ral-print ls)</procedure>
476
477command ((old new (constantly #t)))
478
479<enscript highlight=scheme>
480
481(_ ls)
482requires (%ral? ls)
483ensures  new
484
485</enscript>
486
487==== ral-ref
488
489<procedure>(ral-ref ls place)</procedure>
490
491function (result)
492
493<enscript highlight=scheme>
494
495(_ ls place)
496requires (and (%ral? ls) (fixnum? place)
497              (fx>= place 0) (fx< place (%ral-count ls)))
498ensures  ((%ral-item? ls) result)
499
500</enscript>
501
502==== ral-remove!
503
504<procedure>(ral-remove! ls place)</procedure>
505
506command ((oldcount newcount (lambda (ls place) (%ral-count ls))))
507
508<enscript highlight=scheme>
509
510(_ ls place)
511requires (%ral? ls)
512ensures  (and (fx= newcount (fx- oldcount 1)))
513
514</enscript>
515
516==== ral-restructure
517
518<procedure>(or (ral-restructure ls width)
519               (ral-restructure ls width max-height))</procedure>
520
521function (result)
522
523<enscript highlight=scheme>
524
525(_ ls width)
526requires (and (%ral? ls) (fixnum? width) (fx> width 1))
527ensures  (and (%ral? result)
528              (fx= (%ral-count ls) (%ral-count result))
529              (fx= (%ral-width result) width))
530
531(_ ls width max-height)
532requires (and (%ral? ls) (fixnum? width)
533              (fx> width 1) (fixnum? max-height) (fx> max-height 1))
534ensures  (and (%ral? result) (fx= (%ral-count ls) (%ral-count result))
535              (fx= (%ral-width result) width)
536              (fx= (%ral-max-height result) max-height))
537
538</enscript>
539
540==== ral-set!
541
542<procedure>(ral-set! ls place item)</procedure>
543
544command ((old new (lambda (ls place item) (%ral-ref ls place))))
545
546<enscript highlight=scheme>
547
548(_ ls place item)
549requires (and (%ral? ls) ((%ral-item? ls) item)
550              (fixnum? place) (fx>= place 0)
551              (fx< place (%ral-count ls)))
552ensures  (equal? new item)
553
554</enscript>
555
556==== ral-split
557
558<procedure>(ral-split ls place)</procedure>
559
560function (head tail)
561
562<enscript highlight=scheme>
563
564(_ ls place)
565requires (and (%ral? ls) (fixnum? place)
566              (fx>= place 0) (fx< place (%ral-count ls)))
567ensures  (and (%ral? head) (%ral? tail)
568              (fx= (%ral-count head) place)
569              (fx= (%ral-count tail) (fx- (%ral-count ls) place)))
570
571</enscript>
572
573==== ral-start
574
575<procedure>(ral-start ls)</procedure>
576
577function (result)
578
579<enscript highlight=scheme>
580
581(_ ls)
582requires (%ral? ls)
583ensures  (%ral-node? result)
584
585</enscript>
586
587==== ral-width
588
589<procedure>(ral-width ls)</procedure>
590
591function (result)
592
593<enscript highlight=scheme>
594
595(_ ls)
596requires (%ral? ls)
597ensures  (and (fixnum? result) (fx> result 1))
598
599</enscript>
600
601==== ral?
602
603<procedure>(ral? xpr)</procedure>
604
605function (result)
606
607<enscript highlight=scheme>
608
609(_ xpr)
610requires #t
611ensures  (boolean? result)
612
613</enscript>
614
615=== Examples
616
617<enscript highlight=scheme>
618
619;an empty ral of integers
620(define ls (make-ral integer?))
621(ral? ls)
622(ral-null? ls)
623(fx= (ral-height ls) 1)
624
625;populate it at the right end
626(ral-add! ls 0 1 2 3 4)
627(fx= (ral-count ls) 5)
628(equal? (ral->list ls) '(0 1 2 3 4))
629
630;remove some items
631(ral-remove! ls 2)
632(fx= (ral-count ls) 4)
633(equal? (ral->list ls) '(0 1 3 4))
634(ral-remove! ls (fx- (ral-count ls) 1))
635(fx= (ral-count ls) 3)
636(equal? (ral->list ls) '(0 1 3))
637(ral-remove! ls 0)
638(fx= (ral-count ls) 2)
639(equal? (ral->list ls) '(1 3))
640
641;insert an item
642(ral-insert! ls 1 2)
643(fx= (ral-ref ls 1) 2)
644(fx= (ral-count ls) 3)
645(equal? (ral->list ls) '(1 2 3))
646
647;reset ral
648(ral-clear! ls)
649(ral-null? ls)
650
651;populate ral again
652(do ((k 0 (fx+ 1 k)))
653  ((fx= k 100))
654  (ral-add! ls k))
655(fx= (ral-count ls) 100)
656
657;split, join and subral
658(ral-eql? fx=
659          ls
660          (receive (head tail) (ral-split ls 50)
661            (ral-join head tail)))
662(equal?
663  (ral->list (ral-from-upto ls 20 70))
664  (let loop ((k 69) (result '()))
665    (if (fx= k 19)
666      result
667      (loop (fx- k 1) (cons k result)))))
668
669;inspect and change an item in the middle
670(fx= (ral-ref ls 50) 50)
671(ral-set! ls 50 500)
672(fx= (ral-ref ls 50) 500)
673
674;change item back again
675(ral-set! ls 50 50)
676(fx= (ral-ref ls 50) 50)
677
678;change items at the ends and back again
679(ral-set! ls 0 1000)
680(fx= (ral-ref ls 0) 1000)
681(ral-set! ls 0 0)
682(fx= (ral-ref ls 0) 0)
683(ral-set! ls 99 1000)
684(fx= (ral-ref ls 99) 1000)
685(ral-set! ls 99 99)
686(fx= (ral-ref ls 99) 99)
687
688;insert at left end
689(ral-add-left! ls -1 -2 -3)
690(fx= (ral-ref ls 0) -3)
691(fx= (ral-ref ls 1) -2)
692(fx= (ral-ref ls 2) -1)
693
694;remove them again
695(ral-remove! ls 0)
696(ral-remove! ls 0)
697(ral-remove! ls 0)
698(fx= (ral-ref ls 0) 0)
699(fx= (ral-count ls) 100)
700
701;insert at right end and remove it again
702(ral-add! ls 100 101)
703(fx= (ral-ref ls (fx- (ral-count ls) 1)) 101)
704(ral-remove! ls (fx- (ral-count ls) 1))
705(ral-remove! ls (fx- (ral-count ls) 1))
706(fx= (ral-ref ls (fx- (ral-count ls) 1)) 99)
707
708;insert in the middle and remove it again
709(ral-insert! ls 20 200)
710(fx= (ral-ref ls 20) 200)
711(fx= (ral-ref ls 21) 20)
712(fx= (ral-count ls) 101)
713(ral-remove! ls 20)
714(fx= (ral-ref ls 20) 20)
715(fx= (ral-count ls) 100)
716
717;restructure
718(define lsr (ral-restructure ls 4 20))
719(ral-eql? fx= ls lsr)
720(fx= (ral-width lsr) 4)
721(fx= (ral-max-height lsr) 20)
722
723;map and filter
724(equal? (ral->list (ral-map ls add1))
725        (let loop ((k 100) (result '()))
726          (if (fx= k 0)
727            result
728            (loop (fx- k 1) (cons k result)))))
729(equal? (ral->list (ral-filter ls odd?))
730        (let loop ((k 99) (result '()))
731          (if (fx< k 0)
732            result
733            (loop (fx- k 2) (cons k result)))))
734
735</enscript>
736
737== Requirements
738
739[[dbc]]
740
741== Last update
742
743Nov 27, 2013
744
745== Author
746
747[[/users/juergen-lorenz|Juergen Lorenz]]
748
749== License
750
751 Copyright (c) 2012-2013, Juergen Lorenz
752 All rights reserved.
753
754 Redistribution and use in source and binary forms, with or without
755 modification, are permitted provided that the following conditions are
756 met:
757 
758 Redistributions of source code must retain the above copyright
759 notice, this list of conditions and the following disclaimer.
760 
761 Redistributions in binary form must reproduce the above copyright
762 notice, this list of conditions and the following disclaimer in the
763 documentation and/or other materials provided with the distribution.
764 Neither the name of the author nor the names of its contributors may be
765 used to endorse or promote products derived from this software without
766 specific prior written permission.
767   
768 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
769 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
770 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
771 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
772 HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
773 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
774 TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
775 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
776 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
777 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
778 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
779
780== Version History
781
782; 0.1.2 : tests updated
783; 0.1.1 : tests updated
784; 0.1 : initial import
Note: See TracBrowser for help on using the repository browser.