module SortedMap = (* // let avl = // ['a'..'z'] |> List.fold (fun avl char -> // AvlTree.insert char char avl // ) AvlTree.empty // // avl |> AvlTree.min // 'z' // avl |> AvlTree.max // 'a' // avl |> AvlTree.exists 'b' // true // avl |> AvlTree.find 'd' // Some 'd' // avl |> AvlTree.size // 26 // avl |> AvlTree.value // 'p' (root node) // // let avl2 = avl |> AvlTree.delete 'd' // // avl2 |> AvlTree.exists 'd' // false // avl2 |> AvlTree.size // 25 *) open System.Collections open System.Collections.Generic type Node<'k, 'v> when 'k : comparison = Empty | Node of 'k * 'v * int * int * Node<'k, 'v> * Node<'k, 'v> with interface IEnumerable<'v> with member x.GetEnumerator() = let rec inOrder (tree:Node<'k, 'v>) = seq { match tree with | Empty -> yield! Seq.empty | Node(_, v, _, _, l, r) -> yield! inOrder l; yield v; yield! inOrder r } (inOrder x).GetEnumerator() member x.GetEnumerator() = (x :> IEnumerable<'v>).GetEnumerator() :> IEnumerator let empty = Empty let rec min = function | Empty -> failwith "Empty tree" | Node(_, v, _, _, Empty, _) -> v | Node(_, _, _, _, l, _) -> min l let rec max = function | Empty -> failwith "Empty tree" | Node(_, v, _, _, _, Empty) -> v | Node(_, _, _, _, _, r) -> max r let left = function | Node(_, _, _, _, l, _) -> l | Empty -> failwith "Can't get left child of empty node" let right = function | Node(_, _, _, _, _, r) -> r | Empty -> failwith "Can't get right child of empty node" let value = function | Node(_, v, _, _, _, _) -> v | Empty -> failwith "Can't get value of empty node" let size = function | Empty -> 0 | Node(_, _, s, _, _, _) -> s let private sizeOf l r = (size l) + (size r) + 1 let height = function | Empty -> 0 | Node(_, _, _, h, _, _) -> h let private heightOf l r = (Microsoft.FSharp.Core.Operators.max (height l) (height r)) + 1 let private rotateLeft root = match root with | Node(rk, rv, _, rh, rl, Node(pk, pv, _, ph, pl, pr)) -> let root = Node(rk, rv, sizeOf rl pl, heightOf rl pl, rl, pl) Node(pk, pv, sizeOf root pr, heightOf root pr, root, pr) | _ -> failwith "Can't rotate tree left" let private rotateRight root = match root with | Node(rk, rv, _, rh, Node(pk, pv, _, ph, pl, pr), rr) -> let root = Node(rk, rv, sizeOf pr rr, heightOf pr rr, pr, rr) Node(pk, pv, sizeOf root pl, heightOf root pl, pl, root) | _ -> failwith "Can't rotate tree right" let private balanceOf l r = (height l) - (height r) let balance = function | Empty -> 0 | Node(_, _, _, _, l, r) -> balanceOf l r let private rebalance k v l r = let h = heightOf l r let s = sizeOf l r match balanceOf l r with | -2 -> rotateLeft (match balance r with | 1 -> Node(k, v, s, h, l, rotateRight r) | _ -> Node(k, v, s, h, l, r)) | 2 -> rotateRight (match balance l with | -1 -> Node(k, v, s, h, rotateLeft l, r) | _ -> Node(k, v, s, h, l, r)) | _ -> Node(k, v, s, h, l, r) let inOrderPrev (tree:Node<'k, 'v>) = let rec prev prevVal tree = match tree with | Empty -> Empty | Node(k, v, _, _, l, Empty) -> prevVal := Some(k, v); l | Node(k, v, s, h, l, r) -> let r = prev prevVal r Node(k, v, sizeOf l r, h, l, r) let prevVal = ref None match tree with | Empty -> Empty, !prevVal | Node(_, _, _, _, l, _) -> prev prevVal l, !prevVal let inOrderNext (tree:Node<'k, 'v>) = let rec next nextVal tree = match tree with | Empty -> Empty | Node(k, v, _, _, Empty, r) -> nextVal := Some(k, v); r | Node(k, v, s, h, l, r) -> let l = next nextVal l Node(k, v, sizeOf l r, h, l, r) let nextVal = ref None match tree with | Empty -> Empty, !nextVal | Node(_, _, _, _, _, r) -> next nextVal r, !nextVal let rec find key (tree:Node<'k, 'v>) = match tree with | Empty -> None | Node(k, v, _, _, l, r) -> if key < k then find key l elif key > k then find key r else Some v let rec exists key (tree:Node<'k, 'v>) = tree |> find key |> Option.isSome let rec insert key value (tree:Node<'k, 'v>) = match tree with | Empty -> Node(key, value, 1, 1, Empty, Empty) | Node(k, v, s, h, l, r) -> if key < k then rebalance k v (insert key value l) r elif key > k then rebalance k v l (insert key value r) else Node(key, value, s, h, l, r) let rec delete key (tree:Node<'k, 'v>) = match tree with | Empty -> Empty | Node(k, v, _, _, l, r) -> if key < k then rebalance k v (delete key l) r elif key > k then rebalance k v l (delete key r) else match inOrderPrev tree with | _, None -> match inOrderNext tree with | _, None -> Empty | r, Some(k, v) -> rebalance k v l r | l, Some(k, v) -> rebalance k v l r let rec preOrder (tree:Node<'k, 'v>) = seq { match tree with | Empty -> yield! Seq.empty | Node(_, v, _, _, l, r) -> yield v; yield! preOrder l; yield! preOrder r } let rec postOrder (tree:Node<'k, 'v>) = seq { match tree with | Empty -> yield! Seq.empty | Node(_, v, _, _, l, r) -> yield! postOrder l; yield! postOrder r; yield v } let levelOrder (tree:Node<'k, 'v>) = let queue = new Queue>() tree |> queue.Enqueue seq { while queue.Count > 0 do let node = queue.Dequeue() yield node |> value node |> left |> queue.Enqueue node |> right |> queue.Enqueue }