Skip to content

Instantly share code, notes, and snippets.

@aboekhoff

aboekhoff/red-black-trees.scm

Created September 2, 2010 00:51
Show Gist options
  • Save aboekhoff/561648 to your computer and use it in GitHub Desktop.
Save aboekhoff/561648 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
red-black-trees.scm
;;;; red-black-trees, based on the Functional Pearls article:
;;;; 'Red-Black Trees in a Functional Setting' by Chris Okasaki, 1993
(define-type R | B) ;; red black
(define-type T color left elt right) ;; tree
(define rbt:insert
x t -> (match (rbt:insert* x t)
(T _ a y b) -> (T B a y b)))
;;;; sadly will probably need to rewrite this using a more complicated
;;;; folding operation in order to make it iterative
;;;; keeping the pretty abstraction for now
(define rbt:insert*
x (Empty) -> (T R Empty x Empty)
x (T c a y b) -> (cond
(< x y) (rbt:balance c (rbt:insert* x a) y b)
(> x y) (rbt:balance c a y (rbt:insert* x b))
else (T c a y b)))
(define rbt:balance
B (T R (T R a x b) y c) z d -> (T R (T B a x b) y (T B c z d))
B (T R a x (T R b y c)) z d -> (T R (T B a x b) y (T B c z d))
B a x (T R (T R b y c) z d) -> (T R (T B a x b) y (T B c z d))
B a x (T R b y (T R c z d)) -> (T R (T B a x b) y (T B c z d))
color a x b -> (T color a x b))
(define rbt:member?
x (Empty) -> false
x (T _ a y b) -> (cond
(< x y) (rbt:member? x a)
(> x y) (rbt:member? x b)
else true))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment