namespace PurelyFunctionalDataStructures

#light

type Heap<'a> =
| E
| T of int * 'a * Heap<'a> * Heap<'a> 

module LeftistHeap =
    exception EmptyException

    let empty = E

    let rank h =
        match h with
        | E -> 0
        | T(r, _,_,_) -> r

    let makeT x a b =
        if rank a >= rank b then
            T(rank b + 1, x, a, b)
        else
            T(rank a + 1, x, b, a)

    let isEmpty h =
        if h = E then 
            true
        else
            false

    let rec merge l r =
        match l,r with
        | l,E -> l
        | E,r -> r
        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
            if lx <= rx then
                makeT lx la (merge lb rh)
            else
                makeT rx ra (merge lh rb)

    let insert x h =
        merge (T(1,x,E,E)) h

    let findMin = function
        | E -> raise EmptyException
        | T(_,x,a,b) -> x

    let deleteMin = function
        | E -> raise EmptyException
        | T(_,x,a,b) -> merge a b

    let rec eq l r =
        let res = match l,r with
                    | E,E -> true
                    | E,T(_,_,_,_) -> false
                    | T(_,_,_,_),E -> false
                    | T(lrank, lval, lchildLeft, lchildRight) as left, (T(rrank, rval, rchildLeft, rchildRight) as right) ->
                        lrank = rrank && lval = rval && (eq lchildLeft rchildLeft) && (eq lchildRight rchildRight)
        if not res then
            printfn "left: %A\nright: %A" l r

        res

    let count h =
        let rec count' h acc cont =
            match h with
            | E -> cont (acc)
            | T(_,_,left,right) ->
                let f = (fun lc -> count' right lc cont)
                count' left (acc+1) f

        count' h 0 (fun (x: int) -> x)

    // Excercise 3.2
    let rec insert3_2 x h =
        match h with
        | E -> T(1, x, E, E)
        | T(_, value, left, right) ->
            if (x <= value) then
                makeT x E h
            else
                makeT value left (insert3_2 x right)

    // Excercise 3.3
    let fromList l =
        let singletons = List.map (fun v -> T(1,v,E,E)) l

        let rec reMerge l acc =
            match l with
            | [] -> E, acc
            | h::[] -> h, acc
            | h1::h2::t ->
                let acc = acc + 1
                let rest = reMerge t acc
                (merge (merge h1 h2) (fst(rest))), snd(rest)

        let result = reMerge singletons 0
        printfn "Merge count %d" (snd(result))

        fst(result)

module WeightBiasedLeftistHeap =
    exception EmptyException

    let size h =
        let rec count' h acc cont =
            match h with
            | E -> cont (acc)
            | T(_,_,left,right) ->
                let f = (fun lc -> count' right lc cont)
                count' left (acc+1) f

        count' h 0 (fun (x: int) -> x)

    let weight h =
        match h with
        | E -> 0
        | T(w, _,_,_) -> w
        
    let makeT x a b =
        let weightA = weight a
        let weightB = weight b
        if weightA >= weightB then
            T(weightA + weightB + 1, x, a, b)
        else
            T(weightA + weightB + 1, x, b, a)

    let isEmpty h =
        if h = E then 
            true
        else
            false

    // excercise 3.4
//    let rec merge3_4 l r =
//        match l,r with
//        | l,E -> l
//        | E,r -> r
//        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
//            if lx <= rx then
//                let right = merge3_4 lb rh
//                let weightA = weight la
//                let weightB = weight right
//
//                if weightA >= weightB then
//                    T(weightA + weightB + 1, lx, la, right)
//                else
//                    T(weightA + weightB + 1, lx, right, la)
//            else
//                let right = merge3_4 lh rb
//                let weightA = weight ra
//                let weightB = weight right
//
//                makeT rx ra (merge lh rb)

    // excercise 3.4
    // this doesn't work, I couldn't figure out how to do this in a single pass
    let merge3_4 l r =
        let rec merge' l r value leftChild  =
            match l,r with
            | l,E -> makeT value leftChild l
            | E,r -> makeT value leftChild r
            | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
                if lx <= rx then
                    merge' lb rh lx la   //(fun h -> makeT(lx, la, h))
                else
                    merge' lh rb rx ra   //(fun h -> makeT(rx, ra, h))

        match l, r with
        | l, E -> l
        | E, r -> r
        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
            let lf = fun h -> makeT(lx, la, h)
            if lx <= rx then
                merge' lb rh lx la // (fun h -> makeT(lx, la, h))
            else
                merge' lh rb rx ra // (fun h -> makeT(rx, ra, h))

    let rec merge l r =
        match l,r with
        | l,E -> l
        | E,r -> r
        | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
            if lx <= rx then
                makeT lx la (merge lb rh)
            else
                makeT rx ra (merge lh rb)

    let insert x h =
        merge (T(1,x,E,E)) h

    let insert3_4 x h =
        merge3_4 (T(1,x,E,E)) h

    let findMin = function
        | E -> raise EmptyException
        | T(_,x,a,b) -> x

    let deleteMin = function
        | E -> raise EmptyException
        | T(_,x,a,b) -> merge a b

    let rec eq l r =
        let res = match l,r with
                    | E,E -> true
                    | E,T(_,_,_,_) -> false
                    | T(_,_,_,_),E -> false
                    | T(lweight, lval, lchildLeft, lchildRight) as left, (T(rweight, rval, rchildLeft, rchildRight) as right) ->
                        lweight = rweight && lval = rval && (eq lchildLeft rchildLeft) && (eq lchildRight rchildRight)
        if not res then
            printfn "left: %A\nright: %A" l r

        res