├── .gitignore ├── COPYING ├── README.md ├── avl ├── avl.scrbl ├── info.rkt └── main.rkt └── info.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | compiled 2 | doc 3 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | This software is licensed under the same terms and conditions as Racket. 2 | Consult http://download.racket-lang.org/license.html for more information. 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # AVL Trees 2 | 3 | AVL trees for Racket. Internally always copy-on-write, but supporting 4 | mutation of the tree as a whole for convenience. 5 | 6 | Can be used as a priority queue with ability to remove random elements. 7 | 8 | See scribblings for complete manual. 9 | -------------------------------------------------------------------------------- /avl/avl.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @require[scribble/eval] 4 | 5 | @require[(for-label racket) 6 | (for-label "main.rkt")] 7 | 8 | @define[avl-eval (make-base-eval)] 9 | @interaction-eval[#:eval avl-eval (require "main.rkt")] 10 | 11 | @title{AVL Trees} 12 | @author+email["Jan Dvořák" "mordae@anilinux.org"] 13 | 14 | @defmodule[avl] 15 | 16 | A self-balancing binary search tree variant. 17 | 18 | All mutations of the AVL tree create new nodes instead of modifying the 19 | data in place. The imperative variants change the root node in place 20 | for convenience. Mutating the tree is not thread-safe. 21 | 22 | These trees could be used for as priority queues with possibility to 23 | remove elements from the middle. 24 | 25 | @section{Creating Trees} 26 | 27 | @deftogether[(@defproc[(make-avl (<=? procedure?)) avl?] 28 | @defproc[(make-avleq (<=? procedure?)) avl?] 29 | @defproc[(make-avleqv (<=? procedure?)) avl?])]{ 30 | Create new tree using specified comparator function. 31 | 32 | Like hash tables, every AVL tree variant uses a different equality 33 | predicate. @racket[make-avl] uses @racket[equal?], @racket[make-avleq] 34 | uses @racket[eq?] and @racket[make-avleqv] uses @racket[eqv?]. 35 | 36 | Tree with @racket[number?] elements would use @racket[<=] as the comparator, 37 | tree with @racket[string?] elements would use @racket[string<=?] and so on. 38 | 39 | @examples[#:eval avl-eval 40 | (define tree (make-avleqv <=)) 41 | (avl-add! tree 42) 42 | ] 43 | } 44 | 45 | @defproc[(make-custom-avl (<=? procedure?) (=? procedure?)) avl?]{ 46 | Create new tree using both specified comparator function and 47 | equality predicate. 48 | 49 | @examples[#:eval avl-eval 50 | (define custom-avl 51 | (make-custom-avl (λ (x y) (<= (car x) (car y))) 52 | (λ (x y) (equal? (car x) (car y))))) 53 | (avl-add! custom-avl (cons 1 'hello)) 54 | (avl-add! custom-avl (cons 2 'ciao)) 55 | (avl-add! custom-avl (cons 1 'bye)) 56 | (avl->list custom-avl) 57 | ] 58 | } 59 | 60 | @defproc[(avl-copy (tree avl?)) avl?]{ 61 | Copy the tree container, effectively creating a standalone tree that is 62 | decoupled from the original. 63 | 64 | @examples[#:eval avl-eval 65 | (define copy (avl-copy tree)) 66 | (avl-remove! copy 42) 67 | ] 68 | } 69 | 70 | 71 | @section{Predicates} 72 | 73 | @defproc[(avl? (v any/c)) boolean?]{ 74 | Predicate identifying the AVL tree. 75 | 76 | @examples[#:eval avl-eval 77 | (avl? tree) 78 | (avl? copy) 79 | (avl? 'something-else) 80 | ] 81 | } 82 | 83 | @deftogether[(@defproc[(avl-equal? (v any/c)) boolean?] 84 | @defproc[(avl-eqv? (v any/c)) boolean?] 85 | @defproc[(avl-eq? (v any/c)) boolean?])]{ 86 | Predicates for trees created using respective constructors above. 87 | 88 | @examples[#:eval avl-eval 89 | (avl-equal? tree) 90 | (avl-eqv? tree) 91 | (avl-eq? tree) 92 | ] 93 | } 94 | 95 | @defproc[(avl-empty? (tree avl?)) boolean?]{ 96 | Determine whether the tree contains no values. 97 | 98 | @examples[#:eval avl-eval 99 | (avl-empty? tree) 100 | (avl-empty? copy) 101 | ] 102 | } 103 | 104 | @defproc[(avl-contains? (tree avl?) (value any/c)) boolean?]{ 105 | Determine whether the tree contains specified value at least once. 106 | 107 | @examples[#:eval avl-eval 108 | (avl-contains? tree 42) 109 | (avl-contains? copy 42) 110 | ] 111 | } 112 | 113 | @defproc[(avl-search (tree avl?) (value any/c)) any/c?]{ 114 | Search the tree and return a needle corresponding 115 | to the specified @racket[value]. Return #f if none exist. 116 | 117 | @examples[#:eval avl-eval 118 | (define animal-dict 119 | (make-custom-avl (λ (x y) (<= (car x) (car y))) 120 | (λ (x y) (equal? (car x) (car y))))) 121 | (avl-add! animal-dict (cons 1 'cat)) 122 | (avl-add! animal-dict (cons 2 'dog)) 123 | (avl-add! animal-dict (cons 3 'mouse)) 124 | (avl->list animal-dict) 125 | 126 | (define (search-by-key tree key) 127 | (avl-search tree (cons key '()))) 128 | (search-by-key animal-dict 1) 129 | (search-by-key animal-dict 2) 130 | (search-by-key animal-dict 3) 131 | (search-by-key animal-dict 4) 132 | ] 133 | } 134 | 135 | @section{Manipulating Values} 136 | 137 | @defproc[(avl-add (tree avl?) (value any/c)) avl?]{ 138 | Create new tree containing specified @racket[value]. 139 | 140 | @examples[#:eval avl-eval 141 | (let ((new-tree (avl-add tree 13))) 142 | (avl-contains? new-tree 13)) 143 | (avl-contains? tree 13) 144 | ] 145 | } 146 | 147 | @defproc[(avl-add! (tree avl?) (value any/c)) void?]{ 148 | Like @racket[avl-add], but the container is modified in place. 149 | 150 | @examples[#:eval avl-eval 151 | (avl-add! tree 13) 152 | (avl-contains? tree 13) 153 | ] 154 | } 155 | 156 | @defproc[(avl-remove (tree avl?) (value any/c)) avl?]{ 157 | Create new tree without the first instance of the @racket[value]. 158 | 159 | @examples[#:eval avl-eval 160 | (let ((new-tree (avl-remove tree 13))) 161 | (avl-contains? new-tree 13)) 162 | (avl-contains? tree 13) 163 | ] 164 | } 165 | 166 | @defproc[(avl-remove! (tree avl?) (value any/c)) void?]{ 167 | Like @racket[avl-remove], but the container is modified in place. 168 | 169 | @examples[#:eval avl-eval 170 | (avl-remove! tree 13) 171 | (avl-contains? tree 13) 172 | ] 173 | } 174 | 175 | @defproc[(avl-mirror [tree avl?]) avl?]{ 176 | Mirror (invert) a tree by swapping each left and right node. 177 | Returns the mirrored tree. 178 | 179 | @examples[#:eval avl-eval 180 | (let ([new-tree (make-avl <)]) 181 | (avl-add! new-tree 55) 182 | (avl-add! new-tree 10) 183 | (avl-add! new-tree 99) 184 | (avl->list (avl-mirror new-tree))) 185 | ] 186 | } 187 | 188 | @defproc[(avl-mirror! [tree avl?]) void?]{ 189 | Like @racket[avl-mirror], but the container is modified in place. 190 | 191 | @examples[#:eval avl-eval 192 | (let ([new-tree (make-avl <)]) 193 | (avl-add! new-tree 55) 194 | (avl-add! new-tree 10) 195 | (avl-add! new-tree 99) 196 | (avl-mirror! new-tree) 197 | (avl->list new-tree)) 198 | ] 199 | } 200 | 201 | 202 | @section{Queue Usage} 203 | 204 | @defproc[(avl-min (tree avl?)) any/c]{ 205 | Find smallest (leftmost) value in the tree. 206 | 207 | @examples[#:eval avl-eval 208 | (avl-add! tree 21) 209 | (avl-min tree) 210 | ] 211 | } 212 | 213 | @defproc[(avl-max (tree avl?)) any/c]{ 214 | Find largest (rightmost) value in the tree. 215 | 216 | @examples[#:eval avl-eval 217 | (avl-add! tree 101) 218 | (avl-max tree) 219 | ] 220 | } 221 | 222 | @defproc[(avl-pop-min (tree avl?)) (values any/c avl?)]{ 223 | Find and remove smallest (leftmost) value from the tree. 224 | Returns both the removed value and new tree container. 225 | 226 | @examples[#:eval avl-eval 227 | (avl-pop-min tree) 228 | (avl-min tree) 229 | ] 230 | } 231 | 232 | @defproc[(avl-pop-min! (tree avl?)) any/c]{ 233 | Like @racket[avl-pop-min], but returns only the value and 234 | modifies the container in place. 235 | 236 | @examples[#:eval avl-eval 237 | (avl-pop-min! tree) 238 | (avl-min tree) 239 | ] 240 | } 241 | 242 | @defproc[(avl-pop-max (tree avl?)) (values any/c avl?)]{ 243 | Find and remove largest (rightmost) value from the tree. 244 | Returns both the removed value and new tree container. 245 | 246 | @examples[#:eval avl-eval 247 | (avl-pop-max tree) 248 | (avl-max tree) 249 | ] 250 | } 251 | 252 | @defproc[(avl-pop-max! (tree avl?)) any/c]{ 253 | Like @racket[avl-pop-max], but returns only the value and 254 | modifies the container in place. 255 | 256 | @examples[#:eval avl-eval 257 | (avl-pop-max! tree) 258 | (avl-max tree) 259 | ] 260 | } 261 | 262 | 263 | @section{Iterating Over Values} 264 | 265 | @defproc[(in-avl (tree avl?)) sequence?]{ 266 | Iterate over the tree values in ascending order. 267 | 268 | @examples[#:eval avl-eval 269 | (for/list ((value (in-avl tree))) 270 | (* value 10)) 271 | ] 272 | } 273 | 274 | @defproc[(in-avl/reverse (tree avl?)) sequence?]{ 275 | Iterate over the tree values in descending order. 276 | 277 | @examples[#:eval avl-eval 278 | (for/list ((value (in-avl/reverse tree))) 279 | (/ value 10)) 280 | ] 281 | } 282 | 283 | @defproc[(avl->list (tree avl?)) list?]{ 284 | Convert the tree to an ordered list. 285 | 286 | @examples[#:eval avl-eval 287 | (avl->list tree) 288 | (avl->list copy) 289 | ] 290 | } 291 | 292 | 293 | @; vim:set ft=scribble sw=2 ts=2 et: 294 | -------------------------------------------------------------------------------- /avl/info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | 3 | (define scribblings '(("avl.scrbl"))) 4 | 5 | ; vim:set ts=2 sw=2 et: 6 | -------------------------------------------------------------------------------- /avl/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | ; 3 | ; AVL - Binary Search Tree 4 | ; 5 | 6 | (require racket/generator 7 | racket/contract 8 | racket/match) 9 | 10 | (provide avl?) 11 | 12 | (provide 13 | (contract-out 14 | (make-avl (-> (-> any/c any/c boolean?) avl?)) 15 | (make-avleq (-> (-> any/c any/c boolean?) avl?)) 16 | (make-avleqv (-> (-> any/c any/c boolean?) avl?)) 17 | (make-custom-avl (-> (-> any/c any/c boolean?) 18 | (-> any/c any/c boolean?) avl?)) 19 | (avl-copy (-> avl? avl?)) 20 | (avl-add (-> avl? any/c avl?)) 21 | (avl-add! (-> avl? any/c void?)) 22 | (avl-remove (-> avl? any/c avl?)) 23 | (avl-remove! (-> avl? any/c void?)) 24 | (avl-min (-> avl? any/c)) 25 | (avl-max (-> avl? any/c)) 26 | (avl-pop-min (-> avl? (values any/c avl?))) 27 | (avl-pop-min! (-> avl? any/c)) 28 | (avl-pop-max (-> avl? (values any/c avl?))) 29 | (avl-pop-max! (-> avl? any/c)) 30 | (avl-empty? (-> avl? boolean?)) 31 | (avl-equal? (-> any/c boolean?)) 32 | (avl-eqv? (-> any/c boolean?)) 33 | (avl-eq? (-> any/c boolean?)) 34 | (avl-contains? (-> avl? any/c boolean?)) 35 | (avl-search (-> avl? any/c any/c)) 36 | (avl->list (-> avl? list?)) 37 | (in-avl (-> avl? sequence?)) 38 | (in-avl/reverse (-> avl? sequence?)) 39 | (avl-mirror (-> avl? avl?)) 40 | (avl-mirror! (-> avl? void?)))) 41 | 42 | 43 | ;; Wrapper to hide AVL tree nodes from the user. 44 | ;; Possibly mutable, unlike the individual nodes. 45 | (struct avl 46 | (<=? =? (root #:mutable))) 47 | 48 | ;; An immutable tree node. 49 | (struct node 50 | (left right value height)) 51 | 52 | 53 | ;; Create an empty tree with specified comparator, 54 | ;; that determines two values are identical using equal?. 55 | (define (make-avl <=?) 56 | (avl <=? equal? #f)) 57 | 58 | 59 | ;; Create an empty tree with specified comparator, 60 | ;; that determines two values are identical using eq?. 61 | (define (make-avleq <=?) 62 | (avl <=? eq? #f)) 63 | 64 | 65 | ;; Create an empty tree with specified comparator, 66 | ;; that determines two values are identical using eqv?. 67 | (define (make-avleqv <=?) 68 | (avl <=? eqv? #f)) 69 | 70 | 71 | ;; Create an empty tree with specified comparator and equality predicate. 72 | (define (make-custom-avl <=? =?) 73 | (avl <=? =? #f)) 74 | 75 | 76 | ;; Determine whether the value is an AVL tree have been 77 | ;; created using `make-avl`. 78 | (define (avl-equal? v) 79 | (and (avl? v) 80 | (eq? equal? (avl-=? v)))) 81 | 82 | 83 | ;; Determine whether the value is an AVL tree have been 84 | ;; created using `make-avleqv`. 85 | (define (avl-eqv? v) 86 | (and (avl? v) 87 | (eq? eqv? (avl-=? v)))) 88 | 89 | 90 | ;; Determine whether the value is an AVL tree have been 91 | ;; created using `make-avleq`. 92 | (define (avl-eq? v) 93 | (and (avl? v) 94 | (eq? eq? (avl-=? v)))) 95 | 96 | 97 | ;; Determine whether is the AVL tree empty or not. 98 | (define (avl-empty? tree) 99 | (not (avl-root tree))) 100 | 101 | 102 | ;; Create copy of the AVL tree. 103 | ;; Pretty cheap since nodes are immutable. 104 | (define (avl-copy tree) 105 | (match tree 106 | ((avl <=? =? root) 107 | (avl <=? =? root)))) 108 | 109 | 110 | ;; Create new tree including given value. 111 | (define (avl-add tree value) 112 | (match tree 113 | ((avl <=? =? root) 114 | (avl <=? =? (add <=? =? root value))))) 115 | 116 | 117 | ;; Modify an existing tree to include given value. 118 | (define (avl-add! tree value) 119 | (match tree 120 | ((avl <=? =? root) 121 | (set-avl-root! tree (add <=? =? root value))))) 122 | 123 | 124 | ;; Perform the non-modifying addition of a value into the tree. 125 | (define (add <=? =? parent new-value) 126 | (match parent 127 | ((node left right value height) 128 | (cond 129 | ((=? value new-value) 130 | (make-node left right new-value)) 131 | 132 | ((<=? new-value value) 133 | (rebalance 134 | (make-node (add <=? =? left new-value) right value))) 135 | 136 | (else 137 | (rebalance 138 | (make-node left (add <=? =? right new-value) value))))) 139 | 140 | (else 141 | (make-node #f #f new-value)))) 142 | 143 | 144 | ;; Rebalance tree node if required. 145 | (define (rebalance parent) 146 | (match parent 147 | ((node left right value _) 148 | (cond 149 | ((= (balance parent) 2) 150 | (if (= (balance left) -1) 151 | (let ((left (rotate-left left))) 152 | (rotate-right (make-node left right value))) 153 | (rotate-right parent))) 154 | 155 | ((= (balance parent) -2) 156 | (if (= (balance right) 1) 157 | (let ((right (rotate-right right))) 158 | (rotate-left (make-node left right value))) 159 | (rotate-left parent))) 160 | 161 | (else parent))))) 162 | 163 | 164 | ;; Create right-rotated version of the node. 165 | (define (rotate-right parent) 166 | (match parent 167 | ((node left right value _) 168 | (match left 169 | ((node l-left l-right l-value _) 170 | (let ((new-right (make-node l-right right value))) 171 | (make-node l-left new-right l-value))))))) 172 | 173 | 174 | ;; Create left-rotated version of the node. 175 | (define (rotate-left parent) 176 | (match parent 177 | ((node left right value _) 178 | (match right 179 | ((node r-left r-right r-value _) 180 | (let ((new-left (make-node left r-left value))) 181 | (make-node new-left r-right r-value))))))) 182 | 183 | 184 | ;; Create new node, automatically computing height using the 185 | ;; higher of left and right children. 186 | (define (make-node left right value) 187 | (node left right value (add1 (max (height right) (height left))))) 188 | 189 | 190 | ;; Return height of node or 0 for #f. 191 | (define (height maybe-node) 192 | (if maybe-node (node-height maybe-node) 0)) 193 | 194 | 195 | ;; Return balance for node or 0 for #f. 196 | (define (balance maybe-node) 197 | (match maybe-node 198 | ((node left right _ _) 199 | (- (height left) 200 | (height right))) 201 | 202 | (else 0))) 203 | 204 | 205 | ;; Return minimal (leftmost) value in the tree. 206 | (define (avl-min tree) 207 | (match tree 208 | ((avl _ _ #f) 209 | (error 'avl-min "empty tree")) 210 | 211 | ((avl _ _ root) 212 | (leftmost root)))) 213 | 214 | 215 | ;; Return maximal (rightmost) value in the tree. 216 | (define (avl-max tree) 217 | (match tree 218 | ((avl _ _ #f) 219 | (error 'avl-min "empty tree")) 220 | 221 | ((avl _ _ root) 222 | (rightmost root)))) 223 | 224 | 225 | ;; Recursively reach leftmost value in the tree of nodes. 226 | (define (leftmost parent) 227 | (match parent 228 | ((node #f _ value _) 229 | (begin value)) 230 | 231 | ((node left _ _ _) 232 | (leftmost left)))) 233 | 234 | 235 | ;; Recursively reach rightmost value in the tree of nodes. 236 | (define (rightmost parent) 237 | (match parent 238 | ((node _ #f value _) 239 | (begin value)) 240 | 241 | ((node _ right _ _) 242 | (rightmost right)))) 243 | 244 | 245 | ;; Return tree's minimal item and a new tree without it. 246 | (define (avl-pop-min tree) 247 | (match tree 248 | ((avl _ _ #f) 249 | (error 'avl-pop-min "empty tree")) 250 | 251 | ((avl <=? =? root) 252 | (let-values (((value new-root) (pop-min root))) 253 | (values value (avl <=? =? new-root)))))) 254 | 255 | 256 | ;; Remove tree's minimal item and return it. 257 | (define (avl-pop-min! tree) 258 | (match tree 259 | ((avl _ _ #f) 260 | (error 'avl-pop-min! "empty tree")) 261 | 262 | ((avl _ _ root) 263 | (let-values (((value new-root) (pop-min root))) 264 | (set-avl-root! tree new-root) 265 | (begin value))))) 266 | 267 | 268 | ;; Recursively rebuild nodes without the leftmost node, 269 | ;; returning it's value and a new tree of nodes. 270 | (define (pop-min parent) 271 | (match parent 272 | ((node #f right value _) 273 | (values value right)) 274 | 275 | ((node left right value _) 276 | (let-values (((result left) (pop-min left))) 277 | (values result (rebalance (make-node left right value))))))) 278 | 279 | 280 | ;; Return tree's maximal item and a new tree without it. 281 | (define (avl-pop-max tree) 282 | (match tree 283 | ((avl _ _ #f) 284 | (error 'avl-pop-max "empty tree")) 285 | 286 | ((avl <=? =? root) 287 | (let-values (((value new-root) (pop-max root))) 288 | (values value (avl <=? =? new-root)))))) 289 | 290 | 291 | ;; Remove tree's maximal item and return it. 292 | (define (avl-pop-max! tree) 293 | (match tree 294 | ((avl _ _ #f) 295 | (error 'avl-pop-max! "empty tree")) 296 | 297 | ((avl _ _ root) 298 | (let-values (((value new-root) (pop-max root))) 299 | (set-avl-root! tree new-root) 300 | (begin value))))) 301 | 302 | 303 | ;; Recursively rebuild nodes without the rightmost node, 304 | ;; returning it's value and a new tree of nodes. 305 | (define (pop-max parent) 306 | (match parent 307 | ((node left #f value _) 308 | (values value left)) 309 | 310 | ((node left right value _) 311 | (let-values (((result right) (pop-max right))) 312 | (values result (rebalance (make-node left right value))))))) 313 | 314 | 315 | ;; Return new AVL tree without specified value. 316 | (define (avl-remove tree value) 317 | (match tree 318 | ((avl <=? =? root) 319 | (with-handlers ((boolean? (λ _ tree))) 320 | (let ((new-root (remove-value <=? =? root value))) 321 | (avl <=? =? new-root)))))) 322 | 323 | 324 | ;; Remove specified value from the AVL tree. 325 | (define (avl-remove! tree value) 326 | (match tree 327 | ((avl <=? =? root) 328 | (with-handlers ((boolean? void)) 329 | (let ((new-root (remove-value <=? =? root value))) 330 | (set-avl-root! tree new-root)))))) 331 | 332 | 333 | ;; Return node tree without specified target. 334 | ;; If the value is not present within the tree, raise #f. 335 | (define (remove-value <=? =? parent victim) 336 | (match parent 337 | ((node left right value _) 338 | (cond 339 | ((=? value victim) 340 | (cond 341 | ((and left right) 342 | (let-values (((value right) (pop-min right))) 343 | (rebalance (make-node left right value)))) 344 | 345 | (else 346 | (or left right)))) 347 | 348 | ((<=? victim value) 349 | (let ((left (remove-value <=? =? left victim))) 350 | (rebalance (make-node left right value)))) 351 | 352 | (else 353 | (let ((right (remove-value <=? =? right victim))) 354 | (rebalance (make-node left right value)))))) 355 | 356 | (else (raise #f)))) 357 | 358 | 359 | ;; Determine whether the tree contains specified value. 360 | (define (avl-contains? tree value) 361 | (match tree 362 | ((avl <=? =? root) 363 | (contains? <=? =? root value)))) 364 | 365 | 366 | ;; Return value corresponding to specified needle. 367 | (define (contains? <=? =? parent needle) 368 | (match parent 369 | ((node left right value _) 370 | (cond 371 | ((=? value needle) 372 | (begin #t)) 373 | 374 | ((<=? needle value) 375 | (contains? <=? =? left needle)) 376 | 377 | (else 378 | (contains? <=? =? right needle)))) 379 | 380 | (else #f))) 381 | 382 | ;; Determine whether the tree contains specified value. 383 | ;; Return the needle contained by the tree 384 | (define (avl-search tree value) 385 | (match tree 386 | ((avl <=? =? root) 387 | (find <=? =? root value)))) 388 | 389 | 390 | ;; Return value corresponding to specified needle. 391 | (define (find <=? =? parent needle) 392 | (match parent 393 | ((node left right value _) 394 | (cond 395 | ((=? value needle) 396 | (begin value)) 397 | ((<=? needle value) 398 | (find <=? =? left needle)) 399 | (else 400 | (find <=? =? right needle)))) 401 | (else #f))) 402 | 403 | 404 | ;; Create ordered value sequence. 405 | (define (in-avl tree) 406 | (in-generator 407 | (let iterate ((parent (avl-root tree))) 408 | (match parent 409 | ((node left right value _) 410 | (iterate left) 411 | (yield value) 412 | (iterate right)) 413 | 414 | (else #t))))) 415 | 416 | 417 | ;; Create reverse ordered value sequence. 418 | (define (in-avl/reverse tree) 419 | (in-generator 420 | (let iterate ((parent (avl-root tree))) 421 | (match parent 422 | ((node left right value _) 423 | (iterate right) 424 | (yield value) 425 | (iterate left)) 426 | 427 | (else #t))))) 428 | 429 | 430 | ;; Convert the tree to a list. 431 | (define (avl->list tree) 432 | (for/list ((x (in-avl tree))) x)) 433 | 434 | 435 | ;; Mirror the node children 436 | (define (mirror tree) 437 | (match tree 438 | [(node left right val _) 439 | (make-node (mirror right) (mirror left) val)] 440 | [else #f])) 441 | 442 | 443 | ;; Mirror (invert) a new tree 444 | (define (avl-mirror tree) 445 | (match tree 446 | [(avl <=? =? root) 447 | (avl <=? =? (mirror root))])) 448 | 449 | 450 | ;; Mirror (invert) an existing tree 451 | (define (avl-mirror! tree) 452 | (set-avl-root! tree (mirror (avl-root tree)))) 453 | 454 | ; vim:set ts=2 sw=2 et: 455 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang setup/infotab 2 | 3 | (define collection 'multi) 4 | (define deps '("base" "scribble-lib")) 5 | (define build-deps '("racket-doc")) 6 | 7 | ; vim:set ts=2 sw=2 et: 8 | --------------------------------------------------------------------------------