(use eggdoc) (define doc `((eggdoc:begin (name "rb-tree") (description "A sorted dictionary data structure based on red-black trees.") (author (url "http://chicken.wiki.br/users/ivan-raikov" "Ivan Raikov")) (history (version "2.7" "Bug fix in dispatch-on-key") (version "2.6" "Ported to Chicken 4") (version "2.5" "Fixes to for-each-ascending/descending") (version "2.3" "Build script updated for better cross-platform compatibility") (version "2.2" "Added fold-limit procedures") (version "2.1" "Added fold-partial procedures") (version "2.0" "Added side-effect-free put and delete procedures") (version "1.0" "Initial release")) (requires (url "datatype.html" "datatype")) (usage "(require-extension rb-tree)") (download "rb-tree.egg") (documentation (p "The " (tt "rb-tree") " library is based on the SML/NJ " "library implementation of red-black trees, which is in turn " "based on Chris Okasaki's implementation of red-black trees. " "The delete function is based on the description in Cormen, " "Leiserson, and Rivest.") (p "The present implementation code defines a red-black tree object that " "implements an ordered dictionary mapping of keys to " "values. The object responds to a variety of query and update " "messages, including methods for finding the minimum and " "maximum keys and their associated values as well as " "traversing the tree in an ascending or descending order of " "keys. Looking up an arbitrary or the min/max keys, and " "deleting the min/max keys require no more key comparisons " "than the depth of the tree, which is O(log n) where n is the " "total number of keys in the tree.") (p "The rb-tree object is created by procedure " (tt "make-rb-tree") ", the only user-visible procedure defined in this egg: " (procedure "make-rb-tree:: KEY-COMPARE-PROC -> SELECTOR" (p "where KEY-COMPARE-PROC is a user-supplied function " "that takes two keys and returns a " "negative, positive, or zero number " "depending on how the first key compares to " "the second. ") (p "The returned selector procedure can take one of the following arguments: " (symbol-table (describe "'get" ("returns a procedure " (tt "LAMBDA KEY . DEFAULT-CLAUSE") " which searches the red-black tree for an association with a given " (tt "KEY") ", and returns a (key . value) pair of the found association. " "If an association with " (tt "KEY") " cannot be located in the red-black tree, " "the PROC returns the result of evaluating the " (tt "DEFAULT-CLAUSE") ". " "If the default clause is omitted, an error is signalled. " (tt "KEY") " must be comparable to the keys in the red-black tree " "by a key-compare predicate (which has been specified " "when the red-black tree was created)")) (describe "'get-min" ("returns a (key . value) pair for an association in the " "red-black tree with the smallest key. If the red-black tree is empty, an error " "is signalled.")) (describe "'delete-min!" ("removes the min key and the corresponding association " "from the red-black tree. Returns a (key . value) pair of the " "removed association. If the red-black tree is empty, an error " "is signalled. ")) (describe "'get-max" ("returns a (key . value) pair for an association in the " "red-black tree with the largest key. If the red-black tree is empty, an error " "is signalled.")) (describe "'delete-max!" ("removes the max key and the corresponding association " "from the red-black tree. Returns a (key . value) pair of the " "removed association. If the red-black tree is empty, an error is signalled.")) (describe "'empty?" ("returns " (tt "#t") " if the red-black tree is empty")) (describe "'size" ("returns the size (the number of associations) in the red-black tree")) (describe "'depth" ("returns the depth of the tree. It requires " "the complete traversal of the tree, so use sparingly")) (describe "'clear!" ("removes all associations from the red-black tree (thus making it empty)")) (describe "'put!" ("returns a procedure " (tt "LAMBDA KEY VALUE") " which, given a " (tt "KEY") " and a " (tt "VALUE") ", adds the corresponding association to the red-black tree. " "If an association with the same " (tt "KEY") " already exists, its value is replaced with the " (tt "VALUE") " (and the old (key . value) association is returned). " "Otherwise, the return value is " (tt "#f") ".")) (describe "'put" ("pure variant of " (tt "PUT!") "; it returns a new red-black tree " "object that contains the given association, while the original " "red-black tree object is unmodified. ")) (describe "'delete!" ("returns a procedure " (tt "LAMBDA KEY . DEFAULT-CLAUSE") " which searches the red-black tree for an association with a given " (tt "KEY") ", deletes it, and returns a (key . value) pair of the found " "and deleted association. If an association with the KEY cannot be located " "in the red-black tree, the " (tt "PROC") " returns the result of evaluating " (tt "DEFAULT-CLAUSE") ". " "If the default clause is omitted, an error is signalled. ")) (describe "'delete" ("pure variant of " (tt "DELETE!") "; if the specified key is found, " "it returns a new red-black tree object that no longer contains the " "association specified by that key, while the original " "red-black tree object is unmodified. If the key is not found, " "the behavior of this procedure is identical to " (tt "DELETE!") ". ")) (describe "'for-each-ascending" ("returns a procedure " (tt "LAMBDA PROC") " that will apply the given procedure PROC to each (key . value) " "association of the red-black tree, from the one with the smallest key " "all the way to the one with the max key, in an ascending order " "of keys. ")) (describe "'for-each-descending" ("returns a procedure " (tt "LAMBDA PROC") " that will apply the given " "procedure " (tt "PROC") "to each (key . value) association of the red-black tree, " "in the descending order of keys. ")) (describe "'map" ("returns a procedure " (tt "LAMBDA PROC") " that will apply the given " "procedure " (tt "PROC") "to the value component of each association in " "the red-black tree, in the ascending order of keys, " "and will construct a copy of the tree that contains the values " "returned by that procedure." )) (describe "'mapi" ("returns a procedure " (tt "LAMBDA PROC") " that will apply the given " "procedure " (tt "PROC") "to each (key . value) association in " "the red-black tree, in the ascending order of keys, " "and will construct a copy of the tree that contains the values " "returned by that procedure." )) (describe "'fold" ("returns a procedure " (tt "LAMBDA PROC INITIAL") " such that, " "given the associations in the tree ordered by the descending order of keys: " (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC value-1 (PROC value-2 ... (PROC value-n INITIAL)") ". ")) (describe "'foldi" ("returns a procedure " (tt "LAMBDA PROC INITIAL") " such that, " "given the associations in the tree ordered by the descending order of keys: " (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC key-1 value-1 (PROC key-2 value-2 ... (PROC key-n value-n INITIAL)") ". ")) (describe "'fold-right" ("returns a procedure " (tt "LAMBDA PROC INITIAL") " such that, " "given the associations in the tree ordered by the ascending order of keys: " (tt "(key-1 . value-1) (key-2 . value-2) ... (key-n . value-n) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC value-n ... (PROC value-2 (PROC value-1 INITIAL)") ". ")) (describe "'foldi-right" ("returns a procedure " (tt "LAMBDA PROC INITIAL") " such that, " "given the associations in the tree ordered by the ascending order of keys: " (tt "(key-1 . value-1) (key-2 . value-2) ... (key-n . value-n) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC key-n value-n ... (PROC key-2 value-2 (PROC key-1 value-1 INITIAL)") ". ")) (describe "'fold-partial" ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " "given the associations in the tree ordered by the descending order of keys: " (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC value-i ... (PROC value-n INITIAL)") ", " "where " (tt "i <= n") " and " (tt "(PRED x)") " holds true for all " (tt "x = (value-n) ... (value-i)") ". " "In other words, this function acts like " (tt "fold") " on the ordered subset " "of the values " (tt "x") " in the tree such that " (tt "(PRED x)") " is true. ")) (describe "'foldi-partial" ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " "given the associations in the tree ordered by the descending order of keys: " (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC key-i value-i ... (PROC key-n value-n INITIAL)") ", " "where " (tt "i <= n") " and " (tt "(PRED xk x)") " holds true for all " (tt "x = (value-n) ... (value-i)") " and " (tt "xk = (key-n) ... (key-i)") ". " "In other words, this function acts like " (tt "foldi") " on the ordered subset " "of the key-value pairs " (tt "(k . x)") " in the tree such that " (tt "(PRED k x)") " is true. ")) (describe "'fold-right-partial" ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " "given the associations in the tree ordered by the ascending order of keys: " (tt "(key-1 . value-1) (key-2 . value-2) ... (key-n . value-n) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC value-1 ... (PROC value-i INITIAL)") ", " "where " (tt "i <= n") " and " (tt "(PRED x)") " holds true for all " (tt "x = (value-1) ... (value-i)") ". " "In other words, this function acts like " (tt "fold-right") " on the ordered subset " "of the values " (tt "x") " in the tree such that " (tt "(PRED x)") " is true. ")) (describe "'foldi-right-partial" ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " "given the associations in the tree ordered by the descending order of keys: " (tt "(key-1 . value-1) (key-2 . value-2) ... (key-1 . value-1) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC key-1 value-1 ... (PROC key-i value-i INITIAL)") ", " "where " (tt "i <= n") " and " (tt "(PRED xk x)") " holds true for all " (tt "x = (value-1) ... (value-i)") " and " (tt "xk = (key-1) ... (key-i)") ". " "In other words, this function acts like " (tt "foldi-right") " on the ordered subset " "of the key-value pairs " (tt "(k . x)") " in the tree such that " (tt "(PRED k x)") " is true. ")) (describe "'fold-limit" ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " "given the associations in the tree ordered by the descending order of keys: " (tt "(key-n . value-n) ... (key-2 . value-2) (key-1 . value-1) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC value-i ... (PROC value-n INITIAL)") ", " "where " (tt "i <= n") " and " (tt "(PRED x)") " does not hold true for all " (tt "x = (PROC value-n INITIAL) ... (PROC (value-i) (PROC value-(i-1)...") ". ")) (describe "'fold-right-limit" ("returns a procedure " (tt "LAMBDA PRED PROC INITIAL") " such that, " "given the associations in the tree ordered by the descending order of keys: " (tt "(key-1 . value-1) (key-2 . value-2) ... (key-i . value-1) ") " " "the procedure returns the result of the successive function applications " (tt "(PROC value-i ... (PROC value-1 INITIAL)") ", " "where " (tt "i <= n") " and " (tt "(PRED x)") " does not hold true for all " (tt "x = (PROC value-1 INITIAL) ... (PROC (value-i) (PROC value-(i-1)...") ". ")) ))))) (examples (pre #< Sorting of a set of numbers via a red-black tree" (define (++ x) (fx+ 1 x)) (define (-- x) (fx- x 1)) (let ((min-key -1) (max-key 10) (rb-tree (make-rb-tree (lambda (x y) (- x y)))) ;; a hard-wired association between a key and a value (compute-assoc (lambda (key) (cons key (++ key))))) ;; loading a sequence [min-key .. max-key] in ascending order (do ((i min-key (++ i))) ((> i max-key)) ((rb-tree 'put!) i (cdr (compute-assoc i)))) (print "the tree depth is " (rb-tree 'depth) "\n") (print ((rb-tree 'get) (++ min-key))) (print ((rb-tree 'get) (++ min-key) 'notfound)) ;; checking traversing in ascending order (let ((expected-key min-key)) ((rb-tree 'for-each-ascending) (lambda (association) (print (equal? association (compute-assoc expected-key))) (set! expected-key (++ expected-key))))) ;; clearing the rb-tree and reloading the same sequence in ;; descending order (rb-tree 'clear!) (do ((i max-key (-- i))) ((< i min-key)) ((rb-tree 'put!) i (cdr (compute-assoc i)))) (print "the tree depth is " (rb-tree 'depth) "\n") ;; checking traversing in descending order (let ((expected-key max-key)) ((rb-tree 'for-each-descending) (lambda (association) (print (equal? association (compute-assoc expected-key))) (set! expected-key (-- expected-key)))))) EOF )) (license "Copyright Ivan Raikov and the Okinawa Institute of Science and Technology. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. A full copy of the GPL license can be found at .")))) (if (eggdoc->html doc) (void))