Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Extend Map with functions from Set. 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10468 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2010-05-25 13:29:43 +00:00
parent 734b805161
commit 66092ce6ff
6 changed files with 244 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Changes
View File

@ -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

120
stdlib/map.ml
View File

@ -25,16 +25,28 @@ module type S =
type +'a t
val empty: 'a t
val is_empty: 'a t -> bool
val add: key -> 'a -> 'a t -> 'a t
val find: key -> 'a t -> 'a
val remove: key -> 'a t -> 'a t
val mem: key -> 'a t -> bool
val iter: (key -> 'a -> unit) -> 'a t -> unit
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 add: key -> 'a -> 'a t -> 'a t
val singleton: key -> 'a -> 'a t
val remove: key -> 'a t -> 'a t
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
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

97
stdlib/map.mli
View File

@ -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}. *)

26
stdlib/moreLabels.mli
View File

@ -73,18 +73,30 @@ module Map : sig
and (+'a) t
val empty : 'a t
val is_empty: 'a t -> bool
val add : key:key -> data:'a -> 'a t -> 'a t
val find : key -> 'a t -> 'a
val remove : key -> 'a t -> 'a t
val mem : key -> 'a t -> bool
val add : key:key -> data:'a -> 'a t -> 'a t
val singleton: key -> 'a -> 'a t
val remove : key -> 'a t -> 'a t
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

28
testsuite/tests/basic/maps.ml Normal file
View File

@ -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);
()

6
testsuite/tests/basic/maps.reference Normal file
View File

@ -0,0 +1,6 @@
Union+concat
3 X1
4 YY
5 X2
Inter
4 Y