type set = | Empty | Node of set * elt * set * int let invalid_arg = Empty let height t = match t with | Empty -> i0 | Node(_, _, _, h) -> h let create l vb r = match vb with | Box k -> begin match l with | Empty -> begin match r with | Empty -> begin match gte i0 i0 with | True -> Node(l, k, r, plus i0 i1) | False -> Node(l, k, r, plus i0 i1) end | Node(_, _, _, i) -> begin match gte i0 i with | True -> Node(l, k, r, plus i0 i1) | False -> Node(l, k, r, plus i i1) end end | Node(_, _, _, i) -> begin match r with | Empty -> begin match gte i i0 with | True -> Node(l, k, r, plus i i1) | False -> Node(l, k, r, plus i0 i1) end | Node(_, _, _, i2) -> begin match gte i i2 with | True -> Node(l, k, r, plus i i1) | False -> Node(l, k, r, plus i2 i1) end end end let bal l vb r = match vb with | Box k -> begin match l with | Empty -> begin match r with | Empty -> begin match gt i0 (plus i0 i2) with | True -> invalid_arg | False -> begin match gt i0 (plus i0 i2) with | True -> invalid_arg | False -> begin match gte i0 i0 with | True -> Node(l, k, r, plus i0 i1) | False -> Node(l, k, r, plus i0 i1) end end end | Node(l1, k1, r1, i) -> begin match gt i0 (plus i i2) with | True -> invalid_arg | False -> begin match gt i (plus i0 i2) with | True -> begin match gte (height r1) (height l1) with | True -> create (create l (Box k) l1) (Box k1) r1 | False -> begin match l1 with | Empty -> invalid_arg | Node(l1, k2, r, _) -> create (create l (Box k) l1) (Box k2) (create r (Box k1) r1) end end | False -> begin match gte i0 i with | True -> Node(l, k, r, plus i0 i1) | False -> Node(l, k, r, plus i i1) end end end end | Node(l1, k1, r1, i) -> begin match r with | Empty -> begin match gt i (plus i0 i2) with | True -> begin match gte (height l1) (height r1) with | True -> create l1 (Box k1) (create r1 (Box k) r) | False -> begin match r1 with | Empty -> invalid_arg | Node(l, k2, r1, _) -> create (create l1 (Box k1) l) (Box k2) (create r1 (Box k) r) end end | False -> begin match gt i0 (plus i i2) with | True -> invalid_arg | False -> begin match gte i i0 with | True -> Node(l, k, r, plus i i1) | False -> Node(l, k, r, plus i0 i1) end end end | Node(l2, k2, r2, i3) -> begin match gt i (plus i3 i2) with | True -> begin match gte (height l1) (height r1) with | True -> create l1 (Box k1) (create r1 (Box k) r) | False -> begin match r1 with | Empty -> invalid_arg | Node(l, k2, r1, _) -> create (create l1 (Box k1) l) (Box k2) (create r1 (Box k) r) end end | False -> begin match gt i3 (plus i i2) with | True -> begin match gte (height r2) (height l2) with | True -> create (create l (Box k) l2) (Box k2) r2 | False -> begin match l2 with | Empty -> invalid_arg | Node(l1, k1, r, _) -> create (create l (Box k) l1) (Box k1) (create r (Box k2) r2) end end | False -> begin match gte i i3 with | True -> Node(l, k, r, plus i i1) | False -> Node(l, k, r, plus i3 i1) end end end end end let rec add xb t = match xb with | Box a -> begin match t with | Empty -> Node(Empty, a, Empty, i1) | Node(l, k, r, _) -> begin match compare a k with | Eq -> t | Lt -> bal (add (Box a) l) (Box k) r | Gt -> bal l (Box k) (add (Box a) r) end end let singleton xb = match xb with | Box k -> Node(Empty, k, Empty, i1) let rec min_elt t = match t with | Empty -> None | Node(Empty, u, _, _) -> Some u | Node(Node(l, k, r, i), _, _, _) -> min_elt (Node(l, k, r, i)) let rec max_elt t = match t with | Empty -> None | Node(_, u, Empty, _) -> Some u | Node(_, _, Node(l, k, r, i), _) -> max_elt (Node(l, k, r, i))