diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/baltree.ml | 193 | ||||
| -rw-r--r-- | stdlib/baltree.mli | 77 |
2 files changed, 0 insertions, 270 deletions
diff --git a/stdlib/baltree.ml b/stdlib/baltree.ml deleted file mode 100644 index 6ecf9cf626..0000000000 --- a/stdlib/baltree.ml +++ /dev/null @@ -1,193 +0,0 @@ -(* Weight-balanced binary trees. - These are binary trees such that one child of a node has at most N times - as many elements as the other child. We take N=3. *) - -type 'a t = Empty | Node of 'a t * 'a * 'a t * int - (* The type of trees containing elements of type ['a]. - [Empty] is the empty tree (containing no elements). *) - -type 'a contents = Nothing | Something of 'a - (* Used with the functions [modify] and [List.split], to represent - the presence or the absence of an element in a tree. *) - -(* Compute the size (number of nodes and leaves) of a tree. *) - -let size = function - Empty -> 1 - | Node(_, _, _, s) -> s - -(* Creates a new node with left son l, value x and right son r. - l and r must be balanced and size l / size r must be between 1/N and N. - Inline expansion of size for better speed. *) - -let new l x r = - let sl = match l with Empty -> 0 | Node(_,_,_,s) -> s in - let sr = match r with Empty -> 0 | Node(_,_,_,s) -> s in - Node(l, x, r, sl + sr + 1) - -(* Same as new, but performs rebalancing if necessary. - Assumes l and r balanced, and size l / size r "reasonable" - (between 1/N^2 and N^2 ???). - Inline expansion of new for better speed in the most frequent case - where no rebalancing is required. *) - -let bal l x r = - let sl = match l with Empty -> 0 | Node(_,_,_,s) -> s in - let sr = match r with Empty -> 0 | Node(_,_,_,s) -> s in - if sl > 3 * sr then begin - match l with - Empty -> invalid_arg "Baltree.bal" - | Node(ll, lv, lr, _) -> - if size ll >= size lr then - new ll lv (new lr x r) - else begin - match lr with - Empty -> invalid_arg "Baltree.bal" - | Node(lrl, lrv, lrr, _)-> - new (new ll lv lrl) lrv (new lrr x r) - end - end else if sr > 3 * sl then begin - match r with - Empty -> invalid_arg "Baltree.bal" - | Node(rl, rv, rr, _) -> - if size rr >= size rl then - new (new l x rl) rv rr - else begin - match rl with - Empty -> invalid_arg "Baltree.bal" - | Node(rll, rlv, rlr, _) -> - new (new l x rll) rlv (new rlr rv rr) - end - end else - Node(l, x, r, sl + sr + 1) - -(* Same as bal, but rebalance regardless of the original ratio - size l / size r *) - -let rec join l x r = - match bal l x r with - Empty -> invalid_arg "Baltree.join" - | Node(l', x', r', _) as t' -> - let sl = size l' and sr = size r' in - if sl > 3 * sr or sr > 3 * sl then join l' x' r' else t' - -(* Merge two trees l and r into one. - All elements of l must precede the elements of r. - Assumes size l / size r between 1/N and N. *) - -let rec merge t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) -> - bal l1 v1 (bal (merge r1 l2) v2 r2) - -(* Same as merge, but does not assume anything about l and r. *) - -let rec concat t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) -> - join l1 v1 (join (concat r1 l2) v2 r2) - -(* Insertion *) - -let add searchpred x t = - let rec add = function - Empty -> - Node(Empty, x, Empty, 1) - | Node(l, v, r, _) as t -> - let c = searchpred v in - if c == 0 then t else - if c < 0 then bal (add l) v r else bal l v (add r) - in add t - -(* Membership *) - -let contains searchpred t = - let rec contains = function - Empty -> false - | Node(l, v, r, _) -> - let c = searchpred v in - if c == 0 then true else - if c < 0 then contains l else contains r - in contains t - -(* Search *) - -let find searchpred t = - let rec find = function - Empty -> - raise Not_found - | Node(l, v, r, _) -> - let c = searchpred v in - if c == 0 then v else - if c < 0 then find l else find r - in find t - -(* Deletion *) - -let remove searchpred t = - let rec remove = function - Empty -> - Empty - | Node(l, v, r, _) -> - let c = searchpred v in - if c == 0 then merge l r else - if c < 0 then bal (remove l) v r else bal l v (remove r) - in remove t - -(* Modification *) - -let modify searchpred modifier t = - let rec modify = function - Empty -> - begin match modifier Nothing with - Nothing -> Empty - | Something v -> Node(Empty, v, Empty, 1) - end - | Node(l, v, r, s) -> - let c = searchpred v in - if c == 0 then - begin match modifier(Something v) with - Nothing -> merge l r - | Something v' -> Node(l, v', r, s) - end - else if c < 0 then bal (modify l) v r else bal l v (modify r) - in modify t - -(* Splitting *) - -let split searchpred = - let rec split = function - Empty -> - (Empty, Nothing, Empty) - | Node(l, v, r, _) -> - let c = searchpred v in - if c == 0 then (l, Something v, r) - else if c < 0 then - let (ll, vl, rl) = split l in (ll, vl, join rl v r) - else - let (lr, vr, rr) = split r in (join l v lr, vr, rr) - in split - -(* Comparison (by lexicographic ordering of the fringes of the two trees). *) - -let compare cmp s1 s2 = - let rec compare_aux l1 l2 = - match (l1, l2) with - ([], []) -> 0 - | ([], _) -> -1 - | (_, []) -> 1 - | (Empty::t1, Empty::t2) -> - compare_aux t1 t2 - | (Node(Empty, v1, r1, _) :: t1, Node(Empty, v2, r2, _) :: t2) -> - let c = cmp v1 v2 in - if c != 0 then c else compare_aux (r1::t1) (r2::t2) - | (Node(l1, v1, r1, _) :: t1, t2) -> - compare_aux (l1 :: Node(Empty, v1, r1, 0) :: t1) t2 - | (t1, Node(l2, v2, r2, _) :: t2) -> - compare_aux t1 (l2 :: Node(Empty, v2, r2, 0) :: t2) - in - compare_aux [s1] [s2] diff --git a/stdlib/baltree.mli b/stdlib/baltree.mli deleted file mode 100644 index 4e6f35efbb..0000000000 --- a/stdlib/baltree.mli +++ /dev/null @@ -1,77 +0,0 @@ -(* Basic balanced binary trees *) - -(* This module implements balanced ordered binary trees. - All operations over binary trees are applicative (no side-effects). - The [set] and [List.map] modules are based on this module. - This modules gives a more direct access to the internals of the - binary tree implementation than the [set] and [List.map] abstractions, - but is more delicate to use and not as safe. For advanced users only. *) - -type 'a t = Empty | Node of 'a t * 'a * 'a t * int - (* The type of trees containing elements of type ['a]. - [Empty] is the empty tree (containing no elements). *) - -type 'a contents = Nothing | Something of 'a - (* Used with the functions [modify] and [List.split], to represent - the presence or the absence of an element in a tree. *) - -val add: ('a -> int) -> 'a -> 'a t -> 'a t - (* [add f x t] inserts the element [x] into the tree [t]. - [f] is an ordering function: [f y] must return [0] if - [x] and [y] are equal (or equivalent), a negative integer if - [x] is smaller than [y], and a positive integer if [x] is - greater than [y]. The tree [t] is returned unchanged if - it already contains an element equivalent to [x] (that is, - an element [y] such that [f y] is [0]). - The ordering [f] must be consistent with the orderings used - to build [t] with [add], [remove], [modify] or [List.split] - operations. *) -val contains: ('a -> int) -> 'a t -> bool - (* [contains f t] checks whether [t] contains an element - satisfying [f], that is, an element [x] such - that [f x] is [0]. [f] is an ordering function with the same - constraints as for [add]. It can be coarser (identify more - elements) than the orderings used to build [t], but must be - consistent with them. *) -val find: ('a -> int) -> 'a t -> 'a - (* Same as [contains], except that [find f t] returns the element [x] - such that [f x] is [0], or raises [Not_found] if none has been - found. *) -val remove: ('a -> int) -> 'a t -> 'a t - (* [remove f t] removes one element [x] of [t] such that [f x] is [0]. - [f] is an ordering function with the same constraints as for [add]. - [t] is returned unchanged if it does not contain any element - satisfying [f]. If several elements of [t] satisfy [f], - only one is removed. *) -val modify: ('a -> int) -> ('a contents -> 'a contents) -> 'a t -> 'a t - (* General insertion/modification/deletion function. - [modify f g t] searchs [t] for an element [x] satisfying the - ordering function [f]. If one is found, [g] is applied to - [Something x]; if [g] returns [Nothing], the element [x] - is removed; if [g] returns [Something y], the element [y] - replaces [x] in the tree. (It is assumed that [x] and [y] - are equivalent, in particular, that [f y] is [0].) - If the tree does not contain any [x] satisfying [f], - [g] is applied to [Nothing]; if it returns [Nothing], - the tree is returned unchanged; if it returns [Something x], - the element [x] is inserted in the tree. (It is assumed that - [f x] is [0].) The functions [add] and [remove] are special cases - of [modify], slightly more efficient. *) -val split: ('a -> int) -> 'a t -> 'a t * 'a contents * 'a t - (* [split f t] returns a triple [(less, elt, greater)] where - [less] is a tree containing all elements [x] of [t] such that - [f x] is negative, [greater] is a tree containing all - elements [x] of [t] such that [f x] is positive, and [elt] - is [Something x] if [t] contains an element [x] such that - [f x] is [0], and [Nothing] otherwise. *) -val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int - (* Compare two trees. The first argument [f] is a comparison function - over the tree elements: [f e1 e2] is zero if the elements [e1] and - [e2] are equal, negative if [e1] is smaller than [e2], - and positive if [e1] is greater than [e2]. [compare f t1 t2] - compares the fringes of [t1] and [t2] by lexicographic extension - of [f]. *) -(*--*) -val join: 'a t -> 'a -> 'a t -> 'a t -val concat: 'a t -> 'a t -> 'a t - |