(* ========================================================================= *)
(* FINITE SETS IMPLEMENTED WITH RANDOMLY BALANCED TREES *)
(* Copyright (c) 2004 Joe Leslie-Hurd, distributed under the BSD License *)
(* ========================================================================= *)
structure Set :> Set =
struct
(* ------------------------------------------------------------------------- *)
(* A type of finite sets. *)
(* ------------------------------------------------------------------------- *)
type ('elt,' a) map = ('elt,' a) Map .map ;
datatype 'elt set = Set of (' elt,unit) map ;
(* ------------------------------------------------------------------------- *)
(* Converting to and from maps. *)
(* ------------------------------------------------------------------------- *)
fun dest (Set m) = m;
fun mapPartial f =
let
fun mf (elt,()) = f elt
in
fn Set m => Map .mapPartial mf m
end ;
fun map f =
let
fun mf (elt,()) = f elt
in
fn Set m => Map .map mf m
end ;
fun domain m = Set (Map .transform (fn _ => ()) m);
(* ------------------------------------------------------------------------- *)
(* Constructors. *)
(* ------------------------------------------------------------------------- *)
fun empty cmp = Set (Map .new cmp);
fun singleton cmp elt = Set (Map .singleton cmp (elt,()));
(* ------------------------------------------------------------------------- *)
(* Set size. *)
(* ------------------------------------------------------------------------- *)
fun null (Set m) = Map .null m;
fun size (Set m) = Map .size m;
(* ------------------------------------------------------------------------- *)
(* Querying. *)
(* ------------------------------------------------------------------------- *)
fun peek (Set m) elt =
case Map .peekKey m elt of
SOME (elt,()) => SOME elt
| NONE => NONE;
fun member elt (Set m) = Map .inDomain elt m;
fun pick (Set m) =
let
val (elt,_) = Map .pick m
in
elt
end ;
fun nth (Set m) n =
let
val (elt,_) = Map .nth m n
in
elt
end ;
fun random (Set m) =
let
val (elt,_) = Map .random m
in
elt
end ;
(* ------------------------------------------------------------------------- *)
(* Adding. *)
(* ------------------------------------------------------------------------- *)
fun add (Set m) elt =
let
val m = Map .insert m (elt,())
in
Set m
end ;
local
fun uncurriedAdd (elt,set ) = add set elt;
in
fun addList set = List .foldl uncurriedAdd set ;
end ;
(* ------------------------------------------------------------------------- *)
(* Removing. *)
(* ------------------------------------------------------------------------- *)
fun delete (Set m) elt =
let
val m = Map .delete m elt
in
Set m
end ;
fun remove (Set m) elt =
let
val m = Map .remove m elt
in
Set m
end ;
fun deletePick (Set m) =
let
val ((elt,()),m) = Map .deletePick m
in
(elt, Set m)
end ;
fun deleteNth (Set m) n =
let
val ((elt,()),m) = Map .deleteNth m n
in
(elt, Set m)
end ;
fun deleteRandom (Set m) =
let
val ((elt,()),m) = Map .deleteRandom m
in
(elt, Set m)
end ;
(* ------------------------------------------------------------------------- *)
(* Joining. *)
(* ------------------------------------------------------------------------- *)
fun union (Set m1) (Set m2) = Set (Map .unionDomain m1 m2);
fun unionList sets =
let
val ms = List .map dest sets
in
Set (Map .unionListDomain ms)
end ;
fun intersect (Set m1) (Set m2) = Set (Map .intersectDomain m1 m2);
fun intersectList sets =
let
val ms = List .map dest sets
in
Set (Map .intersectListDomain ms)
end ;
fun difference (Set m1) (Set m2) =
Set (Map .differenceDomain m1 m2);
fun symmetricDifference (Set m1) (Set m2) =
Set (Map .symmetricDifferenceDomain m1 m2);
(* ------------------------------------------------------------------------- *)
(* Mapping and folding. *)
(* ------------------------------------------------------------------------- *)
fun filter pred =
let
fun mpred (elt,()) = pred elt
in
fn Set m => Set (Map .filter mpred m)
end ;
fun partition pred =
let
fun mpred (elt,()) = pred elt
in
fn Set m =>
let
val (m1,m2) = Map .partition mpred m
in
(Set m1, Set m2)
end
end ;
fun app f =
let
fun mf (elt,()) = f elt
in
fn Set m => Map .app mf m
end ;
fun foldl f =
let
fun mf (elt,(),acc) = f (elt,acc)
in
fn acc => fn Set m => Map .foldl mf acc m
end ;
fun foldr f =
let
fun mf (elt,(),acc) = f (elt,acc)
in
fn acc => fn Set m => Map .foldr mf acc m
end ;
(* ------------------------------------------------------------------------- *)
(* Searching. *)
(* ------------------------------------------------------------------------- *)
fun findl p =
let
fun mp (elt,()) = p elt
in
fn Set m =>
case Map .findl mp m of
SOME (elt,()) => SOME elt
| NONE => NONE
end ;
fun findr p =
let
fun mp (elt,()) = p elt
in
fn Set m =>
case Map .findr mp m of
SOME (elt,()) => SOME elt
| NONE => NONE
end ;
fun firstl f =
let
fun mf (elt,()) = f elt
in
fn Set m => Map .firstl mf m
end ;
fun firstr f =
let
fun mf (elt,()) = f elt
in
fn Set m => Map .firstr mf m
end ;
fun exists p =
let
fun mp (elt,()) = p elt
in
fn Set m => Map .exists mp m
end ;
fun all p =
let
fun mp (elt,()) = p elt
in
fn Set m => Map .all mp m
end ;
fun count p =
let
fun mp (elt,()) = p elt
in
fn Set m => Map .count mp m
end ;
(* ------------------------------------------------------------------------- *)
(* Comparing. *)
(* ------------------------------------------------------------------------- *)
fun compareValue ((),()) = EQUAL;
fun equalValue () () = true ;
fun compare (Set m1, Set m2) = Map .compare compareValue (m1,m2);
fun equal (Set m1) (Set m2) = Map .equal equalValue m1 m2;
fun subset (Set m1) (Set m2) = Map .subsetDomain m1 m2;
fun disjoint (Set m1) (Set m2) = Map .disjointDomain m1 m2;
(* ------------------------------------------------------------------------- *)
(* Converting to and from lists. *)
(* ------------------------------------------------------------------------- *)
fun transform f =
let
fun inc (x,l) = f x :: l
in
foldr inc []
end ;
fun toList (Set m) = Map .keys m;
fun fromList cmp elts = addList (empty cmp) elts;
(* ------------------------------------------------------------------------- *)
(* Pretty-printing. *)
(* ------------------------------------------------------------------------- *)
fun toString set =
"{" ^ (if null set then "" else Int.toString (size set )) ^ "}" ;
(* ------------------------------------------------------------------------- *)
(* Iterators over sets *)
(* ------------------------------------------------------------------------- *)
type 'elt iterator = (' elt,unit) Map .iterator;
fun mkIterator (Set m) = Map .mkIterator m;
fun mkRevIterator (Set m) = Map .mkRevIterator m;
fun readIterator iter =
let
val (elt,()) = Map .readIterator iter
in
elt
end ;
fun advanceIterator iter = Map .advanceIterator iter;
end
quality 99%
¤ Dauer der Verarbeitung: 0.2 Sekunden
(vorverarbeitet)
¤
*© Formatika GbR, Deutschland