module Util.Relation where
import Data.Monoid
import Data.Set as Set hiding(map)
import Util.SetLike
import qualified Data.Set as Set
import qualified Data.Map as Map
newtype Rel a b = Rel (Map.Map a (Set b))
deriving(Eq)
instance (Ord a,Ord b) => Monoid (Rel a b) where
mempty = Rel mempty
mappend (Rel r1) (Rel r2) = Rel $ Map.unionWith Set.union r1 r2
instance (Ord a,Ord b) => Unionize (Rel a b) where
difference (Rel r1) (Rel r2) = Rel $ Map.differenceWith f r1 r2 where
f r1 r2 = if Set.null rs then Nothing else Just rs where
rs = Set.difference r1 r2
intersection (Rel r1) (Rel r2) = prune $ Map.intersectionWith Set.intersection r1 r2
instance (Ord a,Ord b) => Collection (Rel a b) where
fromList xs = Rel $ Map.fromListWith Set.union [ (x,Set.singleton y) | (x,y) <- xs ]
toList (Rel r) = [ (x,y) | (x,ys) <- Map.toList r, y <- Set.toList ys]
prune r = Rel $ Map.mapMaybe f r where
f s = if Set.null s then Nothing else Just s
type instance Elem (Rel a b) = (a,b)
type instance Key (Rel a b) = (a,b)
domain :: (Ord a,Ord b) => Rel a b -> Set a
domain (Rel r) = Map.keysSet r
range :: (Ord a,Ord b) => Rel a b -> Set b
range (Rel r) = Set.unions $ Map.elems r
restrictDomain :: (Ord a, Ord b) => (a -> Bool) -> Rel a b -> Rel a b
restrictDomain f (Rel r) = Rel $ Map.filterWithKey (\k _ -> f k) r
restrictDomainS :: (Ord a, Ord b) => a -> Rel a b -> Rel a b
restrictDomainS x (Rel r) = case Map.lookup x r of
Nothing -> Rel mempty
Just v -> Rel $ Map.singleton x v
restrictDomainSet :: (Ord a, Ord b) => Set a -> Rel a b -> Rel a b
restrictDomainSet s (Rel r) = Rel $ Map.filterWithKey (\k _ -> k `Set.member` s) r
restrictRange :: (Ord a, Ord b) => (b -> Bool) -> Rel a b -> Rel a b
restrictRange f (Rel r) = Rel $ Map.mapMaybe g r where
g s = if Set.null ss then Nothing else Just ss where
ss = Set.filter f s
mapDomain :: (Ord a, Ord b, Ord c) => (a -> c) -> Rel a b -> Rel c b
mapDomain f (Rel r) = Rel $ Map.mapKeys f r
mapRange :: (Ord a, Ord b, Ord c) => (b -> c) -> Rel a b -> Rel a c
mapRange f (Rel r) = Rel $ Map.map (Set.map f) r
partitionDomain f (Rel r) = case Map.partitionWithKey (\k _ -> f k) r of
(x,y) -> (Rel x,Rel y)
unRel (Rel r) = r
toRelationList :: (Ord a, Ord b) => Rel a b -> [(a,[b])]
toRelationList (Rel r) = Map.toList (Map.map Set.toList r)