(* 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