mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
new container, AbsSet, that presents an abstract view of sets
and relational operators
This commit is contained in:
parent
32a59b7982
commit
2c3af875b9
5 changed files with 383 additions and 26 deletions
|
|
@ -24,6 +24,7 @@ data structures
|
|||
access to elements by their index.
|
||||
- `Leftistheap`, a polymorphic heap structure.
|
||||
- `SmallSet`, a sorted list implementation behaving like a set.
|
||||
- `AbsSet`, an abstract Set data structure, a bit like `LazyGraph`.
|
||||
|
||||
Other structures are:
|
||||
|
||||
|
|
|
|||
228
absSet.ml
Normal file
228
absSet.ml
Normal file
|
|
@ -0,0 +1,228 @@
|
|||
(*
|
||||
copyright (c) 2013, simon cruanes
|
||||
all rights reserved.
|
||||
|
||||
redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
this software is provided by the copyright holders and contributors "as is" and
|
||||
any express or implied warranties, including, but not limited to, the implied
|
||||
warranties of merchantability and fitness for a particular purpose are
|
||||
disclaimed. in no event shall the copyright holder or contributors be liable
|
||||
for any direct, indirect, incidental, special, exemplary, or consequential
|
||||
damages (including, but not limited to, procurement of substitute goods or
|
||||
services; loss of use, data, or profits; or business interruption) however
|
||||
caused and on any theory of liability, whether in contract, strict liability,
|
||||
or tort (including negligence or otherwise) arising in any way out of the use
|
||||
of this software, even if advised of the possibility of such damage.
|
||||
*)
|
||||
|
||||
(** {1 Abstract set/relation} *)
|
||||
|
||||
type 'a t = {
|
||||
mem : 'a -> bool;
|
||||
iter : ('a -> unit) -> unit;
|
||||
cardinal : unit -> int;
|
||||
} (** The abstract set *)
|
||||
|
||||
let empty = {
|
||||
mem = (fun _ -> false);
|
||||
iter = (fun _ -> ());
|
||||
cardinal = (fun () -> 0);
|
||||
}
|
||||
|
||||
let mem set x = set.mem x
|
||||
|
||||
let iter set k = set.iter k
|
||||
|
||||
let fold set acc f =
|
||||
let acc = ref acc in
|
||||
set.iter (fun x -> acc := f !acc x);
|
||||
!acc
|
||||
|
||||
let cardinal set = set.cardinal ()
|
||||
|
||||
let singleton ?(eq=(=)) x =
|
||||
let mem y = eq x y in
|
||||
let iter k = k x in
|
||||
let cardinal () = 1 in
|
||||
{ mem; iter; cardinal; }
|
||||
|
||||
(* basic cardinal computation, by counting elements *)
|
||||
let __default_cardinal iter =
|
||||
fun () ->
|
||||
let r = ref 0 in
|
||||
iter (fun _ -> incr r);
|
||||
!r
|
||||
|
||||
let mk_generic ?cardinal ~mem ~iter =
|
||||
let cardinal = match cardinal with
|
||||
| Some c -> c
|
||||
| None -> __default_cardinal iter (* default implementation *)
|
||||
in
|
||||
{ mem; iter; cardinal; }
|
||||
|
||||
let of_hashtbl h =
|
||||
let mem x = Hashtbl.mem h x in
|
||||
let iter k = Hashtbl.iter (fun x _ -> k x) h in
|
||||
let cardinal () = Hashtbl.length h in
|
||||
{ mem; iter; cardinal; }
|
||||
|
||||
let filter set pred =
|
||||
let mem x = set.mem x && pred x in
|
||||
let iter k = set.iter (fun x -> if pred x then k x) in
|
||||
let cardinal = __default_cardinal iter in
|
||||
{ mem; iter; cardinal; }
|
||||
|
||||
let union s1 s2 =
|
||||
let mem x = s1.mem x || s2.mem x in
|
||||
let iter k =
|
||||
s1.iter k;
|
||||
s2.iter (fun x -> if not (s1.mem x) then k x);
|
||||
in
|
||||
let cardinal = __default_cardinal iter in
|
||||
{ mem; iter; cardinal; }
|
||||
|
||||
let intersection s1 s2 =
|
||||
let mem x = s1.mem x && s2.mem x in
|
||||
let iter k = s1.iter (fun x -> if s2.mem x then k x) in
|
||||
let cardinal = __default_cardinal iter in
|
||||
{ mem; iter; cardinal; }
|
||||
|
||||
let product s1 s2 =
|
||||
let mem (x,y) = s1.mem x && s2.mem y in
|
||||
let iter k =
|
||||
s1.iter (fun x -> s2.iter (fun y -> k (x,y))) in
|
||||
let cardinal () = s1.cardinal () * s2.cardinal () in
|
||||
{ mem; iter; cardinal; }
|
||||
|
||||
let to_seq set =
|
||||
Sequence.from_iter (fun k -> set.iter k)
|
||||
|
||||
let to_list set =
|
||||
let l = ref [] in
|
||||
set.iter (fun x -> l := x :: !l);
|
||||
!l
|
||||
|
||||
(** {2 Set builders} *)
|
||||
|
||||
(** A set builder is a value that serves to build a set, element by element.
|
||||
Several implementations can be provided, but the two operations that
|
||||
must be present are:
|
||||
|
||||
- add an element to the builder
|
||||
- extract the set composed of all elements added so far
|
||||
*)
|
||||
|
||||
type 'a builder = {
|
||||
add : 'a -> unit;
|
||||
get : unit -> 'a t;
|
||||
}
|
||||
|
||||
let mk_builder ~add ~get =
|
||||
{ add; get; }
|
||||
|
||||
let builder_hash (type k) ?(size=15) ?(eq=(=)) ?(hash=Hashtbl.hash) () =
|
||||
let module H = Hashtbl.Make(struct type t = k let equal = eq let hash = hash end) in
|
||||
let h = H.create size in
|
||||
let add x = H.replace h x () in
|
||||
let get () =
|
||||
let mem x = H.mem h x in
|
||||
let iter k = H.iter (fun x _ -> k x) h in
|
||||
let cardinal () = H.length h in
|
||||
mk_generic ~cardinal ~mem ~iter
|
||||
in
|
||||
mk_builder ~add ~get
|
||||
|
||||
let builder_cmp (type k) ?(cmp=Pervasives.compare) () =
|
||||
let module S = Set.Make(struct type t = k let compare = cmp end) in
|
||||
let s = ref S.empty in
|
||||
let add x = s := S.add x !s in
|
||||
let get () =
|
||||
let s' = !s in
|
||||
let mem x = S.mem x s' in
|
||||
let iter k = S.iter k s' in
|
||||
let cardinal () = S.cardinal s' in
|
||||
mk_generic ~cardinal ~mem ~iter
|
||||
in
|
||||
mk_builder ~add ~get
|
||||
|
||||
let of_seq_builder ~builder seq =
|
||||
Sequence.iter builder.add seq;
|
||||
builder.get ()
|
||||
|
||||
let of_seq_hash ?eq ?hash seq =
|
||||
let b = builder_hash ?eq ?hash () in
|
||||
of_seq_builder b seq
|
||||
|
||||
let of_seq_cmp ?cmp seq =
|
||||
let b = builder_cmp ?cmp () in
|
||||
of_seq_builder b seq
|
||||
|
||||
let of_list l = of_seq_hash (Sequence.of_list l)
|
||||
|
||||
let map ?(builder=builder_hash ()) set ~f =
|
||||
set.iter
|
||||
(fun x ->
|
||||
let y = f x in
|
||||
builder.add y);
|
||||
builder.get ()
|
||||
|
||||
(* relational join *)
|
||||
let hash_join
|
||||
(type k) ?(eq=(=)) ?(size=20) ?(hash=Hashtbl.hash) ?(builder=builder_hash ())
|
||||
~project1 ~project2 ~merge s1 s2
|
||||
=
|
||||
let module H = Hashtbl.Make(struct type t = k let equal = eq let hash = hash end) in
|
||||
let h = H.create size in
|
||||
s1.iter
|
||||
(fun x ->
|
||||
let key = project1 x in
|
||||
H.add h key x);
|
||||
s2.iter
|
||||
(fun y ->
|
||||
let key = project2 y in
|
||||
let xs = H.find_all h key in
|
||||
List.iter (fun x -> builder.add (merge x y)) xs);
|
||||
builder.get ()
|
||||
|
||||
(** {2 Functorial interfaces} *)
|
||||
|
||||
module MakeHash(X : Hashtbl.HashedType) = struct
|
||||
type elt = X.t
|
||||
(** Elements of the set are hashable *)
|
||||
|
||||
module H = Hashtbl.Make(X)
|
||||
|
||||
let of_seq ?(size=5) seq =
|
||||
let h = Hashtbl.create size in
|
||||
Sequence.iter (fun x -> Hashtbl.add h x ()) seq;
|
||||
let mem x = Hashtbl.mem h x in
|
||||
let iter k = Hashtbl.iter (fun x () -> k x) h in
|
||||
let cardinal () = Hashtbl.length h in
|
||||
mk_generic ~cardinal ~mem ~iter
|
||||
end
|
||||
|
||||
|
||||
module MakeSet(S : Set.S) = struct
|
||||
type elt = S.elt
|
||||
|
||||
let of_set set =
|
||||
let mem x = S.mem x set in
|
||||
let iter k = S.iter k set in
|
||||
let cardinal () = S.cardinal set in
|
||||
mk_generic ~cardinal ~mem ~iter
|
||||
|
||||
let of_seq ?(init=S.empty) seq =
|
||||
let set = Sequence.fold (fun s x -> S.add x s) init seq in
|
||||
of_set set
|
||||
|
||||
let to_set set =
|
||||
fold set S.empty (fun set x -> S.add x set)
|
||||
end
|
||||
152
absSet.mli
Normal file
152
absSet.mli
Normal file
|
|
@ -0,0 +1,152 @@
|
|||
(*
|
||||
copyright (c) 2013, simon cruanes
|
||||
all rights reserved.
|
||||
|
||||
redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
this software is provided by the copyright holders and contributors "as is" and
|
||||
any express or implied warranties, including, but not limited to, the implied
|
||||
warranties of merchantability and fitness for a particular purpose are
|
||||
disclaimed. in no event shall the copyright holder or contributors be liable
|
||||
for any direct, indirect, incidental, special, exemplary, or consequential
|
||||
damages (including, but not limited to, procurement of substitute goods or
|
||||
services; loss of use, data, or profits; or business interruption) however
|
||||
caused and on any theory of liability, whether in contract, strict liability,
|
||||
or tort (including negligence or otherwise) arising in any way out of the use
|
||||
of this software, even if advised of the possibility of such damage.
|
||||
*)
|
||||
|
||||
(** {1 Abstract set/relation} *)
|
||||
|
||||
type 'a t
|
||||
|
||||
val empty : 'a t
|
||||
(** Empty set *)
|
||||
|
||||
val mem : 'a t -> 'a -> bool
|
||||
(** [mem set x] returns true iff [x] belongs to the set *)
|
||||
|
||||
val iter : 'a t -> ('a -> unit) -> unit
|
||||
(** Iterate on the set elements **)
|
||||
|
||||
val fold : 'a t -> 'b -> ('b -> 'a -> 'b) -> 'b
|
||||
(** Fold on the set *)
|
||||
|
||||
val cardinal : _ t -> int
|
||||
(** Number of elements *)
|
||||
|
||||
val singleton : ?eq:('a -> 'a -> bool) -> 'a -> 'a t
|
||||
(** Single-element set *)
|
||||
|
||||
val mk_generic : ?cardinal:(unit -> int) ->
|
||||
mem:('a -> bool) ->
|
||||
iter:(('a -> unit) -> unit) -> 'a t
|
||||
(** Generic constructor. Takes a membership function and an iteration
|
||||
function, and possibly a cardinal function (supposed to return
|
||||
the number of elements) *)
|
||||
|
||||
val of_hashtbl : ('a, _) Hashtbl.t -> 'a t
|
||||
(** Set composed of the keys of this hashtable. The cardinal is computed
|
||||
using the number of bindings, so keys with multiple bindings will
|
||||
entail errors in {!cardinal} !*)
|
||||
|
||||
val filter : 'a t -> ('a -> bool) -> 'a t
|
||||
(** Filter the set *)
|
||||
|
||||
val union : 'a t -> 'a t -> 'a t
|
||||
|
||||
val intersection : 'a t -> 'a t -> 'a t
|
||||
|
||||
val product : 'a t -> 'b t -> ('a * 'b) t
|
||||
(** Cartesian product *)
|
||||
|
||||
val to_seq : 'a t -> 'a Sequence.t
|
||||
|
||||
val to_list : 'a t -> 'a list
|
||||
|
||||
(** {2 Set builders} *)
|
||||
|
||||
(** A set builder is a value that serves to build a set, element by element.
|
||||
Several implementations can be provided, but the two operations that
|
||||
must be present are:
|
||||
|
||||
- add an element to the builder
|
||||
- extract the set composed of all elements added so far
|
||||
*)
|
||||
|
||||
type 'a builder
|
||||
|
||||
val mk_builder : add:('a -> unit) -> get:(unit -> 'a t) -> 'a builder
|
||||
(** Generic set builder *)
|
||||
|
||||
val builder_hash : ?size:int ->
|
||||
?eq:('a -> 'a -> bool) ->
|
||||
?hash:('a -> int) -> unit -> 'a builder
|
||||
(** Builds a set from a Hashtable. [size] is the initial size *)
|
||||
|
||||
val builder_cmp : ?cmp:('a -> 'a -> int) -> unit -> 'a builder
|
||||
|
||||
val of_seq_builder : builder:'a builder -> 'a Sequence.t -> 'a t
|
||||
(** Uses the given builder to construct a set from a sequence of elements *)
|
||||
|
||||
val of_seq_hash : ?eq:('a -> 'a -> bool) -> ?hash:('a -> int) -> 'a Sequence.t -> 'a t
|
||||
(** Construction of a set from a sequence of hashable elements *)
|
||||
|
||||
val of_seq_cmp : ?cmp:('a -> 'a -> int) -> 'a Sequence.t -> 'a t
|
||||
(** Construction of a set from a sequence of comparable elements *)
|
||||
|
||||
val of_list : 'a list -> 'a t
|
||||
(** Helper that uses default hash function and equality to build a set *)
|
||||
|
||||
val map : ?builder:'b builder -> 'a t -> f:('a -> 'b) -> 'b t
|
||||
(** Eager map from a set to another set. The result is built immediately
|
||||
using a set builder *)
|
||||
|
||||
val hash_join : ?eq:('key -> 'key -> bool) ->
|
||||
?size:int ->
|
||||
?hash:('key -> int) ->
|
||||
?builder:'res builder ->
|
||||
project1:('a -> 'key) ->
|
||||
project2:('b -> 'key) ->
|
||||
merge:('a -> 'b -> 'res) ->
|
||||
'a t -> 'b t -> 'res t
|
||||
(** Relational join between two sets. The two sets are joined on
|
||||
the 'key type, and rows are merged into 'res.
|
||||
This takes at least three functions
|
||||
in addition to optional parameters:
|
||||
|
||||
- [project1] extracts keys from rows of the first set
|
||||
- [project2] extracts keys from rows of the second set
|
||||
- [merge] merges rows that have the same key together
|
||||
*)
|
||||
|
||||
(** {2 Functorial interfaces} *)
|
||||
|
||||
module MakeHash(X : Hashtbl.HashedType) : sig
|
||||
type elt = X.t
|
||||
(** Elements of the set are hashable *)
|
||||
|
||||
val of_seq : ?size:int -> elt Sequence.t -> elt t
|
||||
(** Build a set from a sequence *)
|
||||
end
|
||||
|
||||
|
||||
module MakeSet(S : Set.S) : sig
|
||||
type elt = S.elt
|
||||
|
||||
val of_seq : ?init:S.t -> elt Sequence.t -> elt t
|
||||
(** Build a set from a sequence *)
|
||||
|
||||
val of_set : S.t -> elt t
|
||||
(** Explicit conversion from a tree set *)
|
||||
|
||||
val to_set : elt t -> S.t
|
||||
(** Conversion to a set (linear time) *)
|
||||
end
|
||||
|
|
@ -25,3 +25,4 @@ MultiSet
|
|||
UnionFind
|
||||
SmallSet
|
||||
Leftistheap
|
||||
AbsSet
|
||||
|
|
|
|||
|
|
@ -1,26 +0,0 @@
|
|||
Cache
|
||||
Deque
|
||||
Gen
|
||||
FHashtbl
|
||||
FQueue
|
||||
FlatHashtbl
|
||||
Hashset
|
||||
Heap
|
||||
LazyGraph
|
||||
PersistentGraph
|
||||
PersistentHashtbl
|
||||
PHashtbl
|
||||
Sequence
|
||||
SkipList
|
||||
SplayTree
|
||||
SplayMap
|
||||
Univ
|
||||
Vector
|
||||
Bij
|
||||
PiCalculus
|
||||
Bencode
|
||||
Sexp
|
||||
RAL
|
||||
MultiSet
|
||||
UnionFind
|
||||
SmallSet
|
||||
1
containers.odocl
Symbolic link
1
containers.odocl
Symbolic link
|
|
@ -0,0 +1 @@
|
|||
containers.mllib
|
||||
Loading…
Add table
Reference in a new issue