diff --git a/README.md b/README.md index 910c30ce..1d5b99f9 100644 --- a/README.md +++ b/README.md @@ -42,6 +42,7 @@ monadic futures, and MVars (concurrent boxes) a functorial interface (replaced by PHashtbl) - `Gen` and `Sequence`, generic iterators structures. - `UnionFind`, a functorial imperative Union-Find structure. +- `HGraph`, a structure of generalized hypergraphs Some serialisation formats are also implemented, with a streaming, non-blocking interface that allows the user to feed the input in chunk by chunk (useful diff --git a/_oasis b/_oasis index 0b3bbe4a..945d8cb0 100644 --- a/_oasis +++ b/_oasis @@ -39,7 +39,8 @@ Library "containers" PHashtbl, Sequence, SkipList, SplayTree, SplayMap, Univ, Vector, Bij, PiCalculus, Bencode, Sexp, RAL, MultiSet, UnionFind, SmallSet, Leftistheap, AbsSet, CSM, MultiMap, - ActionMan, BV, QCheck, BencodeOnDisk, Show, TTree + ActionMan, BV, QCheck, BencodeOnDisk, Show, TTree, + HGraph BuildDepends: unix Library "containers_thread" diff --git a/_tags b/_tags index 3f96a872..ab5e37c9 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 727237717e19643a155e5e70e3495f8e) +# DO NOT EDIT (digest: dcf1c0cacacb67335a863b18858eaeb7) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -51,6 +51,7 @@ "bencodeOnDisk.cmx": for-pack(Containers) "show.cmx": for-pack(Containers) "tTree.cmx": for-pack(Containers) +"hGraph.cmx": for-pack(Containers) # Library containers_thread "containers_thread.cmxs": use_containers_thread <*.ml{,i}>: pkg_threads diff --git a/containers.mlpack b/containers.mlpack index abdffeed..3132bdde 100644 --- a/containers.mlpack +++ b/containers.mlpack @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 5c1e80992f9515200585f739a64d9771) +# DO NOT EDIT (digest: c05f285f4d4b4832b21ddd28863f4edf) Cache Deque Gen @@ -36,4 +36,5 @@ QCheck BencodeOnDisk Show TTree +HGraph # OASIS_STOP diff --git a/containers.odocl b/containers.odocl index 4fd566d3..48ce7541 100644 --- a/containers.odocl +++ b/containers.odocl @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: ca2e7fd09ab7b0d8b4525454fa277f3c) +# DO NOT EDIT (digest: b68696a2df00165022fe21a389026f4f) Cache Deque Gen @@ -36,5 +36,6 @@ QCheck BencodeOnDisk Show TTree +HGraph Behavior # OASIS_STOP diff --git a/hGraph.ml b/hGraph.ml new file mode 100644 index 00000000..864c093b --- /dev/null +++ b/hGraph.ml @@ -0,0 +1,255 @@ + +(* +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. +*) + +(** {2 Hypergraph Representation} + +Generalized Hypergraphs. Objects are either constants, or hyperedges that +connect [n] other objets together (a [n]-tuple). Each hyperedge can contain +additional data. +*) + +module type S = sig + type const + (** Constants. Those are what can annotate hyperedges or make single, + leaf, nodes. *) + + type data + (** Additional data carried by the hypergraph elements *) + + type t + (** An element of the hypergraph. It can be parametrized by a ['a option] + additional data (use 'a = unit if you don't care). *) + + val eq : t -> t -> bool + (** Structural equality of the two edges *) + + val hash : t -> int + (** Hash, used for hashtables *) + + val id : t -> int + (** Same as {!hash}, but guarantees that the int is actually unique. *) + + val cmp : t -> t -> int + (** Arbitrary total order *) + + val data : t -> data option + (** Data contained in this edge, if any *) + + val const : t -> const + (** Constant that annotates this hyperedge. *) + + val arity : t -> int + (** Number of sub-elements *) + + val nth : t -> int -> t + (** [nth x i] accesses the [i]-th sub-node of [x]. + @raise Invalid_argument if [i >= arity x]. *) + + val sub : t -> t array + (** Access the sub-nodes as an array. This array {b MUST NOT} be modified + by the caller. *) + + val make : ?data:data -> const -> t array -> t + (** Create a new hyperedge from a constant that annotates it, and + an ordered tuple of sub-edges. + @param data optional data to decorate the edge. *) + + val make_l : ?data:data -> const -> t list -> t + (** From a list, same as {!make} otherwise *) + + val const : ?data:data -> const -> t + (** Constant node *) + + val update : ?data:data -> t -> t array -> t + (** [update e sub] creates an hyperedge equivalent to [e] in all ways, + but with the given sub-nodes as sub-edges. The array's ownership + is lost by the caller. + + @param data optional data that annotates the new edge. + *) + + val pp : Buffer.t -> t -> unit + (** Print itself (non-recursively) on the buffer *) +end + +module type PARAM = sig + type const + type data + + val eq : const -> const -> bool + val hash : const -> int + val to_string : const -> string (* for printing *) +end + +module Make(P : PARAM) = struct + type const = P.const + type data = P.data + + type t = { + head : const; + data : data option; + sub : t array; + mutable id : int; + mutable backref : t Weak.t; + } + + type edge = t + + let eq t1 t2 = t1.id = t2.id + + let hash t = t.id + + let id t = t.id + + let cmp t1 t2 = t1.id - t2.id + + let data t = t.data + + let const t = t.head + + let arity t = Array.length t.sub + + let nth t i = t.sub.(i) + + let sub t = t.sub + + (* add a backref from [a] to [b]. *) + let _add_backref a b = + let n = Weak.length a.backref in + let arr = a.backref in + try + for i = 0 to n-1 do + if not (Weak.check arr i) + then begin (* insert here *) + Weak.set arr i (Some b); + raise Exit; + end + done; + (* no insertion possible: resize *) + a.backref <- Weak.create (2 * n); + Weak.blit arr 0 a.backref 0 n; + Weak.set a.backref n (Some b) + with Exit -> () + + (* structural equality on top-level *) + let _eq_top t1 t2 = + Array.length t1.sub = Array.length t2.sub && + P.eq t1.head t2.head && + try + for i = 0 to Array.length t1.sub - 1 do + if not (eq (Array.unsafe_get t1.sub i) (Array.unsafe_get t2.sub i)) then raise Exit; + done; true + with Exit -> false + + (* top-level hashing *) + let _hash_top t = + let h = ref (P.hash t.head) in + for i = 0 to Array.length t.sub - 1 do + h := max_int land (!h * 65599 + (hash (Array.unsafe_get t.sub i))) + done; + !h + + (* hashconsing weak table *) + module H = Weak.Make(struct + type t = edge + let equal = _eq_top + let hash = _hash_top + end) + + let __count = ref 0 + let __table = H.create 2045 + + let make ?data head sub = + let my_t = { + head; + data; + sub; + id = ~-1; + backref = Weak.create 0; + } in + let t = H.merge __table my_t in + if t == my_t then begin + (* hashconsing tag *) + assert (t.id = ~-1); + t.id <- !__count; + incr __count; + (* make a proper backref array *) + t.backref <- Weak.create 5; + (* add oneself to sub-nodes' backref arrays *) + Array.iter (fun t' -> _add_backref t' t) sub + end; + t + + let make_l ?data head sub = make ?data head (Array.of_list sub) + + let const ?data head = make ?data head [| |] + + let update ?data t sub' = make ?data t.head sub' + + let pp buf e = + Buffer.add_string buf (string_of_int e.id); + Buffer.add_char buf ':'; + if arity e = 0 + then Buffer.add_string buf (P.to_string e.head) + else begin + Buffer.add_char buf '('; + Buffer.add_string buf (P.to_string e.head); + Array.iteri + (fun i sub -> + if i > 0 then Buffer.add_char buf ' '; + Buffer.add_string buf (string_of_int sub.id)) + e.sub; + Buffer.add_char buf ')' + end +end + +(** {2 Useful default} *) + +module DefaultParam = struct + type const = + | S of string + | I of int + + type data = unit + + let eq c1 c2 = match c1, c2 with + | S s1, S s2 -> s1 = s2 + | I i1, I i2 -> i1 = i2 + | _ -> false + + let hash = function + | S s -> Hashtbl.hash s + | I i -> i + + let to_string = function + | S s -> s + | I i -> string_of_int i + + let i i = I i + let s s = S s +end + +module Default = Make(DefaultParam) diff --git a/hGraph.mli b/hGraph.mli new file mode 100644 index 00000000..df4a9f7d --- /dev/null +++ b/hGraph.mli @@ -0,0 +1,127 @@ + +(* +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. +*) + +(** {2 Hypergraph Representation} + +Generalized Hypergraphs. Objects are either constants, or hyperedges that +connect [n] other objets together (a [n]-tuple). Each hyperedge can contain +additional data. + +Hashconsing is used to ensure that structural equality implies physical +equality. This makes this module non thread safe. +*) + +module type S = sig + type const + (** Constants. Those are what can annotate hyperedges or make single, + leaf, nodes. *) + + type data + (** Additional data carried by the hypergraph elements *) + + type t + (** An element of the hypergraph. It can be parametrized by a ['a option] + additional data (use 'a = unit if you don't care). *) + + val eq : t -> t -> bool + (** Structural equality of the two edges *) + + val hash : t -> int + (** Hash, used for hashtables *) + + val id : t -> int + (** Same as {!hash}, but guarantees that the int is actually unique. *) + + val cmp : t -> t -> int + (** Arbitrary total order *) + + val data : t -> data option + (** Data contained in this edge, if any *) + + val const : t -> const + (** Constant that annotates this hyperedge. *) + + val arity : t -> int + (** Number of sub-elements *) + + val nth : t -> int -> t + (** [nth x i] accesses the [i]-th sub-node of [x]. + @raise Invalid_argument if [i >= arity x]. *) + + val sub : t -> t array + (** Access the sub-nodes as an array. This array {b MUST NOT} be modified + by the caller. *) + + val make : ?data:data -> const -> t array -> t + (** Create a new hyperedge from a constant that annotates it, and + an ordered tuple of sub-edges. + @param data optional data to decorate the edge. *) + + val make_l : ?data:data -> const -> t list -> t + (** From a list, same as {!make} otherwise *) + + val const : ?data:data -> const -> t + (** Constant node *) + + val update : ?data:data -> t -> t array -> t + (** [update e sub] creates an hyperedge equivalent to [e] in all ways, + but with the given sub-nodes as sub-edges. The array's ownership + is lost by the caller. + + @param data optional data that annotates the new edge. + *) + + val pp : Buffer.t -> t -> unit + (** Print itself (non-recursively) on the buffer *) +end + +module type PARAM = sig + type const + type data + + val eq : const -> const -> bool + val hash : const -> int + val to_string : const -> string (* for printing *) +end + +module Make(P : PARAM) : S with type const = P.const and type data = P.data + +(** {2 Useful default} *) + +module DefaultParam : sig + type const = + | S of string + | I of int + + type data = unit + + include PARAM with type const := const and type data := data + + val i : int -> const + val s : string -> const +end + +module Default : S with type const = DefaultParam.const and type data = DefaultParam.data diff --git a/setup.ml b/setup.ml index 5a4551f2..be2a5d7e 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.3.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 1ff8886120b2512ffd368de480850fcc) *) +(* DO NOT EDIT (digest: b3286e91d3acc2931801b7c5da3859c2) *) (* Regenerated by OASIS v0.3.0 Visit http://oasis.forge.ocamlcore.org for more information and @@ -5903,7 +5903,8 @@ let setup_t = "QCheck"; "BencodeOnDisk"; "Show"; - "TTree" + "TTree"; + "HGraph" ]; lib_pack = true; lib_internal_modules = []; @@ -6224,7 +6225,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.3.0"; - oasis_digest = Some "!l\025\004\144\144\255le\222F\177Z\202S\216"; + oasis_digest = Some "\139{\144\225j\1545\001\221\138R\129\177\182q*"; oasis_exec = None; oasis_setup_args = []; setup_update = false; @@ -6232,6 +6233,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 6236 "setup.ml" +# 6237 "setup.ml" (* OASIS_STOP *) let () = setup ();;