Commits

Sébastien Ferré committed 3818da2

subset, equal, partitioner, ...

Comments (0)

Files changed (1)

-(*
-   module about ordered polymorphic lists as sets
-*)
+(** Sets as ordered polymorphic lists. *)
 
-open List
+include List
+
+let compare x y = Pervasives.compare y x
 
 type 'a t = 'a list
 
-(* return an empty set *)
+(** The empty set. *)
 let empty : unit -> 'a list = fun () -> []
 
-(* test if a set is empty or not *)
+(** Test if a set is empty or not. *)
 let is_empty : 'a list -> bool = function [] -> true | _ -> false
 
-(* return the cardinal of a set *)
+(** Return the cardinal of a set. *)
 let cardinal : 'a list -> int = List.length
 
-(* comparison of 2 sets for any relation among: Contains, Contained, Equals, Other *)
+(** Return a list of the elements. *)
+let elements : 'a t -> 'a list = fun l -> l
+
+(** Comparison of 2 sets for any relation among: Contains, Contained, Equals, Other. *)
 
 type comp = Contains | Contained | Equals | Other
 
         | Other -> Other
       else comp l1 l2
 
-(* return true if the first set contains the second *)
+(** Return true if the first set contains the second. *)
 let rec contains : 'a list -> 'a list -> bool =
   fun l1 l2 -> match l1, l2 with
     _, [] -> true
       else if comp > 0 then false
       else contains l1 l2
 
+let subset l1 l2 = contains l2 l1
+
+let equal = (=)
+
 let mem : 'a -> 'a list -> bool =
   fun x l -> contains l [x]
 
-(* return the union of 2 and several sets *)
+(** Return the union of 2 and several sets. *)
 let rec union : 'a list -> 'a list -> 'a list =
   fun l1 l2 -> match l1, l2 with
     [], l2 -> l2
 let singleton : 'a -> 'a list =
   fun x -> [x]
 
+(** Get a set from a list. *)
 let of_list : 'a list -> 'a t =
   fun l -> List.fold_left (fun res x -> add x res) [] l
 
-(* return the intersection of 2 sets *)
+(** Return the intersection of 2 sets. *)
 let rec inter : 'a list -> 'a list -> 'a list =
   fun l1 l2 -> match l1, l2 with
     [], _ -> []
       [] -> raise (Invalid_argument "inter_r : empty list of sets")
     | set::sets -> List.fold_right (fun set res -> inter set res) sets set
 
-(* return the subtraction of 2 sets *)
+(** Return the subtraction of 2 sets. *)
 let rec subtract : 'a list -> 'a list -> 'a list =
   fun l1 l2 ->  match l1, l2 with
     [], _ -> []
       else if comp > 0 then subtract (x1::l1) l2
       else subtract l1 l2
 
+let diff = subtract
+
 let subtract_r : 'a list -> 'a list list -> 'a list =
   fun set sets -> List.fold_left (fun res set -> subtract res set) set sets
 
 let remove : 'a -> 'a list -> 'a list =
   fun x l -> subtract l [x]
 
+(* partition par the belonging to a set *)
+(* partitioner -> partitionee -> inter * diff *)
+      let rec partition_set : 'a t -> 'a t -> 'a t * 'a t =
+	fun l1 l2 -> match l1, l2 with
+	| [], l2 -> [], l2
+	| _, [] -> [], []
+	| x1::l1, x2::l2 ->
+	    let comp = compare x1 x2 in
+	    if comp < 0 then
+	      partition_set l1 (x2::l2)
+	    else if comp > 0 then
+	      let inter, diff = partition_set (x1::l1) l2 in
+	      inter, x2::diff
+	    else
+	      let inter, diff = partition_set l1 l2 in
+	      x2::inter, diff
+
+(** Remove an element if present, add it otherwise. *)
 let rec flip : 'a -> 'a list -> 'a list =
   fun x -> function
     [] -> [x]
       else if comp > 0 then y::flip x l
       else l
 
-(* generic folding over the synchronized traversal of 2 LSets *)
+(** Generic folding over the synchronized traversal of 2 LSets *)
 
 type inwhich = Infst | Insnd | Inboth