Util/Set.hs

   1 module Util.Set where
   2 import qualified Data.List as List
   3 import Data.Maybe (fromJust)
   4 import Data.Set (Set)
   5 import qualified Data.Set as Set
   6 import Data.Tuple (swap)
   7
   8 allSet :: (a -> Bool) -> Set a -> Bool
   9 allSet p = all p . Set.toList
  10
  11 anySet :: (a -> Bool) -> Set a -> Bool
  12 anySet p = any p . Set.toList
  13
  14 subsetsOfSize :: Ord a => Integer -> Set a -> Set (Set a)
  15 subsetsOfSize n xs = case compare n 0 of
  16   LT -> Set.empty
  17   EQ -> Set.singleton Set.empty
  18   GT -> case Set.minView xs of
  19     Nothing -> Set.empty
  20     Just (x, xs') -> Set.union
  21       (subsetsOfSize n xs') $
  22       Set.map (Set.insert x) $ subsetsOfSize (n - 1) xs'
  23
  24 distinctPairsOneWay :: Ord a => Set a -> Set (a, a)
  25 distinctPairsOneWay =
  26   Set.map (\xys -> let [x, y] = Set.toList xys in (x, y)) . subsetsOfSize 2
  27
  28 distinctPairs :: Ord a => Set a -> Set (a, a)
  29 distinctPairs xs =
  30   let dpow = distinctPairsOneWay xs in
  31   Set.union dpow $ Set.map swap dpow
  32
  33 distinctTriplesOneWay :: Ord a => Set a -> Set (a, a, a)
  34 distinctTriplesOneWay =
  35   Set.map (\xyzs -> let [x, y, z] = Set.toList xyzs in (x, y, z))
  36   . subsetsOfSize 3
  37