BTree Variants
Whenever I code Data structures like BTree,LSM etc. in OCaml I read SML,Rust or C++ code. The code I read is in a repo. that implements a caching layer or DBs like https://rethinkdb.com. I don’t find any direct OCaml references. So I ported this Haskell two-three tree by http://matthew.brecknell.net/post/btree-gadt/…. Moreover since I am learning it is hard to identify succinct functional code as some examples seem to be imperative.
Two-Three BTree
type ('n, 'a) n =
| Type1 of ('n, 'a) t * 'a * ('n, 'a) t
| Type2 of ('n, 'a) t * 'a * ('n, 'a) t * 'a * ('n, 'a) t
and ('n, 'a) t =
| BR of('n, 'a) n
| LF
type ('n, 'a ) tree = Tree of ('n, 'a ) t
type ('n, 'a, 't ) normal_replace = ('n, 'a ) t -> 't
type ('n, 'a, 't ) insert_or_pushup = ('n, 'a ) t -> 'a -> ('n, 'a ) t -> 't
type order = LESS | EQUAL | GREATER
let compare k1 k2 : order =
if k1 < k2 then LESS
else if k1 = k2 then EQUAL
else GREATER
let compare_normal v1 v2 v1_lessthan_V2 v1_equalto_v2 v1_greaterthan_v2 =
match compare v2 v2 with
| LESS -> v1_lessthan_V2
| EQUAL -> v1_equalto_v2
| GREATER -> v1_greaterthan_v2
let compare_pushup v1 v2 v3 v1_lessthan_V2 v1_equalto_v2 v1_between v1_equalto_v3 v1_greaterthan_v3 =
compare_normal v1 v2 v1_lessthan_V2 v1_equalto_v2 ( compare_normal v1 v3 v1_between v1_equalto_v3 v1_greaterthan_v3 )
let insert (value:int) tree =
let rec ins t normal_replace insert_or_pushup =
match t with
| LF -> insert_or_pushup LF value LF
| BR br ->
match br with
| Type1 ( a, b, c ) ->
let v1_lessthan_v2 =
ins a (fun k -> normal_replace (BR (Type1 (k,b,c))))
(fun p q r -> normal_replace (BR (Type2 (p, q, r, b, c )))) in
let v1_greaterthan_v2 =
ins c (fun k -> normal_replace (BR ((Type1 (a, b, k)))))
(fun p q r -> normal_replace (BR ((Type2 (a, b, p, q, r ))))) in
let v1_equalto_v2 = normal_replace (BR ((Type1 (a, value, c)))) in
compare_normal value b v1_lessthan_v2 v1_greaterthan_v2 v1_equalto_v2
| Type2( a, b, c, d, e ) ->
let v1_lessthan_v2 =
ins a (fun k -> normal_replace (BR (Type2 (k,b,c,d,e))))
(fun p q r -> insert_or_pushup (BR (Type1 (p, q, r))) b (BR (Type1 (c, d, e)))) in
let v1_between =
ins c (fun k -> normal_replace (BR (Type2 (a,b,k,d,e))))
(fun p q r -> insert_or_pushup (BR (Type1 (a, b, p))) q (BR (Type1 (r, d, a) ))) in
let v1_greaterthan_v3 =
ins e (fun k -> normal_replace (BR (Type2 (a,b,c,d,k))))
(fun p q r -> insert_or_pushup (BR (Type1 (a, b, c))) d (BR (Type1 (p, q, r) ))) in
let v1_equalto_v2 = normal_replace (BR ((Type2 (a, value, c, d, e)))) in
let v1_equalto_v3 = normal_replace (BR ((Type2 (a, b, c, value, e)))) in
compare_pushup value b d v1_lessthan_v2 v1_between v1_greaterthan_v3 v1_equalto_v2 v1_equalto_v3
in
ins tree (fun t -> t)(fun a b c -> BR(Type1( a, b, c)))
let rec print_bTree (bTree: ('n, 'a) t) d : unit =
begin match bTree with
|LF -> ()
|BR n->
begin match n with
| (Type1 ( a,b,c)) ->
print_bTree a (d + 1);
for __i=0 to (d - 1) do
Printf.printf " "
done;
Printf.printf "%d \n" b;
print_bTree c (d+1);
| (Type2 ( a,b,c,d,e)) ->
print_bTree a (d + 1);
for __i=0 to (d - 1) do
Printf.printf " "
done;
Printf.printf "%d %d\n" b d;
print_bTree c (d+1);
print_bTree e (d+1);
end;
end;
The print_bTree function prints all the values when I tested even though it may not be in an order that proves that the two-three BTree is storing values properly.
Development Environment
Since my Spacemacs IDE broke after I upgraded to a newer version of Emacs I decided to move to a new environment - Doom Emacs.