Relations.lhs

  module Relations where
 
  import FiniteMap(emptyFM,addListToFM_C,lookupWithDefaultFM)
  import Sets











  type Rel a b = Set (a,b)









  listToRel :: (Ord a,Ord b) => [(a,b)] -> Rel a b
  listToRel xs = mkSet xs

  relToList :: Rel a b -> [(a,b)]
  relToList r = setToList r



  emptyRel :: Rel a b
  emptyRel = emptySet





  restrictDom :: (Ord a, Ord b) => 
    (a -> Bool) -> Rel a b -> Rel a b
  restrictDom p r = listToRel [(x,y) | (x,y) <- relToList r, p x]

  restrictRng :: (Ord a, Ord b) => 
    (b -> Bool) -> Rel a b -> Rel a b
  restrictRng p r = listToRel [(x,y) | (x,y) <- relToList r, p y]




  --dom :: Ord a => Rel a b -> Set a
  dom r = mapSet fst r

  --rng :: Ord b => Rel a b -> Set b
  rng r = mapSet snd r





  --mapDom :: (Ord b, Ord x) => 
  --  (a -> x) -> Rel a b -> Rel x b
  mapDom f = mapSet (\(x,y) -> (f x, y)) 

  --mapRng :: (Ord a, Ord x) => 
  --  (b -> x) -> Rel a b -> Rel a x
  mapRng f = mapSet (\(x,y) -> (x, f y)) 






  intersectRel :: (Ord a, Ord b) => 
    Rel a b -> Rel a b -> Rel a b
  r `intersectRel` s = r `intersect` s

  unionRels :: (Ord a, Ord b) => [Rel a b] -> Rel a b
  unionRels rs = unionManySets rs





  minusRel :: (Ord a, Ord b) => 
    Rel a b -> Rel a b -> Rel a b
  r `minusRel` s = r `minusSet` s





  partitionDom :: (Ord a, Ord b) =>
    (a -> Bool) -> Rel a b -> (Rel a b, Rel a b)
  partitionDom p r = (restrictDom p r, restrictDom (not . p) r)











  applyRel :: (Ord a, Ord b) => Rel a b -> a -> [b]
  --applyRel r a = setToList (rng (restrictDom (== a) r))
  --applyRel r a = [b|(a',b)<-setToList r,a'==a] -- not faster...
  applyRel r = lookupWithDefaultFM fm []
    where fm = addListToFM_C (++) emptyFM [(a,[b])|(a,b)<-setToList r]






  unionMapSet :: Ord b => (a -> Set b) -> (Set a -> Set b)
  unionMapSet f = unionManySets . map f . setToList