(*  This program contains two different implementations of binary search
    trees, the first in a purely functional style, and the second in 
    a more conventional style, but which still take advantage of functional
    features and pattern matching.
*)

// binary search trees, purely functional style (non-destructive trees).
open System;
open Option;

type 'a bst when 'a:comparison = Nil | Node of ('a * 'a bst * 'a bst);;

let rec insert x tree =   // insert x into tree 
  match tree with
    | Nil -> Node(x,Nil,Nil)
    | Node(y,left,right) when x<y -> Node(y,(insert x left),right)
    | Node(y,left,right) when x>y -> Node(y,left,(insert x right))
    | _ -> tree;;

let rec search(x,tree) = // search for x in tree
  match tree with
    | Nil -> false
    | Node(y,_,_) when x=y -> true
//    | Node(y,_,_) -> if x=y then true else false
    | Node(y,left,_) when x<y -> search(x,left)
    | Node(y,_,right) -> search(x,right);;

let rec inorder f tree =
  match tree with
    | Nil -> ()  // () is "unit", do nothing
    | Node(x,left,right) ->
       inorder f left
       f x
       inorder f right;;

// f is a function of type a -> a -> b, id is of type b
let rec reduce_postorder f id = function
    | Nil -> id
    | Node(x,left,right) ->
       reduce_postorder f id left
       |>
       f (reduce_postorder f id right)
       |> f x;;

let rec tostring = function //tree = // convert tree into string
    | Nil -> ""
    | Node(x,left,right) -> tostring(left)+" "+string(x)+tostring(right);;

let mutable tree = Nil;
for x in [6;8;2;4;1;9;5] do
  tree <- insert x tree

Console.WriteLine(tostring(tree));

let mutable size = 0
inorder (fun x -> size<-size+1) tree
printfn "size of tree is %d" size;

printfn "product of tree is %d" (reduce_postorder (*) 1 tree)
printfn "sum of tree is %d" (reduce_postorder (+) 0 tree)

// LL rotation
let LL = function
  | Node(x,Node(y,ll,lr),r) -> Node(y,ll,Node(x,lr,r))
  | t -> t;;


///// SECOND VERSION
/////////////////// The records/option approach (more efficient)

type Bstnode<'a> when 'a:comparison =
  { mutable value:'a;
    mutable left: Bstnode<'a> option;
    mutable right: Bstnode<'a> option;
  };;

type Tree<'T> when 'T:comparison = option<Bstnode<'T>>   // type alias

let newnode x = {Bstnode.value=x; left=None; right=None};

// The Bstnode.value helps to distinguish Bstnode records from other
// records that might have fields with the same names.

let rec add x node =
  match node with
   | { value=y; left=None; right=_; } when x<y ->
      node.left <- Some(newnode x)
   | { value=y; left=Some(lf); right=_; } when x<y ->
      add x lf
   | { value=y; left=_; right=None; } when x>y ->
      node.right <- Some(newnode x)
   | { value=y; left=_; right=Some(rt); } when x>y ->
      add x rt
   | _ -> ();  // default do nothing (return unit)

// add_to is defined on Tree<'t> (option type)
let add_to x tree =
  match tree with
    | None -> Some(newnode x)
    | Some(node) ->  add x node;  tree;;

let rec contains x = function // short for tree = match tree with ...
   | {value=y; left=_; right=_} when x=y -> true
   | {value=y; left=Some(lf); right=_} when x<y -> contains x lf
   | {value=y; left=_; right=Some(rt)} when x>y -> contains x rt
   | _ -> false; // false in all other cases

let rec search_for x = function
  | None -> false
  | Some(node) -> contains x node;;

// to delete from binary search tree, replace value at node with largest
// value on the left subtree, if it exists, if not, move right tree up.
// delete returns tree: call with tree <- delete x tree.  Delete is also
// defined on option<Bstnode<'T>>.
// Function delmax deletes the right-most (largest) node on a tree branch
// and returns the largest value deleted.
// Function delete, defined on option<Bstnode<'t>>,
// then calls delmax when it finds the node with the value to delete.
// Both delmax and delete must return option<Bstnode<'t>> types, so
// delete should be called as in tree <- delete x tree

let rec delmax node =
  match node with
    | {value=_; left=_; right=Some(rt)} as treen ->
       let (newtree,max) = delmax rt
       treen.right <- newtree 
       (Some(treen), max)  // returns pair
    | {value=x; left=lf; right=None} ->
       (lf,x) // return left subtree (option type) along with max value

let rec delete x optree =
  match optree with
    | Some({value=y; left=lf; right=_} as tree) when x<y ->
         tree.left <- delete x lf;
         optree 
    | Some({value=y; left=_; right=rt} as tree) when x>y ->
         tree.right <- delete x rt;
         optree
    | Some({value=y; left=None; right=_} as tree) when x=y -> tree.right
    | Some({value=y; left=Some(lf); right=_} as tree) when x=y ->
        let (newtree, max) = delmax lf
        tree.left <- newtree
        tree.value <- max
        optree
    | _ -> optree;; // default unchanged	


// what type does this have?
let rec map_inorder f = function
   | None -> ()
   | Some({value=x; left=lf; right=rt}) ->
      map_inorder f lf
      f x
      map_inorder f rt;;

let node2 = newnode(5);
for x in [4;8;7;9;3;2;1] do
   add x node2;;

map_inorder (printf "%d ") (Some(node2));
printfn ""
let tree3 = delete 3 (Some node2);
map_inorder (printf "%d ") tree3
let mutable sum = 0;
size <- 0;  // size already declared above
map_inorder (fun y -> (sum <- sum + y; size<-size+1)) tree3
printfn "\nsum of all numbers in tree3 = %A" sum;
printfn "size of tree3 = %A" size;
printfn "\nsearch 2: %A" (search_for 2 tree3);
printfn "search 0: %A" (search_for 0 tree3);

// The following version of tree traversal, this time preorder, is 
// designed to allow the function being applied to a node to be aware
// of its parent node, if there is one.  Through its parent it would be
// able to reach its siblings and other relatives in the tree.  The
// function preorder takes a *Curried* function f as argument.
// f is expected to be of type option<Bstnode<'T>> -> 'T -> unit.
// The first argument is the parent and the second the value at each node.
// The inner recursive function takes a function (fp) that is just
// f already applied to a parent argument.  This example illustrates the 
// value of Curried functions.
let preorder f tree = 
  let rec preorder_with_parent fp = function
    | None -> ()
    | Some({value=x; left=lf; right=rt}) as node ->
       fp x
       preorder_with_parent (f node) lf
       preorder_with_parent (f node) rt;
  preorder_with_parent (f None) tree;; // start with no parent

(Some node2) 
|>
(
  (fun parent v -> 
     match parent with
       | None -> printfn "%A is the root" v
       | Some({value=x;}) -> printfn "%A has parent %A" v x
  )
  |>
  preorder
);;

(* Output:
 1 2 4 5 6 8 9
size of tree is 7
product of tree is 17280
sum of tree is 35
1 2 3 4 5 7 8 9
1 2 4 5 7 8 9
sum of all numbers in tree3 = 36
size of tree3 = 7

search 2: true
search 0: false
5 is the root
4 has parent 5
2 has parent 4
1 has parent 2
8 has parent 5
7 has parent 8
9 has parent 8
*)