diff options
| -rw-r--r-- | Changes | 1 | ||||
| -rw-r--r-- | stdlib/map.ml | 116 | ||||
| -rw-r--r-- | stdlib/map.mli | 97 | ||||
| -rw-r--r-- | stdlib/moreLabels.mli | 24 | ||||
| -rw-r--r-- | testsuite/tests/basic/maps.ml | 28 | ||||
| -rw-r--r-- | testsuite/tests/basic/maps.reference | 6 |
6 files changed, 241 insertions, 31 deletions
@@ -83,6 +83,7 @@ Standard library: low level input, value Scanf.stdin has been added. * Random: changed the algorithm to produce better randomness. Now passes the DieHard tests. +- Map: implement functions from Set that make sense for Map. Other libraries: * Str: letters that constitute a word now include digits 0-9 and diff --git a/stdlib/map.ml b/stdlib/map.ml index a159e7aef..3d9597aa0 100644 --- a/stdlib/map.ml +++ b/stdlib/map.ml @@ -25,16 +25,28 @@ module type S = type +'a t val empty: 'a t val is_empty: 'a t -> bool + val mem: key -> 'a t -> bool val add: key -> 'a -> 'a t -> 'a t - val find: key -> 'a t -> 'a + val singleton: key -> 'a -> 'a t val remove: key -> 'a t -> 'a t - val mem: key -> 'a t -> bool + val merge: (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t + val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool val iter: (key -> 'a -> unit) -> 'a t -> unit + val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val for_all: (key -> 'a -> bool) -> 'a t -> bool + val exists: (key -> 'a -> bool) -> 'a t -> bool + val filter: (key -> 'a -> bool) -> 'a t -> 'a t + val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t + val cardinal: 'a t -> int + val bindings: 'a t -> (key * 'a) list + val min_binding: 'a t -> (key * 'a) + val max_binding: 'a t -> (key * 'a) + val choose: 'a t -> (key * 'a) + val split: key -> 'a t -> 'a t * 'a option * 'a t + val find: key -> 'a t -> 'a val map: ('a -> 'b) -> 'a t -> 'b t val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t - val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool end module Make(Ord: OrderedType) = struct @@ -53,6 +65,8 @@ module Make(Ord: OrderedType) = struct let hl = height l and hr = height r in Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1)) + let singleton x d = Node(Empty, x, d, Empty, 1) + let bal l x d r = let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in @@ -119,6 +133,11 @@ module Make(Ord: OrderedType) = struct | Node(Empty, x, d, r, _) -> (x, d) | Node(l, x, d, r, _) -> min_binding l + let rec max_binding = function + Empty -> raise Not_found + | Node(l, x, d, Empty, _) -> (x, d) + | Node(l, x, d, r, _) -> max_binding r + let rec remove_min_binding = function Empty -> invalid_arg "Map.remove_min_elt" | Node(Empty, x, d, r, _) -> r @@ -173,6 +192,80 @@ module Make(Ord: OrderedType) = struct | Node(l, v, d, r, _) -> fold f r (f v d (fold f l accu)) + let rec for_all p = function + Empty -> true + | Node(l, v, d, r, _) -> p v d && for_all p l && for_all p r + + let rec exists p = function + Empty -> false + | Node(l, v, d, r, _) -> p v d || exists p l || exists p r + + let filter p s = + let rec filt accu = function + | Empty -> accu + | Node(l, v, d, r, _) -> + filt (filt (if p v d then add v d accu else accu) l) r in + filt Empty s + + let partition p s = + let rec part (t, f as accu) = function + | Empty -> accu + | Node(l, v, d, r, _) -> + part (part (if p v d then (add v d t, f) else (t, add v d f)) l) r in + part (Empty, Empty) s + + (* Same as create and bal, but no assumptions are made on the + relative heights of l and r. *) + + let rec join l v d r = + match (l, r) with + (Empty, _) -> add v d r + | (_, Empty) -> add v d l + | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) -> + if lh > rh + 2 then bal ll lv ld (join lr v d r) else + if rh > lh + 2 then bal (join l v d rl) rv rd rr else + create l v d r + + (* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. *) + + let concat t1 t2 = + match (t1, t2) with + (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> + let (x, d) = min_binding t2 in + join t1 x d (remove_min_binding t2) + + let concat_or_join t1 v d t2 = + match d with + | Some d -> join t1 v d t2 + | None -> concat t1 t2 + + let rec split x = function + Empty -> + (Empty, None, Empty) + | Node(l, v, d, r, _) -> + let c = Ord.compare x v in + if c = 0 then (l, Some d, r) + else if c < 0 then + let (ll, pres, rl) = split x l in (ll, pres, join rl v d r) + else + let (lr, pres, rr) = split x r in (join l v d lr, pres, rr) + + let rec merge f s1 s2 = + match (s1, s2) with + (Empty, Empty) -> Empty + | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 -> + let (l2, d2, r2) = split v1 s2 in + concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2) + | (_, Node (l2, v2, d2, r2, h2)) -> + let (l1, d1, r1) = split v2 s1 in + concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2) + | _ -> + assert false + type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration let rec cons_enum m e = @@ -205,4 +298,17 @@ module Make(Ord: OrderedType) = struct equal_aux (cons_enum r1 e1) (cons_enum r2 e2) in equal_aux (cons_enum m1 End) (cons_enum m2 End) + let rec cardinal = function + Empty -> 0 + | Node(l, _, _, r, _) -> cardinal l + 1 + cardinal r + + let rec bindings_aux accu = function + Empty -> accu + | Node(l, v, d, r, _) -> bindings_aux ((v, d) :: bindings_aux accu r) l + + let bindings s = + bindings_aux [] s + + let choose = min_binding + end diff --git a/stdlib/map.mli b/stdlib/map.mli index af1d4d37b..7d1e8355a 100644 --- a/stdlib/map.mli +++ b/stdlib/map.mli @@ -52,22 +52,34 @@ module type S = val is_empty: 'a t -> bool (** Test whether a map is empty or not. *) + val mem: key -> 'a t -> bool + (** [mem x m] returns [true] if [m] contains a binding for [x], + and [false] otherwise. *) + val add: key -> 'a -> 'a t -> 'a t (** [add x y m] returns a map containing the same bindings as [m], plus a binding of [x] to [y]. If [x] was already bound in [m], its previous binding disappears. *) - val find: key -> 'a t -> 'a - (** [find x m] returns the current binding of [x] in [m], - or raises [Not_found] if no such binding exists. *) + val singleton: key -> 'a -> 'a t + (** [singleton x y] returns the one-element map that contains a binding [y] for [x]. *) val remove: key -> 'a t -> 'a t (** [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. *) - val mem: key -> 'a t -> bool - (** [mem x m] returns [true] if [m] contains a binding for [x], - and [false] otherwise. *) + val merge: (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t + (** [merge f m1 m2] compute a map whose keys is a subset of keys of [m1] and of [m2]. The presence of each such binding, and the corresponding value, is determined with the function [f]. *) + + val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int + (** Total ordering between maps. The first argument is a total ordering + used to compare data associated with equal keys in the two maps. *) + + val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are + equal, that is, contain equal keys and associate them with + equal data. [cmp] is the equality predicate used to compare + the data associated with the keys. *) val iter: (key -> 'a -> unit) -> 'a t -> unit (** [iter f m] applies [f] to all bindings in map [m]. @@ -75,6 +87,65 @@ module type S = as second argument. The bindings are passed to [f] in increasing order with respect to the ordering over the type of the keys. *) + val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], + where [k1 ... kN] are the keys of all bindings in [m] + (in increasing order), and [d1 ... dN] are the associated data. *) + + val for_all: (key -> 'a -> bool) -> 'a t -> bool + (** [for_all p m] checks if all the bindings of the map + satisfy the predicate [p]. *) + + val exists: (key -> 'a -> bool) -> 'a t -> bool + (** [exists p m] checks if at least one binding of the map + satisfy the predicate [p]. *) + + val filter: (key -> 'a -> bool) -> 'a t -> 'a t + (** [filter p m] returns the map with all the bindings in [m] + that satisfy predicate [p]. *) + + val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t + (** [partition p m] returns a pair of maps [(m1, m2)], where + [m1] contains all the bindings of [s] that satisfy the + predicate [p], and [m2] is the map with all the bindings of + [s] that do not satisfy [p]. *) + + val cardinal: 'a t -> int + (** Return the number of bindings of a map. *) + + val bindings: 'a t -> (key * 'a) list + (** Return the list of all bindings of the given map. + The returned list is sorted in increasing order with respect + to the ordering [Ord.compare], where [Ord] is the argument + given to {!Map.Make}. *) + + val min_binding: 'a t -> (key * 'a) + (** Return the smallest binding of the given map + (with respect to the [Ord.compare] ordering), or raise + [Not_found] if the map is empty. *) + + val max_binding: 'a t -> (key * 'a) + (** Same as {!Map.S.max_binding}, but returns the largest binding + of the given map. *) + + val choose: 'a t -> (key * 'a) + (** Return one binding of the given map, or raise [Not_found] if + the map is empty. Which binding is chosen is unspecified, + but equal bindings will be chosen for equal maps. *) + + val split: key -> 'a t -> 'a t * 'a option * 'a t + (** [split x m] returns a triple [(l, data, r)], where + [l] is the map with all the bindings of [m] whose key + is strictly less than [x]; + [r] is the map with all the bindings of [m] whose key + is strictly greater than [x]; + [data] is [None] if [m] contains no binding for [x], + or [Some v] if [m] binds [v] to [x]. *) + + val find: key -> 'a t -> 'a + (** [find x m] returns the current binding of [x] in [m], + or raises [Not_found] if no such binding exists. *) + val map: ('a -> 'b) -> 'a t -> 'b t (** [map f m] returns a map with same domain as [m], where the associated value [a] of all bindings of [m] has been @@ -86,20 +157,6 @@ module type S = (** Same as {!Map.S.map}, but the function receives as arguments both the key and the associated value for each binding of the map. *) - val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], - where [k1 ... kN] are the keys of all bindings in [m] - (in increasing order), and [d1 ... dN] are the associated data. *) - - val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int - (** Total ordering between maps. The first argument is a total ordering - used to compare data associated with equal keys in the two maps. *) - - val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are - equal, that is, contain equal keys and associate them with - equal data. [cmp] is the equality predicate used to compare - the data associated with the keys. *) end (** Output signature of the functor {!Map.Make}. *) diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli index fbf848cba..55c773347 100644 --- a/stdlib/moreLabels.mli +++ b/stdlib/moreLabels.mli @@ -73,18 +73,30 @@ module Map : sig and (+'a) t val empty : 'a t val is_empty: 'a t -> bool + val mem : key -> 'a t -> bool val add : key:key -> data:'a -> 'a t -> 'a t - val find : key -> 'a t -> 'a + val singleton: key -> 'a -> 'a t val remove : key -> 'a t -> 'a t - val mem : key -> 'a t -> bool + val merge: f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t + val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit - val map : f:('a -> 'b) -> 'a t -> 'b t - val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t val fold : f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b - val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool + val for_all: f:(key -> 'a -> bool) -> 'a t -> bool + val exists: f:(key -> 'a -> bool) -> 'a t -> bool + val filter: f:(key -> 'a -> bool) -> 'a t -> 'a t + val partition: f:(key -> 'a -> bool) -> 'a t -> 'a t * 'a t + val cardinal: 'a t -> int + val bindings: 'a t -> (key * 'a) list + val min_binding: 'a t -> (key * 'a) + val max_binding: 'a t -> (key * 'a) + val choose: 'a t -> (key * 'a) + val split: key -> 'a t -> 'a t * 'a option * 'a t + val find : key -> 'a t -> 'a + val map : f:('a -> 'b) -> 'a t -> 'b t + val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t end module Make : functor (Ord : OrderedType) -> S with type key = Ord.t end diff --git a/testsuite/tests/basic/maps.ml b/testsuite/tests/basic/maps.ml new file mode 100644 index 000000000..cb0e989b1 --- /dev/null +++ b/testsuite/tests/basic/maps.ml @@ -0,0 +1,28 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* $Id: sets.ml 5183 2002-10-16 09:06:39Z weis $ *) + +module IntMap = Map.Make(struct type t = int let compare x y = x-y end) + +let m1 = IntMap.add 4 "Y" (IntMap.singleton 3 "X1") +let m2 = IntMap.add 4 "Y" (IntMap.singleton 5 "X2") + +let show m = IntMap.iter (fun k v -> Printf.printf "%d %s\n" k v) m + +let () = + print_endline "Union+concat"; + show (IntMap.merge (fun _ l r -> match l, r with Some x, None | None, Some x -> Some x | Some x, Some y -> Some (x ^ x) | _ -> assert false) m1 m2); + print_endline "Inter"; + show (IntMap.merge (fun _ l r -> match l, r with Some x, Some y when x = y -> Some x | _ -> None) m1 m2); + () + diff --git a/testsuite/tests/basic/maps.reference b/testsuite/tests/basic/maps.reference new file mode 100644 index 000000000..c7b0c0833 --- /dev/null +++ b/testsuite/tests/basic/maps.reference @@ -0,0 +1,6 @@ +Union+concat +3 X1 +4 YY +5 X2 +Inter +4 Y |