Find "nearest" value in BST, inspired by: https://github.com/andy-young/Coders-Workshop/blob/master/Coding-Challenges/binarySearch/binarySearch.md

BinarySearchTree.re

open Typeclasses;

// a binary search tree is a binary tree that holds order-able members and
// keeps lesser values on the left and greater or equal values on the right
module Make = (Order: Ord) => {
  type t =
    | Empty
    | Node(t, Order.t, t);

  // O(log n) operation to add a new value in a valid position in the tree
  let rec insert = v =>
    fun
    | Empty => Node(Empty, v, Empty)
    | Node(l, x, r) =>
      switch (Order.compare(v, x)) {
      | LT => Node(insert(v, l), x, r)
      | GT
      | EQ => Node(l, x, insert(v, r))
      };

  // Breadth-first iteration over the tree that collects each row of
  // values as strings
  let visualize = (show, tree) => {
    let getValues =
      fun
      | Empty => None
      | Node(l, x, r) => (l, x, r)->Some;

    let rec revList: 'a. (list('a), list('a)) => list('a) =
      acc =>
        fun
        | [] => acc
        | [x, ...xs] => revList([x, ...acc], xs);

    let rev = xs => revList([], xs);
    let append: 'a. ('a, list('a)) => list('a) =
      (x, xs) => rev([x, ...rev(xs)]);
    let maybeAppend = (x, xs) =>
      switch (x) {
      | None => xs
      | Some(v) => append(v, xs)
      };

    let rec go = (acc: list(string), row) =>
      switch (row) {
      | [] => acc
      | xs =>
        let (stringRow, next) =
          Belt.List.reduce(
            xs,
            ("", []),
            ((str, next), (l, x, r)) => {
              let next =
                next
                |> maybeAppend(getValues(l))
                |> maybeAppend(getValues(r));
              (str ++ " " ++ show(x), next);
            },
          );
        go(append(stringRow, acc), next);
      };

    getValues(tree)->Belt.Option.mapWithDefault([], v => go([], [v]));
  };

  // When the inner type is also a member of Ring, we can find the closest
  // value to a target value, then use that strategy over the entire tree
  // to find the nearest that exists in the tree relative to a given target
  module RingTree = (Ring: Ring with type t = Order.t) => {
    let negate = a => Ring.subtract(Ring.zero, a);
    let abs = a =>
      switch (Order.compare(a, Ring.zero)) {
      | LT => negate(a)
      | GT
      | EQ => a
      };

    let closer = (target, a, b) => {
      let distanceA = abs(Ring.subtract(target, a));
      let distanceB = abs(Ring.subtract(target, b));
      switch (Order.compare(distanceA, distanceB)) {
      | EQ
      | LT => a
      | GT => b
      };
    };

    let nearest = (v, tree) => {
      let newBest = possible =>
        fun
        | Some(existing) => Some(closer(v, existing, possible))
        | None => Some(possible);

      let rec go = best =>
        fun
        | Empty => best
        | Node(l, x, r) =>
          switch (Order.compare(v, x)) {
          | EQ => Some(v)
          | LT => go(newBest(x, best), l)
          | GT => go(newBest(x, best), r)
          };

      go(None, tree);
    };
  };
};

Index.re

open Typeclasses;

// we begin with some Int-specific typeclass implementations
module IntRing: Ring with type t = int = {
  type t = int;
  let zero = 0;
  let one = 1;
  let add = (+);
  let subtract = (-);
  let multiply = ( * );
};

module IntOrder: Ord with type t = int = {
  type t = int;
  let compare = (a: int, b: int) => a == b ? Ordering.EQ : a < b ? LT : GT;
};

// using those typeclasses, we can construct an Int BST that includes
// all of the functions that require Int to be a member of Ord and Ring
module IntTree = {
  module InnerTree = Tree(IntOrder);
  include InnerTree;
  include RingTree(IntRing);
  let visualize = visualize(string_of_int);
};

let tree =
  IntTree.(
    insert(3, Empty)
    |> insert(2)
    |> insert(7)
    |> insert(9)
    |> insert(1)
    |> insert(6)
  );

let rows = IntTree.visualize(tree);
Belt.List.forEach(rows, Js.log); // " 3" \n " 2 7" \n " 1 6 9"
Js.log(IntTree.nearest(5, tree)); // Some(6)

Typeclasses.re

module Ordering = {
  type t = | GT | EQ | LT;
};

// typeclass that captures simple mathematic operations
module type Semiring = {
  type t;
  let add: (t, t) => t;
  let multiply: (t, t) => t;
  let zero: t;
  let one: t;
};

// adds subtraction to the simpler math functions
module type Ring = {
  include Semiring;
  let subtract: (t, t) => t;
};

module type Ord = {
  type t;
  let compare: (t, t) => Ordering.t;
};