1:   module SortedMap =
  2: 
  3:     (*
  4:     //  let avl =
  5:     //    ['a'..'z'] |> List.fold (fun avl char ->
  6:     //      AvlTree.insert char char avl
  7:     //    ) AvlTree.empty
  8:     //  
  9:     //  avl |> AvlTree.min // 'z'
 10:     //  avl |> AvlTree.max // 'a'
 11:     //  avl |> AvlTree.exists 'b' // true
 12:     //  avl |> AvlTree.find 'd' // Some 'd'
 13:     //  avl |> AvlTree.size // 26
 14:     //  avl |> AvlTree.value // 'p' (root node)
 15:     //  
 16:     //  let avl2 = avl |> AvlTree.delete 'd' // 
 17:     //  avl2 |> AvlTree.exists 'd' // false
 18:     //  avl2 |> AvlTree.size // 25
 19:     *)
 20: 
 21:     open System.Collections
 22:     open System.Collections.Generic
 23: 
 24:     type Node<'k, 'v> when 'k : comparison
 25:       = Empty
 26:       | Node of 'k * 'v * int * int * Node<'k, 'v> * Node<'k, 'v>
 27:       with
 28:         interface IEnumerable<'v> with
 29:           member x.GetEnumerator() =
 30:             let rec inOrder (tree:Node<'k, 'v>) =
 31:               seq {
 32:                 match tree with
 33:                 | Empty -> yield! Seq.empty
 34:                 | Node(_, v, _, _, l, r) -> 
 35:                   yield! inOrder l; yield v; yield! inOrder r
 36:               }
 37: 
 38:             (inOrder x).GetEnumerator()
 39: 
 40:           member x.GetEnumerator() =
 41:             (x :> IEnumerable<'v>).GetEnumerator() :> IEnumerator
 42: 
 43:     let empty = Empty
 44:     
 45:     let rec min = function
 46:       | Empty -> failwith "Empty tree"
 47:       | Node(_, v, _, _, Empty, _) -> v
 48:       | Node(_, _, _, _, l, _) -> min l 
 49: 
 50:     let rec max = function
 51:       | Empty -> failwith "Empty tree"
 52:       | Node(_, v, _, _, _, Empty) -> v
 53:       | Node(_, _, _, _, _, r) -> max r
 54:       
 55:     let left = function
 56:       | Node(_, _, _, _, l, _) -> l
 57:       | Empty -> failwith "Can't get left child of empty node"
 58: 
 59:     let right = function
 60:       | Node(_, _, _, _, _, r) -> r
 61:       | Empty -> failwith "Can't get right child of empty node"
 62: 
 63:     let value = function
 64:       | Node(_, v, _, _, _, _) -> v
 65:       | Empty -> failwith "Can't get value of empty node"
 66: 
 67:     let size = function
 68:       | Empty -> 0
 69:       | Node(_, _, s, _, _, _) -> s
 70: 
 71:     let private sizeOf l r = 
 72:       (size l) + (size r) + 1
 73: 
 74:     let height = function
 75:       | Empty -> 0
 76:       | Node(_, _, _, h, _, _) -> h
 77:       
 78:     let private heightOf l r =
 79:       (Microsoft.FSharp.Core.Operators.max (height l) (height r)) + 1
 80: 
 81:     let private rotateLeft root =
 82:       match root with
 83:       | Node(rk, rv, _, rh, rl, Node(pk, pv, _, ph, pl, pr)) ->
 84:         let root = Node(rk, rv, sizeOf rl pl, heightOf rl pl, rl, pl)
 85:         Node(pk, pv, sizeOf root pr, heightOf root pr, root, pr)
 86:       
 87:       | _ -> failwith "Can't rotate tree left"
 88: 
 89:     let private rotateRight root =
 90:       match root with
 91:       | Node(rk, rv, _, rh, Node(pk, pv, _, ph, pl, pr), rr) ->
 92:         let root = Node(rk, rv, sizeOf pr rr, heightOf pr rr, pr, rr)
 93:         Node(pk, pv, sizeOf root pl, heightOf root pl, pl, root)
 94: 
 95:       | _ -> failwith "Can't rotate tree right"
 96: 
 97:     let private balanceOf l r = 
 98:       (height l) - (height r)
 99: 
100:     let balance = function
101:       | Empty -> 0
102:       | Node(_, _, _, _, l, r) -> balanceOf l r
103: 
104:     let private rebalance k v l r =
105:       let h = heightOf l r 
106:       let s = sizeOf l r
107: 
108:       match balanceOf l r with
109:       | -2 ->
110:         rotateLeft 
111:          (match balance r with
112:           | 1 -> Node(k, v, s, h, l, rotateRight r)
113:           | _ -> Node(k, v, s, h, l, r))
114: 
115:       | 2 ->
116:         rotateRight
117:          (match balance l with
118:           | -1 -> Node(k, v, s, h, rotateLeft l, r)
119:           | _ -> Node(k, v, s, h, l, r))
120: 
121:       | _ -> Node(k, v, s, h, l, r)
122: 
123:     let inOrderPrev (tree:Node<'k, 'v>) =
124:       let rec prev prevVal tree = 
125:         match tree with
126:         | Empty -> Empty
127:         | Node(k, v, _, _, l, Empty) -> prevVal := Some(k, v); l
128:         | Node(k, v, s, h, l, r) -> 
129:           let r = prev prevVal r
130:           Node(k, v, sizeOf l r, h, l, r)
131:         
132:       let prevVal = ref None
133: 
134:       match tree with
135:       | Empty -> Empty, !prevVal
136:       | Node(_, _, _, _, l, _) -> prev prevVal l, !prevVal
137: 
138:     let inOrderNext (tree:Node<'k, 'v>) =
139:       let rec next nextVal tree = 
140:         match tree with
141:         | Empty -> Empty
142:         | Node(k, v, _, _, Empty, r) -> nextVal := Some(k, v); r
143:         | Node(k, v, s, h, l, r) -> 
144:           let l = next nextVal l
145:           Node(k, v, sizeOf l r, h, l, r)
146: 
147:       let nextVal = ref None
148: 
149:       match tree with
150:       | Empty -> Empty, !nextVal
151:       | Node(_, _, _, _, _, r) -> next nextVal r, !nextVal
152: 
153:     let rec find key (tree:Node<'k, 'v>) =
154:       match tree with
155:       | Empty -> None
156:       | Node(k, v, _, _, l, r) ->
157:         if key < k
158:           then find key l
159:           elif key > k
160:             then find key r
161:             else Some v
162: 
163:     let rec exists key (tree:Node<'k, 'v>) =
164:       tree |> find key |> Option.isSome
165: 
166:     let rec insert key value (tree:Node<'k, 'v>) =
167:       match tree with
168:       | Empty -> Node(key, value, 1, 1, Empty, Empty)
169:       | Node(k, v, s, h, l, r) -> 
170:         if key < k 
171:           then rebalance k v (insert key value l) r
172:           elif key > k 
173:             then rebalance k v l (insert key value r)
174:             else Node(key, value, s, h, l, r)
175: 
176:     let rec delete key (tree:Node<'k, 'v>) =
177:       match tree with
178:       | Empty -> Empty
179:       | Node(k, v, _, _, l, r) ->
180:         if key < k
181:           then rebalance k v (delete key l) r
182:           elif key > k
183:             then rebalance k v l (delete key r)
184:             else 
185:               match inOrderPrev tree with
186:               | _, None -> 
187:                 match inOrderNext tree with
188:                 | _, None -> Empty
189:                 | r, Some(k, v) -> rebalance k v l r
190:               | l, Some(k, v) -> rebalance k v l r
191: 
192:     let rec preOrder (tree:Node<'k, 'v>) =
193:       seq {
194:         match tree with
195:         | Empty -> yield! Seq.empty
196:         | Node(_, v, _, _, l, r) ->
197:           yield v; yield! preOrder l; yield! preOrder r
198:       }
199: 
200:     let rec postOrder (tree:Node<'k, 'v>) =
201:       seq {
202:         match tree with
203:         | Empty -> yield! Seq.empty
204:         | Node(_, v, _, _, l, r) ->
205:           yield! postOrder l; yield! postOrder r; yield v
206:       }
207: 
208:     let levelOrder (tree:Node<'k, 'v>) =
209:       let queue = new Queue<Node<'k, 'v>>()
210:       tree |> queue.Enqueue
211: 
212:       seq {
213:         while queue.Count > 0 do
214:           let node = queue.Dequeue()
215:           yield node |> value
216:           node |> left |> queue.Enqueue 
217:           node |> right |> queue.Enqueue
218:       }