1 | |
---|
2 | (use eggdoc) |
---|
3 | |
---|
4 | (define doc |
---|
5 | `((eggdoc:begin |
---|
6 | (name "rb-tree") |
---|
7 | (description "A sorted dictionary data structure based on red-black trees.") |
---|
8 | (author (url "http://chicken.wiki.br/users/ivan-raikov" "Ivan Raikov")) |
---|
9 | |
---|
10 | (history |
---|
11 | (version "2.6" "Ported to Chicken 4") |
---|
12 | (version "2.5" "Fixes to for-each-ascending/descending") |
---|
13 | (version "2.3" "Build script updated for better cross-platform compatibility") |
---|
14 | (version "2.2" "Added fold-limit procedures") |
---|
15 | (version "2.1" "Added fold-partial procedures") |
---|
16 | (version "2.0" "Added side-effect-free put and delete procedures") |
---|
17 | (version "1.0" "Initial release")) |
---|
18 | |
---|
19 | (requires (url "datatype.html" "datatype")) |
---|
20 | |
---|
21 | (usage "(require-extension rb-tree)") |
---|
22 | |
---|
23 | (download "rb-tree.egg") |
---|
24 | |
---|
25 | (documentation |
---|
26 | |
---|
27 | (p "The " (tt "rb-tree") " library is based on the SML/NJ " |
---|
28 | "library implementation of red-black trees, which is in turn " |
---|
29 | "based on Chris Okasaki's implementation of red-black trees. " |
---|
30 | "The delete function is based on the description in Cormen, " |
---|
31 | "Leiserson, and Rivest.") |
---|
32 | |
---|
33 | (p "The present implementation code defines a red-black tree object that " |
---|
34 | "implements an ordered dictionary mapping of keys to " |
---|
35 | "values. The object responds to a variety of query and update " |
---|
36 | "messages, including methods for finding the minimum and " |
---|
37 | "maximum keys and their associated values as well as " |
---|
38 | "traversing the tree in an ascending or descending order of " |
---|
39 | "keys. Looking up an arbitrary or the min/max keys, and " |
---|
40 | "deleting the min/max keys require no more key comparisons " |
---|
41 | "than the depth of the tree, which is O(log n) where n is the " |
---|
42 | "total number of keys in the tree.") |
---|
43 | |
---|
44 | (p "The rb-tree object is created by procedure " (tt "make-rb-tree") |
---|
45 | ", the only user-visible procedure defined in this egg: " |
---|
46 | |
---|
47 | (procedure "make-rb-tree:: KEY-COMPARE-PROC -> SELECTOR" |
---|
48 | (p "where KEY-COMPARE-PROC is a user-supplied function " |
---|
49 | "that takes two keys and returns a " |
---|
50 | "negative, positive, or zero number " |
---|
51 | "depending on how the first key compares to " |
---|
52 | "the second. ") |
---|
53 | (p "The returned selector procedure can take one of the following arguments: " |
---|
54 | (symbol-table |
---|
55 | |
---|
56 | (describe "'get" |
---|
57 | ("returns a procedure " (tt "LAMBDA KEY . DEFAULT-CLAUSE") |
---|
58 | " which searches the red-black tree for an association with a given " |
---|
59 | (tt "KEY") ", and returns a (key . value) pair of the found association. " |
---|
60 | "If an association with " (tt "KEY") " cannot be located in the red-black tree, " |
---|
61 | "the PROC returns the result of evaluating the " (tt "DEFAULT-CLAUSE") ". " |
---|
62 | "If the default clause is omitted, an error is signalled. " |
---|
63 | (tt "KEY") " must be comparable to the keys in the red-black tree " |
---|
64 | "by a key-compare predicate (which has been specified " |
---|
65 | "when the red-black tree was created)")) |
---|
66 | |
---|
67 | (describe "'get-min" |
---|
68 | ("returns a (key . value) pair for an association in the " |
---|
69 | "red-black tree with the smallest key. If the red-black tree is empty, an error " |
---|
70 | "is signalled.")) |
---|
71 | |
---|
72 | (describe "'delete-min!" |
---|
73 | ("removes the min key and the corresponding association " |
---|
74 | "from the red-black tree. Returns a (key . value) pair of the " |
---|
75 | "removed association. If the red-black tree is empty, an error " |
---|
76 | "is signalled. ")) |
---|
77 | |
---|
78 | (describe "'get-max" |
---|
79 | ("returns a (key . value) pair for an association in the " |
---|
80 | "red-black tree with the largest key. If the red-black tree is empty, an error " |
---|
81 | "is signalled.")) |
---|
82 | |
---|
83 | (describe "'delete-max!" |
---|
84 | ("removes the max key and the corresponding association " |
---|
85 | "from the red-black tree. Returns a (key . value) pair of the " |
---|
86 | "removed association. If the red-black tree is empty, an error is signalled.")) |
---|
87 | |
---|
88 | (describe "'empty?" |
---|
89 | ("returns " (tt "#t") " if the red-black tree is empty")) |
---|
90 | |
---|
91 | (describe "'size" |
---|
92 | ("returns the size (the number of associations) in the red-black tree")) |
---|
93 | |
---|
94 | |
---|
95 | (describe "'depth" |
---|
96 | ("returns the depth of the tree. It requires " |
---|
97 | "the complete traversal of the tree, so use sparingly")) |
---|
98 | |
---|
99 | |
---|
100 | (describe "'clear!" |
---|
101 | ("removes all associations from the red-black tree (thus making it empty)")) |
---|
102 | |
---|
103 | (describe "'put!" |
---|
104 | ("returns a procedure " (tt "LAMBDA KEY VALUE") |
---|
105 | " which, given a " (tt "KEY") " and a " (tt "VALUE") |
---|
106 | ", adds the corresponding association to the red-black tree. " |
---|
107 | "If an association with the same " (tt "KEY") |
---|
108 | " already exists, its value is replaced with the " |
---|
109 | (tt "VALUE") " (and the old (key . value) association is returned). " |
---|
110 | "Otherwise, the return value is " (tt "#f") ".")) |
---|
111 | |
---|
112 | (describe "'put" |
---|
113 | ("pure variant of " (tt "PUT!") "; it returns a new red-black tree " |
---|
114 | "object that contains the given association, while the original " |
---|
115 | "red-black tree object is unmodified. ")) |
---|
116 | |
---|
117 | (describe "'delete!" |
---|
118 | ("returns a procedure " (tt "LAMBDA KEY . DEFAULT-CLAUSE") |
---|
119 | " which searches the red-black tree for an association with a given " |
---|
120 | (tt "KEY") ", deletes it, and returns a (key . value) pair of the found " |
---|
121 | "and deleted association. If an association with the KEY cannot be located " |
---|
122 | "in the red-black tree, the " (tt "PROC") " returns the result of evaluating " |
---|
123 | (tt "DEFAULT-CLAUSE") ". " |
---|
124 | "If the default clause is omitted, an error is signalled. ")) |
---|
125 | |
---|
126 | (describe "'delete" |
---|
127 | ("pure variant of " (tt "DELETE!") "; if the specified key is found, " |
---|
128 | "it returns a new red-black tree object that no longer contains the " |
---|
129 | "association specified by that key, while the original " |
---|
130 | "red-black tree object is unmodified. If the key is not found, " |
---|
131 | "the behavior of this procedure is identical to " (tt "DELETE!") ". ")) |
---|
132 | |
---|
133 | (describe "'for-each-ascending" |
---|
134 | ("returns a procedure " (tt "LAMBDA PROC") |
---|
135 | " that will apply the given procedure PROC to each (key . value) " |
---|
136 | "association of the red-black tree, from the one with the smallest key " |
---|
137 | "all the way to the one with the max key, in an ascending order " |
---|
138 | "of keys. ")) |
---|
139 | |
---|
140 | (describe "'for-each-descending" |
---|
141 | ("returns a procedure " (tt "LAMBDA PROC") " that will apply the given " |
---|
142 | "procedure " (tt "PROC") "to each (key . value) association of the red-black tree, " |
---|
143 | "in the descending order of keys. ")) |
---|
144 | |
---|
145 | (describe "'map" |
---|
146 | ("returns a procedure " (tt "LAMBDA PROC") " that will apply the given " |
---|
147 | "procedure " (tt "PROC") "to the value component of each association in " |
---|
148 | "the red-black tree, in the ascending order of keys, " |
---|
149 | "and will construct a copy of the tree that contains the values " |
---|
150 | "returned by that procedure." )) |
---|
151 | |
---|
152 | (describe "'mapi" |
---|
153 | ("returns a procedure " (tt "LAMBDA PROC") " that will apply the given " |
---|
154 | "procedure " (tt "PROC") "to each (key . value) association in " |
---|
155 | "the red-black tree, in the ascending order of keys, " |
---|
156 | "and will construct a copy of the tree that contains the values " |
---|
157 | "returned by that procedure." )) |
---|
158 | |
---|
159 | (describe "'fold" |
---|
160 | ("returns a procedure " (tt "LAMBDA PROC INITIAL") " such that, " |
---|
161 | "given the associations in the tree ordered by the descending order of keys: " |
---|
162 | (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " |
---|
163 | "the procedure returns the result of the successive function applications " |
---|
164 | (tt "(PROC value-1 (PROC value-2 ... (PROC value-n INITIAL)") ". ")) |
---|
165 | |
---|
166 | (describe "'foldi" |
---|
167 | ("returns a procedure " (tt "LAMBDA PROC INITIAL") " such that, " |
---|
168 | "given the associations in the tree ordered by the descending order of keys: " |
---|
169 | (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " |
---|
170 | "the procedure returns the result of the successive function applications " |
---|
171 | (tt "(PROC key-1 value-1 (PROC key-2 value-2 ... (PROC key-n value-n INITIAL)") ". ")) |
---|
172 | |
---|
173 | (describe "'fold-right" |
---|
174 | ("returns a procedure " (tt "LAMBDA PROC INITIAL") " such that, " |
---|
175 | "given the associations in the tree ordered by the ascending order of keys: " |
---|
176 | (tt "(key-1 . value-1) (key-2 . value-2) ... (key-n . value-n) ") " " |
---|
177 | "the procedure returns the result of the successive function applications " |
---|
178 | (tt "(PROC value-n ... (PROC value-2 (PROC value-1 INITIAL)") ". ")) |
---|
179 | |
---|
180 | (describe "'foldi-right" |
---|
181 | ("returns a procedure " (tt "LAMBDA PROC INITIAL") " such that, " |
---|
182 | "given the associations in the tree ordered by the ascending order of keys: " |
---|
183 | (tt "(key-1 . value-1) (key-2 . value-2) ... (key-n . value-n) ") " " |
---|
184 | "the procedure returns the result of the successive function applications " |
---|
185 | (tt "(PROC key-n value-n ... (PROC key-2 value-2 (PROC key-1 value-1 INITIAL)") ". ")) |
---|
186 | |
---|
187 | (describe "'fold-partial" |
---|
188 | ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " |
---|
189 | "given the associations in the tree ordered by the descending order of keys: " |
---|
190 | (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " |
---|
191 | "the procedure returns the result of the successive function applications " |
---|
192 | (tt "(PROC value-i ... (PROC value-n INITIAL)") ", " |
---|
193 | "where " (tt "i <= n") " and " (tt "(PRED x)") " holds true for all " |
---|
194 | (tt "x = (value-n) ... (value-i)") ". " |
---|
195 | "In other words, this function acts like " (tt "fold") " on the ordered subset " |
---|
196 | "of the values " (tt "x") " in the tree such that " (tt "(PRED x)") " is true. ")) |
---|
197 | |
---|
198 | (describe "'foldi-partial" |
---|
199 | ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " |
---|
200 | "given the associations in the tree ordered by the descending order of keys: " |
---|
201 | (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " |
---|
202 | "the procedure returns the result of the successive function applications " |
---|
203 | (tt "(PROC key-i value-i ... (PROC key-n value-n INITIAL)") ", " |
---|
204 | "where " (tt "i <= n") " and " (tt "(PRED xk x)") " holds true for all " |
---|
205 | (tt "x = (value-n) ... (value-i)") " and " (tt "xk = (key-n) ... (key-i)") ". " |
---|
206 | "In other words, this function acts like " (tt "foldi") " on the ordered subset " |
---|
207 | "of the key-value pairs " (tt "(k . x)") " in the tree such that " |
---|
208 | (tt "(PRED k x)") " is true. ")) |
---|
209 | |
---|
210 | (describe "'fold-right-partial" |
---|
211 | ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " |
---|
212 | "given the associations in the tree ordered by the ascending order of keys: " |
---|
213 | (tt "(key-1 . value-1) (key-2 . value-2) ... (key-n . value-n) ") " " |
---|
214 | "the procedure returns the result of the successive function applications " |
---|
215 | (tt "(PROC value-1 ... (PROC value-i INITIAL)") ", " |
---|
216 | "where " (tt "i <= n") " and " (tt "(PRED x)") " holds true for all " |
---|
217 | (tt "x = (value-1) ... (value-i)") ". " |
---|
218 | "In other words, this function acts like " (tt "fold-right") " on the ordered subset " |
---|
219 | "of the values " (tt "x") " in the tree such that " (tt "(PRED x)") " is true. ")) |
---|
220 | |
---|
221 | (describe "'foldi-right-partial" |
---|
222 | ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " |
---|
223 | "given the associations in the tree ordered by the descending order of keys: " |
---|
224 | (tt "(key-1 . value-1) (key-2 . value-2) ... (key-1 . value-1) ") " " |
---|
225 | "the procedure returns the result of the successive function applications " |
---|
226 | (tt "(PROC key-1 value-1 ... (PROC key-i value-i INITIAL)") ", " |
---|
227 | "where " (tt "i <= n") " and " (tt "(PRED xk x)") " holds true for all " |
---|
228 | (tt "x = (value-1) ... (value-i)") " and " (tt "xk = (key-1) ... (key-i)") ". " |
---|
229 | "In other words, this function acts like " (tt "foldi-right") " on the ordered subset " |
---|
230 | "of the key-value pairs " (tt "(k . x)") " in the tree such that " |
---|
231 | (tt "(PRED k x)") " is true. ")) |
---|
232 | |
---|
233 | (describe "'fold-limit" |
---|
234 | ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " |
---|
235 | "given the associations in the tree ordered by the descending order of keys: " |
---|
236 | (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " |
---|
237 | "the procedure returns the result of the successive function applications " |
---|
238 | (tt "(PROC value-i ... (PROC value-n INITIAL)") ", " |
---|
239 | "where " (tt "i <= n") " and " (tt "(PRED x)") " does not hold true for all " |
---|
240 | (tt "x = (PROC value-n INITIAL) ... (PROC (value-i) (PROC value-(i-1)...") ". ")) |
---|
241 | |
---|
242 | (describe "'fold-right-limit" |
---|
243 | ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " |
---|
244 | "given the associations in the tree ordered by the descending order of keys: " |
---|
245 | (tt "(key-1 . value-1) (key-2 . value-2) ... (key-i . value-1) ") " " |
---|
246 | "the procedure returns the result of the successive function applications " |
---|
247 | (tt "(PROC value-i ... (PROC value-1 INITIAL)") ", " |
---|
248 | "where " (tt "i <= n") " and " (tt "(PRED x)") " does not hold true for all " |
---|
249 | (tt "x = (PROC value-1 INITIAL) ... (PROC (value-i) (PROC value-(i-1)...") ". ")) |
---|
250 | ))))) |
---|
251 | |
---|
252 | (examples (pre #<<EOF |
---|
253 | ;; "--> Sorting of a set of numbers via a red-black tree" |
---|
254 | |
---|
255 | (define (++ x) (fx+ 1 x)) |
---|
256 | (define (-- x) (fx- x 1)) |
---|
257 | |
---|
258 | (let |
---|
259 | ((min-key -1) (max-key 10) |
---|
260 | (rb-tree (make-rb-tree (lambda (x y) (- x y)))) |
---|
261 | ;; a hard-wired association between a key and a value |
---|
262 | (compute-assoc (lambda (key) (cons key (++ key))))) |
---|
263 | |
---|
264 | ;; loading a sequence [min-key .. max-key] in ascending order |
---|
265 | (do ((i min-key (++ i))) ((> i max-key)) |
---|
266 | ((rb-tree 'put!) i (cdr (compute-assoc i)))) |
---|
267 | |
---|
268 | (print "the tree depth is " (rb-tree 'depth) "\n") |
---|
269 | |
---|
270 | (print ((rb-tree 'get) (++ min-key))) |
---|
271 | |
---|
272 | (print ((rb-tree 'get) (++ min-key) 'notfound)) |
---|
273 | |
---|
274 | ;; checking traversing in ascending order |
---|
275 | (let ((expected-key min-key)) |
---|
276 | ((rb-tree 'for-each-ascending) |
---|
277 | (lambda (association) |
---|
278 | (print (equal? association (compute-assoc expected-key))) |
---|
279 | (set! expected-key (++ expected-key))))) |
---|
280 | |
---|
281 | ;; clearing the rb-tree and reloading the same sequence in |
---|
282 | ;; descending order |
---|
283 | (rb-tree 'clear!) |
---|
284 | (do ((i max-key (-- i))) ((< i min-key)) |
---|
285 | ((rb-tree 'put!) i (cdr (compute-assoc i)))) |
---|
286 | |
---|
287 | (print "the tree depth is " (rb-tree 'depth) "\n") |
---|
288 | |
---|
289 | ;; checking traversing in descending order |
---|
290 | (let ((expected-key max-key)) |
---|
291 | ((rb-tree 'for-each-descending) |
---|
292 | (lambda (association) |
---|
293 | (print (equal? association (compute-assoc expected-key))) |
---|
294 | (set! expected-key (-- expected-key)))))) |
---|
295 | EOF |
---|
296 | )) |
---|
297 | (license |
---|
298 | "Copyright Ivan Raikov and the Okinawa Institute of Science and Technology. |
---|
299 | |
---|
300 | This program is free software: you can redistribute it and/or modify |
---|
301 | it under the terms of the GNU General Public License as published by |
---|
302 | the Free Software Foundation, either version 3 of the License, or (at |
---|
303 | your option) any later version. |
---|
304 | |
---|
305 | This program is distributed in the hope that it will be useful, but |
---|
306 | WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
307 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
---|
308 | General Public License for more details. |
---|
309 | |
---|
310 | A full copy of the GPL license can be found at |
---|
311 | <http://www.gnu.org/licenses/>.")))) |
---|
312 | |
---|
313 | (if (eggdoc->html doc) (void)) |
---|