codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; red-black trees (define (tree c k v l r) (vector c k v l r)) (define empty (tree 'black 'nil 'nil 'nil 'nil)) (define (empty? t) (eqv? t empty)) (define (color t) (vector-ref t 0)) (define (key t) (vector-ref t 1)) (define (value t) (vector-ref t 2)) (define (lkid t) (vector-ref t 3)) (define (rkid t) (vector-ref t 4)) (define (red? c) (eqv? c 'red)) (define (black? c) (eqv? c 'black)) (define (lookup lt? t k) (cond ((empty? t) #f) ((lt? k (key t)) (lookup lt? (lkid t) k)) ((lt? (key t) k) (lookup lt? (rkid t) k)) (else (cons (key t) (value t))))) (define (insert lt? t k v) (define (ins t) (cond ((empty? t) (tree 'red k v empty empty)) ((lt? k (key t)) (balance (color t) (key t) (value t) (ins (lkid t)) (rkid t))) ((lt? (key t) k) (balance (color t) (key t) (value t) (lkid t) (ins (rkid t)))) (else (tree (color t) k v (lkid t) (rkid t))))) (let ((z (ins t))) (tree 'black (key z) (value z) (lkid z) (rkid z)))) (define (balance c k v l r) (cond ((and (black? c) (red? (color l)) (red? (color (lkid l)))) (tree 'red (key l) (value l) (tree 'black (key (lkid l)) (value (lkid l)) (lkid (lkid l)) (rkid (lkid l))) (tree 'black k v (rkid l) r))) ((and (black? c) (red? (color l)) (red? (color (rkid l)))) (tree 'red (key (rkid l)) (value (rkid l)) (tree 'black (key l) (value l) (lkid l) (lkid (rkid l))) (tree 'black k v (rkid (rkid l)) r))) ((and (black? c) (red? (color r)) (red? (color (lkid r)))) (tree 'red (key (lkid r)) (value (lkid r)) (tree 'black k v l (lkid (lkid r))) (tree 'black (key r) (value r) (rkid (lkid r)) (rkid r)))) ((and (black? c) (red? (color r)) (red? (color (rkid r)))) (tree 'red (key r) (value r) (tree 'black k v l (lkid r)) (tree 'black (key (rkid r)) (value (rkid r)) (lkid (rkid r)) (rkid (rkid r))))) (else (tree c k v l r)))) (define (enlist t) (let enlist ((t t) (xs '())) (cond ((empty? t) xs) ((and (empty? (lkid t)) (empty? (rkid t))) (cons (cons (key t) (value t)) xs)) (else (enlist (lkid t) (cons (cons (key t) (value t)) (enlist (rkid t) xs))))))) (define t (insert < (insert < (insert < (insert < (insert < empty 2 "b") 5 "e") 3 "c") 4 "d") 1 "a")) (display (lookup < t 7)) (newline) (display (lookup < t 4)) (newline) (display (enlist t)) (newline)
Private
[
?
]
Run code
Submit