# dok/example/red-black-tree

This example is taken from https://rosettacode.org/wiki/Algebraic_data_types

In the below code: R stays for red; B for black; T for tree; E for empty tree.

The Haskell code is compact, because it uses pattern matching.

data Color = R | B
data Tree a = E | T Color (Tree a) a (Tree a)

balance :: Color -> Tree a -> a -> Tree a -> Tree a
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)
balance 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)
balance 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)
balance 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)
balance col a x b = T col a x b

insert :: Ord a => a -> Tree a -> Tree a
insert x s = T B a y b where
ins E          =  T R E x E
ins s@(T col a y b)
| x < y      =  balance col (ins a) y b
| x > y      =  balance col a y (ins b)
| otherwise  =  s
T _ a y b = ins s


## Dok code

The Dok code uses transaction semantic instead of pattern matching. It is more verbose, but the mappings between the input tree and the resulting tree are more direct, because named fields are used, instead of equational/positional one.

data Color [
variant ../R
variant ../B
]

data Tree(A::Ord) [
variant ../E
:^# empty leaf

variant ../T [
slot ~::Color
slot left::Self
slot value::A
slot rigth::Self
]

fun !balance {
when self.color.isa(Color/B) {
case {
when self.left.color.isa(R)
when self.left.left.color.isa(R)

set self.color R
set self.left.color: B
set self.value self.left.value
set self.right ../T(
with color B
with left self.left.right
with value self.value
with right self.right
)
} -else {
when self.left.color.isa(R)
when self.left.right.color.isa(R)

set self.color R
set self.left ../T(
with color B
with left self.left.left
with value self.right.value
with right ../T(
with color B
with left self.right.right
with value self.value
with right self.right))
} -else {
when self.right.color.isa(R)
when self.right.left.color.isa(R)

set self.color R
set self.left ../T(
with color B
with left self.left
with value self.value
with right self.right.left)
set value self.right.left.value
set self.right ../T(
with color B
with left self.right.left.right
with value self.right.value
with right self.right.right)
} -else {
when self.left.color.isa(R)
when self.right.color.isa(R)

set self.color R
set self.left ../T(
with color B
with left self.left
with value self.value
with right self.right.left)
set self.value self.right.value
set self.right ../T(
with color B
with left self.right.right.left
with value self.right.right.value
with right self.right.right.right)
}
}
}

fun !_insert(x::A) {
case-on self -isa ../E {
set self ../T(
with color R
with left ../E
with value x
with right ../E)

} -isa ../T {
try self.value -when ~ > x {
do self.left.!_insert(x)
} -when ~ < x {
do self.right.!_insert(x)
}
}
}

fun !insert(x::A) {
do self.!_insert(x)
set self.color Color/B
}
}