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.

image-title-here

Written on January 30, 2024