Btree -> add element with function closures..(toy program not serious)

Learning
1

I decided to challenge myself this weekend with a toy function of my own creation. The function isn’t pratical but it will challenge my understanding of higher order functions… Hopefully.

So what’s the challenge? Create a function…

val findBranchFunc : 'a -> 'a btree -> (unit -> 'a btree) option

…that will return a function to add an element 'a to 'a btree if the element 'a doesn’t exist in 'a btree using closures. Basically the returned function(if it exist) will construct the new btree branch and attach all the not traversed branches. Its basically an add function but it doesn’t construct any data structures until the returned function is called.

Just want the input of the community on this toy function.

The function:

let findBranchFunc elem bt =
  let rec findBranchFuncAux elem bt branchFunc =
    match bt with
    | Empty -> Some (fun () -> branchFunc(Btree(elem, Empty, Empty)))
    | Btree (dt, left, right) ->
      if dt = elem
      then
        None
      else if dt > elem
      then
        findBranchFuncAux elem left 
          (fun node -> branchFunc(Btree(dt, node, right)))
      else
        findBranchFuncAux elem right 
          (fun node -> branchFunc(Btree(dt, left, node))) in
  findBranchFuncAux elem bt (fun node -> node)

A simple program using the function:

module type MyBtreeSig =
  sig

    type 'a btree

    val createEmptyBtree: 'a btree
    val addElementBtree: 'a -> 'a btree -> 'a btree
    val displayBtree: ('a -> string) -> 'a btree -> unit
    val findElementBtree: 'a -> 'a btree -> 'a btree option
    val findBranchFunc: 'a -> 'a btree -> (unit -> 'a btree) option

  end

module MyBtree:MyBtreeSig =
  struct

    type 'a btree = Empty | Btree of ('a * 'a btree * 'a btree)

    let createEmptyBtree = Empty

    let addElementBtree elem bt =
      let origBtree = bt in
      let rec addElementBtreeAux elem bt =
        match bt with
        | Empty -> Btree (elem, Empty, Empty)
        | Btree (dt, left, right) ->
          if dt = elem
          then
            failwith "Element found!"
          else if dt > elem
          then
            Btree (dt, addElementBtreeAux elem left, right)
          else
            Btree (dt, left, addElementBtreeAux elem right) in
      try
        addElementBtreeAux elem bt
      with _ ->
        origBtree

    let rec displayBtree f bt =
      match bt with
      | Empty -> print_endline "Empty"
      | Btree (dt, left, right) ->
        print_endline (f dt);
        displayBtree f left;
        displayBtree f right

    let rec findElementBtree elem bt =
      match bt with
      | Empty -> None
      | Btree (dt, left, right) as btre ->
        if dt = elem
        then
          Some btre
        else if dt > elem
        then
          findElementBtree elem left
        else
          findElementBtree elem right

    let findBranchFunc elem bt =
      let rec findBranchFuncAux elem bt branchFunc =
        match bt with
        | Empty -> Some (fun () -> branchFunc(Btree(elem, Empty, Empty)))
        | Btree (dt, left, right) ->
          if dt = elem
          then
            None
          else if dt > elem
          then
            findBranchFuncAux elem left 
              (fun node -> branchFunc(Btree(dt, node, right)))
          else
            findBranchFuncAux elem right 
              (fun node -> branchFunc(Btree(dt, left, node))) in
      findBranchFuncAux elem bt (fun node -> node)

  end

open MyBtree

let b =
  List.fold_left
    (fun a b -> addElementBtree b a)
    createEmptyBtree
    [10;1;9;2;8;3;7;4;6;5;]

let () = displayBtree string_of_int (addElementBtree (-1) b)

let () = List.iter (fun _ -> print_newline()) [1;2;]

let ans = findBranchFunc (-1) b

let () =
  match ans with
  | None -> print_endline "Nothing"
  | Some f -> displayBtree string_of_int (f())
2

Aside from the specifics of the data structure, could this be implemented by making a standard add function taking another unit argument? The standard Set module is implemented as a tree. To get something similar what you are doing, I could do:

module S = Set.Make(String)

let empty = S.empty
let add str set = fun () -> S.add str set

With types:

val empty : S.t
val add : string -> S.t -> (unit -> S.t)

Returning a function rather than a value comes almost for free. What am I missing here that would make this a challenge beyond implementing the core data structure?

3

Thanks for the reply but I think you missed the spirit of the function. It was an exercise I created for myself to see if I could create the function using closures.
I wanted a returned function that only called the data-structure’s constructor when itself was called. Basically I didn’t want any constructors called if the element already existed.
Basically its like the…

let addElementBtree elem bt =
      let origBtree = bt in
      let rec addElementBtreeAux elem bt =
        match bt with
        | Empty -> Btree (elem, Empty, Empty)
        | Btree (dt, left, right) ->
          if dt = elem
          then
            failwith "Element found!"
          else if dt > elem
          then
            Btree (dt, addElementBtreeAux elem left, right)
          else
            Btree (dt, left, addElementBtreeAux elem right) in
      try
        addElementBtreeAux elem bt
      with _ ->
        origBtree

… but it doesn’t use the exception mechanism to escape constructing the data-structures, it uses closures.

Hope that makes sense.