small set implementation, relying on a sorted list

smallSet.ml

@@ -0,0 +1,133 @@
+(*
+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 Small set structure} *)
+
+type 'a t = {
+  cmp : 'a -> 'a -> int;
+  nodes : 'a node;
+} (** Set of elements of type 'a *)
+and 'a node =
+  | Empty
+  | Node of 'a * 'a node
+  (** Sorted list of 'a *)
+
+let empty ~cmp =
+  { cmp;
+    nodes = Empty;
+  }
+
+let is_empty set =
+  match set.nodes with
+  | Empty -> true
+  | Node _ -> false
+
+let mem set x =
+  let cmp = set.cmp in
+  let rec explore node = match node with
+    | Empty -> false
+    | Node (y, node') ->
+      let c = cmp x y in
+      if c = 0 then true
+      else if c > 0 then explore node'
+      else false
+  in
+  explore set.nodes
+
+let add set x =
+  let cmp = set.cmp in
+  let rec insert node = match node with
+    | Empty -> Node (x, Empty)  (* insert here *)
+    | Node (y, node') ->
+      let c = cmp x y in
+      if c = 0 then node  (* already there *)
+      else if c > 0
+        then
+          let node'' = insert node' in
+          if node' == node'' then node else Node (y, node'')
+      else Node (x, node) (* insert before y *)
+  in
+  let nodes = insert set.nodes in
+  if nodes == set.nodes
+    then set
+    else { set with nodes; }
+
+let rec remove set x =
+  let cmp = set.cmp in
+  let rec remove node = match node with
+    | Empty -> Empty
+    | Node (y, node') ->
+      let c = cmp x y in
+      if c = 0 then node'
+      else if c > 0
+        then
+          let node'' = remove node' in
+          if node' == node'' then node else Node (y, node'')
+      else node (* not present *)
+  in
+  let nodes = remove set.nodes in
+  if nodes == set.nodes
+    then set
+    else { set with nodes; }
+
+let choose set =
+  match set.nodes with
+  | Empty -> raise Not_found
+  | Node (x, _) -> x
+
+let fold f acc set =
+  let rec fold f acc node = match node with
+    | Empty -> acc
+    | Node (x, node') ->
+      let acc' = f acc x in
+      fold f acc' node'
+  in fold f acc set.nodes
+
+let iter f set =
+  let rec iter f node = match node with
+    | Empty -> ()
+    | Node (x, node') ->
+      f x;
+      iter f node'
+  in iter f set.nodes
+
+let size set =
+  let r = ref 0 in
+  iter (fun _ -> incr r) set;
+  !r
+
+let to_seq set =
+  fun k ->
+    iter k set
+
+let of_seq set seq =
+  Sequence.fold add set seq
+
+let to_list set =
+  Sequence.to_rev_list (to_seq set)
+
+let of_list set l =
+  of_seq set (Sequence.of_list l)
+

smallSet.mli

@@ -0,0 +1,68 @@
+(*
+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 Small set structure} *)
+
+(** This set structure is polymorphic, using a user-provided comparison
+    function. It is implemented as a sorted list, so most operations
+    are in linear time. *)
+
+type 'a t
+  (** Set of elements of type 'a *)
+
+val empty : cmp:('a -> 'a -> int) -> 'a t
+  (** Create an empty set *)
+
+val is_empty : 'a t -> bool
+  (** Is the set empty? *)
+
+val mem : 'a t -> 'a -> bool
+  (** Is the element member of the set? *)
+
+val add : 'a t -> 'a -> 'a t
+  (** add an element *)
+
+val remove : 'a t -> 'a -> 'a t
+  (** Remove element *)
+
+val choose : 'a t -> 'a
+  (** Some element of the set, of Not_found *)
+
+val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
+  (** Fold on elements *)
+
+val iter : ('a -> unit) -> 'a t -> unit
+  (** Iterate on elements *)
+
+val size : _ t -> int
+  (** Number of elements *)
+
+val to_seq : 'a t -> 'a Sequence.t
+
+val of_seq : 'a t -> 'a Sequence.t -> 'a t
+
+val to_list : 'a t -> 'a list
+
+val of_list : 'a t -> 'a list -> 'a t