From 2812f797e901ca2b9aa3aea8bd863b1e989a54eb Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 5 Aug 2014 11:18:15 +0200 Subject: [PATCH] CCMultiMap now also contains a functor to build bidirectional multimaps --- core/CCMultiMap.ml | 133 ++++++++++++++++++++++++++++++++++++++++++++ core/CCMultiMap.mli | 63 +++++++++++++++++++++ 2 files changed, 196 insertions(+) diff --git a/core/CCMultiMap.ml b/core/CCMultiMap.ml index 3eedb5f7..29be19a8 100644 --- a/core/CCMultiMap.ml +++ b/core/CCMultiMap.ml @@ -225,3 +225,136 @@ module Make(K : OrderedType)(V : OrderedType) = struct let values m k = iter m (fun _ v -> k v) end + +module type BIDIR = sig + type t + type left + type right + + val empty : t + + val is_empty : t -> bool + + val add : t -> left -> right -> t + (** Add a binding (left,right) *) + + val remove : t -> left -> right -> t + (** Remove a specific binding *) + + val cardinal_left : t -> int + (** number of distinct left keys *) + + val cardinal_right : t -> int + (** number of distinct right keys *) + + val remove_left : t -> left -> t + (** Remove all bindings for the left key *) + + val remove_right : t -> right -> t + (** Remove all bindings for the right key *) + + val mem_left : t -> left -> bool + (** Is the left key present in at least one pair? *) + + val mem_right : t -> right -> bool + (** Is the right key present in at least one pair? *) + + val find_left : t -> left -> right sequence + (** Find all bindings for this given left-key *) + + val find_right : t -> right -> left sequence + (** Find all bindings for this given right-key *) + + val find1_left : t -> left -> right option + (** like {!find_left} but returns at most one value *) + + val find1_right : t -> right -> left option + (** like {!find_right} but returns at most one value *) + + val fold : ('a -> left -> right -> 'a) -> 'a -> t -> 'a + (** Fold on pairs *) + + val pairs : t -> (left * right) sequence + (** Iterate on pairs *) + + val add_pairs : t -> (left * right) sequence -> t + (** Add pairs *) + + val seq_left : t -> left sequence + val seq_right : t -> right sequence +end + +let _fold_seq f acc seq = + let acc = ref acc in + seq (fun x -> acc := f !acc x); + !acc + +let _head_seq seq = + let r = ref None in + begin try seq (fun x -> r := Some x; raise Exit) + with Exit -> (); + end; + !r + +module MakeBidir(L : OrderedType)(R : OrderedType) = struct + type left = L.t + type right = R.t + + module MapL = Make(L)(R) + module MapR = Make(R)(L) + + type t = { + left : MapL.t; + right : MapR.t; + } + + let empty = { + left = MapL.empty; + right = MapR.empty; + } + + let is_empty m = MapL.is_empty m.left + + let add m a b = { + left = MapL.add m.left a b; + right = MapR.add m.right b a; + } + + let remove m a b = { + left = MapL.remove m.left a b; + right = MapR.remove m.right b a; + } + + let cardinal_left m = MapL.size m.left + let cardinal_right m = MapR.size m.right + + let find_left m a = MapL.find_iter m.left a + let find_right m b = MapR.find_iter m.right b + + let remove_left m a = + _fold_seq + (fun m b -> remove m a b) + m (find_left m a) + + let remove_right m b = + _fold_seq + (fun m a -> remove m a b) + m (find_right m b) + + let mem_left m a = MapL.mem m.left a + let mem_right m b = MapR.mem m.right b + + let find1_left m a = _head_seq (find_left m a) + let find1_right m b = _head_seq (find_right m b) + + let fold f acc m = + MapL.fold m.left acc f + + let pairs m = MapL.to_seq m.left + + let add_pairs m seq = _fold_seq (fun m (a,b) -> add m a b) m seq + + let seq_left m = MapL.keys m.left + + let seq_right m = MapR.keys m.right +end diff --git a/core/CCMultiMap.mli b/core/CCMultiMap.mli index 8d6e9e71..850bb93f 100644 --- a/core/CCMultiMap.mli +++ b/core/CCMultiMap.mli @@ -104,3 +104,66 @@ module type OrderedType = sig end module Make(K : OrderedType)(V : OrderedType) : S with type key = K.t and type value = V.t + +(** {2 Two-Way Multimap} *) + +module type BIDIR = sig + type t + type left + type right + + val empty : t + + val is_empty : t -> bool + + val add : t -> left -> right -> t + (** Add a binding (left,right) *) + + val remove : t -> left -> right -> t + (** Remove a specific binding *) + + val cardinal_left : t -> int + (** number of distinct left keys *) + + val cardinal_right : t -> int + (** number of distinct right keys *) + + val remove_left : t -> left -> t + (** Remove all bindings for the left key *) + + val remove_right : t -> right -> t + (** Remove all bindings for the right key *) + + val mem_left : t -> left -> bool + (** Is the left key present in at least one pair? *) + + val mem_right : t -> right -> bool + (** Is the right key present in at least one pair? *) + + val find_left : t -> left -> right sequence + (** Find all bindings for this given left-key *) + + val find_right : t -> right -> left sequence + (** Find all bindings for this given right-key *) + + val find1_left : t -> left -> right option + (** like {!find_left} but returns at most one value *) + + val find1_right : t -> right -> left option + (** like {!find_right} but returns at most one value *) + + val fold : ('a -> left -> right -> 'a) -> 'a -> t -> 'a + (** Fold on pairs *) + + val pairs : t -> (left * right) sequence + (** Iterate on pairs *) + + val add_pairs : t -> (left * right) sequence -> t + (** Add pairs *) + + val seq_left : t -> left sequence + val seq_right : t -> right sequence +end + +module MakeBidir(L : OrderedType)(R : OrderedType) : BIDIR + with type left = L.t and type right = R.t