(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.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))