Juliet

(* Treap.fsi *)
module Treap
    [<Sealed>]
    type Treap<'a> =
        member Contains : v:'a -> bool
        member Insert : v:'a -> Treap<'a>
        member Remove : v:'a -> Treap<'a>
        member Split : v:'a -> Treap<'a> * bool * Treap<'a>
        member Count : int
        member Max : 'a
        member Min : 'a

    val empty : ('a -> 'a -> int) -> Treap<'a>
    val toSeq : Treap<'a> -> seq<'a>
    val toSeqBack : Treap<'a> -> seq<'a>

(* Treap.fs *)
module Treap
    open System

    type 'a treap =
        | Nil of ('a -> 'a -> int) * Random
        | Node of ('a -> 'a -> int) * Random * int * 'a treap * 'a * 'a treap * int
        with
            member this.Comparer =
                match this with
                | Nil(comparer, rnd) -> comparer
                | Node(comparer, rnd, priority, left, x, right, count) -> comparer

            member this.Rnd =
                match this with
                | Nil(comparer, rnd) -> rnd
                | Node(comparer, rnd, priority, left, x, right, count) -> rnd

            member this.Priority =
                match this with
                | Nil(comparer, rnd) -> Int32.MinValue
                | Node(comparer, rnd, priority, left, x, right, count) -> priority

            member this.Left =
                match this with
                | Nil(comparer, rnd) -> failwith "Empty treap"
                | Node(comparer, rnd, priority, left, x, right, count) -> left

            member this.Right =
                match this with
                | Nil(comparer, rnd) -> failwith "Empty treap"
                | Node(comparer, rnd, priority, left, x, right, count) -> right

            member this.Value =
                match this with
                | Nil(comparer, rnd) -> failwith "Empty treap"
                | Node(comparer, rnd, priority, left, x, right, count) -> x

            member this.Count =
                match this with
                | Nil(comparer, rnd) -> 0
                | Node(comparer, rnd, priority, left, x, right, count) -> count

            member this.Min =
                match this with
                | Nil(comparer, rnd) -> failwith "Empty treap"
                | Node(comparer, rnd, priority, Nil(comparer', rnd'), x, right, count) -> x
                | Node(comparer, rnd, priority, left, x, right, count) -> left.Min

            member this.Max =
                match this with
                | Nil(comparer, rnd) -> failwith "Empty treap"
                | Node(comparer, rnd, priority, left, x, Nil(comparer', rnd'), count) -> x
                | Node(comparer, rnd, priority, left, x, right, count) -> right.Max

            member this.IsEmpty =
                match this with
                | Nil(comparer, rnd) -> true
                | Node(comparer, rnd, priority, left, x, right, count) -> false



    let nil f = Nil(f, new Random())
    let nextPriority (rnd : Random) = rnd.Next(Int32.MinValue, Int32.MaxValue)
    let makeWithPriority (l : 'a treap, v, r : 'a treap, priority) = Node(l.Comparer, l.Rnd, priority, l, v, r, l.Count + r.Count + 1)
    let make(l : 'a treap, v, r) = makeWithPriority(l, v, r, l.Rnd.Next(Int32.MinValue, Int32.MaxValue))

    (*
         q      Right Rotation       p
       /   \    --------------+    /   \
      p     c                     a     q
     / \        Left Rotation          / \
    a   b       +-------------        b   c
    *)

    let rotLeft = function
        | Node(pcomparer, prnd, ppriority, a, p, Node(qcomparer, qrnd, qpriority, b, q, c, qcount), pcount) ->
            makeWithPriority(makeWithPriority(a, p, b, ppriority), q, c, qpriority)
        | node -> node

    let rotRight = function
        | Node(qcomparer, qrnd, qpriority, Node(pcomparer, prnd, ppriority, a, p, b, pcount), q, c, qcount) ->
            makeWithPriority(a, p, makeWithPriority(b, q, c, qpriority), ppriority)
        | node -> node

    let balLeft = function
        | Node(comparer, rnd, priority, l, x, r, count) as node when priority < l.Priority -> rotRight node
        | node -> node

    let balRight = function
        | Node(comparer, rnd, priority, l, x, r, count) as node when priority < r.Priority -> rotLeft node
        | node -> node

    let rec contains v = function
        | Nil(comparer, rnd) -> false
        | Node(comparer, rnd, priority, left, x, right, count) ->
            let compare = comparer v x
            if compare < 0 then contains v left
            elif compare > 0 then contains v right
            else true

    let rec insert v = function
        | Nil(comparer, rnd) as node -> make(node, v, node)
        | Node(comparer, rnd, priority, left, x, right, count) as node ->
            let compare = comparer v x
            if compare < 0 then makeWithPriority(insert v left, x, right, priority) |> balLeft
            elif compare > 0 then makeWithPriority(left, x, insert v right, priority) |> balRight
            else node

    let rec remove v = function
        | Nil(comparer, rnd) as node -> node
        | Node(comparer, rnd, priority, left, x, right, count) as node ->
            let compare = comparer v x
            if compare < 0 then makeWithPriority(remove v left, x, right, priority)
            elif compare > 0 then makeWithPriority(left, x, remove v right, priority)
            else
                if not (left.IsEmpty) then
                    let successor = left.Max
                    let l' = remove successor left
                    makeWithPriority(l', successor, right, priority)
                elif not (right.IsEmpty) then
                    let successor = right.Min
                    let r' = remove successor right
                    makeWithPriority(left, successor, r', priority)
                else
                    left // guaranteed to be nil

    let rec split v = function
        | Nil(comparer, rnd) as node -> node, false, node
        | Node(comparer, rnd, priority, left, x, right, count) as node ->
            let compare = comparer v x
            if compare < 0 then
                let left', found, r' = split v left
                let right' = makeWithPriority(r', x, right, priority)
                left', found, right'
            elif compare > 0 then
                let l', found, right' = split v right
                let left' = makeWithPriority(left, x, l', priority)
                left', found, right'
            else
                left, true, right

    (*
    // used for debugging in fsi

    let print t =
        let rec loop indent = function
            | Nil(comparer, rnd) -> ()
            | Node(comparer, rnd, priority, left, x, right, count) ->
                let spaces = new String(' ', indent * 4)
                loop (indent + 1) right
                printfn "%s(%s, %i)" spaces (x.ToString()) priority
                loop (indent + 1) left
        loop 0 t

    let insert' v t =
        let t' = insert v t
        print t'
        t'

    let remove' v t =
        let t' = remove v t
        print t'
        t'

    *)

    [<Sealed>]
    type Treap<'a>(t : 'a treap) =
        member this.Internal = t
        member this.Insert v = Treap(insert v t)
        member this.Remove v = Treap(remove v t)
        member this.Split v = let l, found, r = split v t in Treap(l), found, Treap(r)
        member this.Contains v = contains v t
        member this.Count = t.Count
        member this.Min = t.Min
        member this.Max = t.Max

    let empty f = Treap(nil f)

    let toSeq (t : Treap<'a>) =
        let rec loop = function
            | Nil(comparer, rnd) -> Seq.empty
            | Node(comparer, rnd, priority, l, x, r, count) -> seq { yield! loop l; yield x; yield! loop r }
        loop t.Internal

    let toSeqBack (t : Treap<'a>) =
        let rec loop = function
            | Nil(comparer, rnd) -> Seq.empty
            | Node(comparer, rnd, priority, l, x, r, count) -> seq { yield! loop r; yield x; yield! loop l }
        loop t.Internal