Initial insert-only RB tree implementing a set

This commit is contained in:
Nathan Braswell
2021-08-01 22:15:58 -04:00
parent 537386d97b
commit 93fd0d1943
2 changed files with 47 additions and 0 deletions

32
rb.kp Normal file
View File

@@ -0,0 +1,32 @@
(with_import "./match.kp"
(let (
; ['R ..] or ['B ..] or ['BB]
; possibly temporarily ['BB ..] during rebalencing
empty ['B]
contains? (rec-lambda recurse (t v) (match t
['B] false
[c a x b] (cond (< v x) (recurse a v)
(= v x) true
true (recurse b v))))
blacken (lambda (t) (match t
['R a x b] ['B a x b]
t t))
balance (lambda (t) (match t
['B ['R ['R a x b] y c] z d] ['R ['B a x b] y ['B c z d]]
['B ['R a x ['R b y c]] z d] ['R ['B a x b] y ['B c z d]]
['B a x ['R ['R b y c] z d]] ['R ['B a x b] y ['B c z d]]
['B a x ['R b y ['R c z d]]] ['R ['B a x b] y ['B c z d]]
t t))
insert (lambda (t v) (let (
ins (rec-lambda ins (t) (match t
['B] ['R ['B] v ['B]]
[c a x b] (cond (< v x) (balance [c (ins a) x b])
(= v x) [c a x b]
true (balance [c a x (ins b)]))))
) (blacken (ins t))))
)
(provide empty contains? insert)
))

15
rb_test.kp Normal file
View File

@@ -0,0 +1,15 @@
(with_import "./rb.kp"
(let (
first empty
_ (println first " contains? " 1 " ? " (contains? first 1))
second (insert first 1)
_ (println second " contains? " 1 " ? " (contains? second 1))
third (insert second 2)
_ (println third " contains? " 1 " ? " (contains? third 1))
_ (println third " contains? " 2 " ? " (contains? third 2))
fourth (insert third 3)
_ (println fourth " contains? " 1 " ? " (contains? fourth 1))
_ (println fourth " contains? " 2 " ? " (contains? fourth 2))
_ (println fourth " contains? " 3 " ? " (contains? fourth 3))
_ (println fourth " contains? " 4 " ? " (contains? fourth 4))
) nil))