From 3818da2cf8e64611be4e9269170b9b56b7b57591 Mon Sep 17 00:00:00 2001 From: Sebastien Ferre Date: Mon, 19 Dec 2005 12:53:23 +0000 Subject: [PATCH] subset, equal, partitioner, ... --- lSet.ml | 54 +++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 41 insertions(+), 13 deletions(-) diff --git a/lSet.ml b/lSet.ml index d0cc83e..919276b 100644 --- a/lSet.ml +++ b/lSet.ml @@ -1,21 +1,24 @@ -(* - 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 @@ -40,7 +43,7 @@ let rec comp : 'a list -> 'a list -> comp = | 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 @@ -51,10 +54,14 @@ let rec contains : 'a list -> 'a list -> bool = 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 @@ -74,10 +81,11 @@ let add : 'a -> 'a list -> 'a list = 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 [], _ -> [] @@ -93,7 +101,7 @@ let rec inter_r : 'a list list -> 'a list = [] -> 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 [], _ -> [] @@ -104,12 +112,32 @@ let rec subtract : 'a list -> 'a list -> 'a list = 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] @@ -119,7 +147,7 @@ let rec flip : 'a -> 'a list -> 'a list = 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 -- 2.1.1