1(* ========================================================================= *) 2(* FINITE SETS IMPLEMENTED WITH RANDOMLY BALANCED TREES *) 3(* Copyright (c) 2004 Joe Hurd, distributed under the BSD License *) 4(* ========================================================================= *) 5 6structure Set :> Set = 7struct 8 9(* ------------------------------------------------------------------------- *) 10(* A type of finite sets. *) 11(* ------------------------------------------------------------------------- *) 12 13type ('elt,'a) map = ('elt,'a) Map.map; 14 15datatype 'elt set = Set of ('elt,unit) map; 16 17(* ------------------------------------------------------------------------- *) 18(* Converting to and from maps. *) 19(* ------------------------------------------------------------------------- *) 20 21fun dest (Set m) = m; 22 23fun mapPartial f = 24 let 25 fun mf (elt,()) = f elt 26 in 27 fn Set m => Map.mapPartial mf m 28 end; 29 30fun map f = 31 let 32 fun mf (elt,()) = f elt 33 in 34 fn Set m => Map.map mf m 35 end; 36 37fun domain m = Set (Map.transform (fn _ => ()) m); 38 39(* ------------------------------------------------------------------------- *) 40(* Constructors. *) 41(* ------------------------------------------------------------------------- *) 42 43fun empty cmp = Set (Map.new cmp); 44 45fun singleton cmp elt = Set (Map.singleton cmp (elt,())); 46 47(* ------------------------------------------------------------------------- *) 48(* Set size. *) 49(* ------------------------------------------------------------------------- *) 50 51fun null (Set m) = Map.null m; 52 53fun size (Set m) = Map.size m; 54 55(* ------------------------------------------------------------------------- *) 56(* Querying. *) 57(* ------------------------------------------------------------------------- *) 58 59fun peek (Set m) elt = 60 case Map.peekKey m elt of 61 SOME (elt,()) => SOME elt 62 | NONE => NONE; 63 64fun member elt (Set m) = Map.inDomain elt m; 65 66fun pick (Set m) = 67 let 68 val (elt,_) = Map.pick m 69 in 70 elt 71 end; 72 73fun nth (Set m) n = 74 let 75 val (elt,_) = Map.nth m n 76 in 77 elt 78 end; 79 80fun random (Set m) = 81 let 82 val (elt,_) = Map.random m 83 in 84 elt 85 end; 86 87(* ------------------------------------------------------------------------- *) 88(* Adding. *) 89(* ------------------------------------------------------------------------- *) 90 91fun add (Set m) elt = 92 let 93 val m = Map.insert m (elt,()) 94 in 95 Set m 96 end; 97 98local 99 fun uncurriedAdd (elt,set) = add set elt; 100in 101 fun addList set = List.foldl uncurriedAdd set; 102end; 103 104(* ------------------------------------------------------------------------- *) 105(* Removing. *) 106(* ------------------------------------------------------------------------- *) 107 108fun delete (Set m) elt = 109 let 110 val m = Map.delete m elt 111 in 112 Set m 113 end; 114 115fun remove (Set m) elt = 116 let 117 val m = Map.remove m elt 118 in 119 Set m 120 end; 121 122fun deletePick (Set m) = 123 let 124 val ((elt,()),m) = Map.deletePick m 125 in 126 (elt, Set m) 127 end; 128 129fun deleteNth (Set m) n = 130 let 131 val ((elt,()),m) = Map.deleteNth m n 132 in 133 (elt, Set m) 134 end; 135 136fun deleteRandom (Set m) = 137 let 138 val ((elt,()),m) = Map.deleteRandom m 139 in 140 (elt, Set m) 141 end; 142 143(* ------------------------------------------------------------------------- *) 144(* Joining. *) 145(* ------------------------------------------------------------------------- *) 146 147fun union (Set m1) (Set m2) = Set (Map.unionDomain m1 m2); 148 149fun unionList sets = 150 let 151 val ms = List.map dest sets 152 in 153 Set (Map.unionListDomain ms) 154 end; 155 156fun intersect (Set m1) (Set m2) = Set (Map.intersectDomain m1 m2); 157 158fun intersectList sets = 159 let 160 val ms = List.map dest sets 161 in 162 Set (Map.intersectListDomain ms) 163 end; 164 165fun difference (Set m1) (Set m2) = 166 Set (Map.differenceDomain m1 m2); 167 168fun symmetricDifference (Set m1) (Set m2) = 169 Set (Map.symmetricDifferenceDomain m1 m2); 170 171(* ------------------------------------------------------------------------- *) 172(* Mapping and folding. *) 173(* ------------------------------------------------------------------------- *) 174 175fun filter pred = 176 let 177 fun mpred (elt,()) = pred elt 178 in 179 fn Set m => Set (Map.filter mpred m) 180 end; 181 182fun partition pred = 183 let 184 fun mpred (elt,()) = pred elt 185 in 186 fn Set m => 187 let 188 val (m1,m2) = Map.partition mpred m 189 in 190 (Set m1, Set m2) 191 end 192 end; 193 194fun app f = 195 let 196 fun mf (elt,()) = f elt 197 in 198 fn Set m => Map.app mf m 199 end; 200 201fun foldl f = 202 let 203 fun mf (elt,(),acc) = f (elt,acc) 204 in 205 fn acc => fn Set m => Map.foldl mf acc m 206 end; 207 208fun foldr f = 209 let 210 fun mf (elt,(),acc) = f (elt,acc) 211 in 212 fn acc => fn Set m => Map.foldr mf acc m 213 end; 214 215(* ------------------------------------------------------------------------- *) 216(* Searching. *) 217(* ------------------------------------------------------------------------- *) 218 219fun findl p = 220 let 221 fun mp (elt,()) = p elt 222 in 223 fn Set m => 224 case Map.findl mp m of 225 SOME (elt,()) => SOME elt 226 | NONE => NONE 227 end; 228 229fun findr p = 230 let 231 fun mp (elt,()) = p elt 232 in 233 fn Set m => 234 case Map.findr mp m of 235 SOME (elt,()) => SOME elt 236 | NONE => NONE 237 end; 238 239fun firstl f = 240 let 241 fun mf (elt,()) = f elt 242 in 243 fn Set m => Map.firstl mf m 244 end; 245 246fun firstr f = 247 let 248 fun mf (elt,()) = f elt 249 in 250 fn Set m => Map.firstr mf m 251 end; 252 253fun exists p = 254 let 255 fun mp (elt,()) = p elt 256 in 257 fn Set m => Map.exists mp m 258 end; 259 260fun all p = 261 let 262 fun mp (elt,()) = p elt 263 in 264 fn Set m => Map.all mp m 265 end; 266 267fun count p = 268 let 269 fun mp (elt,()) = p elt 270 in 271 fn Set m => Map.count mp m 272 end; 273 274(* ------------------------------------------------------------------------- *) 275(* Comparing. *) 276(* ------------------------------------------------------------------------- *) 277 278fun compareValue ((),()) = EQUAL; 279 280fun equalValue () () = true; 281 282fun compare (Set m1, Set m2) = Map.compare compareValue (m1,m2); 283 284fun equal (Set m1) (Set m2) = Map.equal equalValue m1 m2; 285 286fun subset (Set m1) (Set m2) = Map.subsetDomain m1 m2; 287 288fun disjoint (Set m1) (Set m2) = Map.disjointDomain m1 m2; 289 290(* ------------------------------------------------------------------------- *) 291(* Converting to and from lists. *) 292(* ------------------------------------------------------------------------- *) 293 294fun transform f = 295 let 296 fun inc (x,l) = f x :: l 297 in 298 foldr inc [] 299 end; 300 301fun toList (Set m) = Map.keys m; 302 303fun fromList cmp elts = addList (empty cmp) elts; 304 305(* ------------------------------------------------------------------------- *) 306(* Pretty-printing. *) 307(* ------------------------------------------------------------------------- *) 308 309fun toString set = 310 "{" ^ (if null set then "" else Int.toString (size set)) ^ "}"; 311 312(* ------------------------------------------------------------------------- *) 313(* Iterators over sets *) 314(* ------------------------------------------------------------------------- *) 315 316type 'elt iterator = ('elt,unit) Map.iterator; 317 318fun mkIterator (Set m) = Map.mkIterator m; 319 320fun mkRevIterator (Set m) = Map.mkRevIterator m; 321 322fun readIterator iter = 323 let 324 val (elt,()) = Map.readIterator iter 325 in 326 elt 327 end; 328 329fun advanceIterator iter = Map.advanceIterator iter; 330 331end 332