I've got 99 Problems - and OCaml is all of them (Binary Trees)

Problemset

Construct completely balanced binary trees. (medium)

In OCaml, one can define a new type binary_tree that carries an arbitrary value of type 'a at each node.

# type 'a binary_tree =
    | Empty
    | Node of 'a * 'a binary_tree * 'a binary_tree;;
type 'a binary_tree = Empty | Node of 'a * 'a binary_tree * 'a binary_tree

let rec cbal_tree nodes =
if nodes = 0 then [Empty] else
let rec attach_deep v = function
| [] -> []
| hd :: tl -> Node ("x", v, hd) :: attach_deep v tl in
let rec attach lis = function
| [] -> []
| hd :: tl -> attach_deep hd lis @ attach lis tl in
let lhs = (nodes-1)/2 in
let rhs = (nodes-1) - ((nodes-1)/2) in
if nodes % 2 = 1 then attach (cbal_tree lhs) (cbal_tree rhs) else attach (cbal_tree lhs) (cbal_tree rhs) @ attach (cbal_tree rhs) (cbal_tree lhs)
;;

Symmetric binary trees. (medium)

let rec is_mirror lhs rhs =
match (lhs, rhs) with
| (Empty, Empty) -> true
| (Node (_, l1, r1), Node (_, l2, r2)) -> if is_mirror l1 r2 && is_mirror l2 r1 then true else false
| _ -> false;;

let is_symmetric = function
| Empty -> true
| Node (v, l, r) -> is_mirror l r
;;

Binary search trees (dictionaries). (medium)

let construct lis =
let rec insert v = function
| Empty -> Node (v, Empty, Empty)
| Node (hv, l, r) as orig -> if v < hv then Node (hv, insert v l, r) else if v > hv then Node (hv, l, insert v r) else orig
in
let rec aux tree = function
| [] -> tree
| h :: t -> insert h (aux tree t)
in
aux Empty (List.rev lis);;

Generate-and-test paradigm. (medium)

let sym_cbal_trees nodes =
List.filter ~f:(fun x -> is_symmetric x) (cbal_tree nodes);;

Construct height-balanced binary trees. (medium)

let rec hbal_tree height =
if height = 0 then [Empty] else
if height = 1 then [Node ("x", Empty, Empty)] else
let rec attach_deep v = function
| [] -> []
| hd :: tl -> Node ("x", v, hd) :: attach_deep v tl in
let rec attach lis = function
| [] -> []
| hd :: tl -> attach_deep hd lis @ attach lis tl in
let lhs = height-2 in
let rhs = height-1 in
attach (hbal_tree lhs) (hbal_tree rhs) @ attach (hbal_tree rhs) (hbal_tree lhs) @ attach (hbal_tree rhs) (hbal_tree rhs);;