// Code from Hansen and Rischel: Functional Programming using F#     16/12 2012
// Chapter 6: Finite trees. Just from the sections 6.1, 6.2 and 6.3

// From Section 6.1 Chinese boxes

type Colour = Red | Blue | Green | Yellow | Purple;;

type Cbox = | Nothing                         // 1.
            | Cube of float * Colour * Cbox;; // 2.

let cb1 = Cube(0.5, Red, Nothing);;
let cb2 = Cube(1.0, Green, cb1);;
let cb3 = Cube(2.0, Yellow, cb2);;

let rec count = function
    | Nothing       -> 0
    | Cube(r,c,cb)  -> 1 + count cb;;

let rec insert(r,c,cb) =
  if r <= 0.0 then failwith "ChineseBox"
  else match cb with
       | Nothing         -> Cube(r,c,Nothing)
       | Cube(r1,c1,cb1) ->
             match compare r r1 with
             | t when t > 0 -> Cube(r,c,cb)
             | 0            -> failwith "ChineseBox"
             | _            -> Cube(r1,c1,insert(r,c,cb1));;


type Cbox1 = | Single of float * Colour
             | Multiple of float * Colour * Cbox1;;

let rec count1 = function
  | Single _         -> 1
  | Multiple(_,_,cb) -> 1 + count1 cb;;

let rec insert1 (r1,c1,cb2) =
  if r1 <= 0.0 then failwith "insert1: Chinese box"
  else match cb2 with
       | Single (r2,c2)       ->
         match compare r1 r2 with
         | t when t < 0 -> Multiple(r2,c2,Single(r1,c1))
         | 0            -> failwith "ChineseBox"
         |  _           -> Multiple(r1,c1,cb2)
       | Multiple (r2,c2,cb3) ->
         match compare r1 r2 with
         | t when t < 0 -> Multiple(r2,c2,insert1(r1,c1,cb3))
         | 0            -> failwith "ChineseBox"
         | _            -> Multiple(r1,c1,cb2);;


// From Section 6.2 6.2 Symbolic differentiation

type Fexpr = | Const of float
             | X
             | Add of Fexpr * Fexpr
             | Sub of Fexpr * Fexpr
             | Mul of Fexpr * Fexpr
             | Div of Fexpr * Fexpr
             | Sin of Fexpr
             | Cos of Fexpr
             | Log of Fexpr
             | Exp of Fexpr;;

let rec D = function
  | Const _    -> Const 0.0
  | X          -> Const 1.0
  | Add(fe,ge) -> Add(D fe, D ge)
  | Sub(fe,ge) -> Sub(D fe, D ge)
  | Mul(fe,ge) -> Add(Mul(D fe, ge), Mul(fe, D ge))
  | Div(fe,ge) -> Div(Sub(Mul(D fe,ge), Mul(fe,D ge)),
                      Mul(ge,ge))
  | Sin fe     -> Mul(Cos fe, D fe)
  | Cos fe     -> Mul(Const -1.0, Mul(Sin fe, D fe))
  | Log fe     -> Div(D fe, fe)
  | Exp fe     -> Mul(Exp fe, D fe);;

let rec toString = function
    | Const x       -> string x
    | X             -> "x"
    | Add(fe1,fe2)  -> "(" + (toString fe1) + ")"
                       + " + " + "(" + (toString fe2) + ")"
    | Sub(fe1,fe2)  -> "(" + (toString fe1) + ")"
                       + " - " + "(" + (toString fe2) + ")"
    | Mul(fe1,fe2)  -> "(" + (toString fe1) + ")"
                       + " * " + "(" + (toString fe2) + ")"
    | Div(fe1,fe2)  -> "(" + (toString fe1) + ")"
                       + " / " + "(" + (toString fe2) + ")"
    | Sin fe        -> "(sin " + (toString fe) + ")"
    | Cos fe        -> "(cos " + (toString fe) + ")"
    | Log fe        -> "(log " + (toString fe) + ")"
    | Exp fe        -> "(exp " + (toString fe) + ")";;


// From Section 6.3 Binary trees. Parameterized types

type BinTree<'a,'b> =
     | Leaf of 'a
     | Node of BinTree<'a,'b> * 'b * BinTree<'a,'b>;;

let t1 = Node(Node(Leaf 1,"cd",Leaf 2),"ab",Leaf 3);;

let rec depth = function
    | Leaf _        -> 0
    | Node(t1,_,t2) -> 1 + max (depth t1) (depth t2);;