module Unison.Util.Relation
  ( Relation,

    -- * Initialization
    empty,
    singleton,
    fromList,
    fromManyDom,
    fromManyRan,
    fromMap,
    fromMultimap,
    fromSet,
    unsafeFromMultimaps,

    -- * Queries
    null,
    size,
    member,
    notMember,
    memberDom,
    memberRan,
    lookupDom,
    lookupRan,
    manyDom,
    manyRan,
    (<$|),
    (|$>),

    -- ** Searches
    searchDom,
    searchDomG,
    searchRan,

    -- ** Filters
    filter,
    Unison.Util.Relation.filterM,
    filterDom,
    filterDomM,
    filterManyDom,
    filterRan,
    filterRanM,
    subtractDom,
    (<||),
    subtractRan,
    (||>),
    restrictDom,
    (<|),
    restrictRan,
    (|>),
    collectRan,

    -- ** Folds
    foldlStrict,

    -- * General traversals
    map,
    mapDom,
    mapDomMonotonic,
    mapRan,
    mapRanMonotonic,
    bimap,
    bitraverse,

    -- * Manipulations
    swap,
    insert,
    insertManyDom,
    insertManyRan,
    delete,
    deleteDom,
    deleteRan,
    deleteDomWhere,
    deleteRanWhere,
    replaceDom,
    replaceRan,
    updateDom,
    updateRan,

    -- ** Combinations
    difference,
    difference1,
    intersection,
    joinDom,
    joinRan,
    innerJoinDomMultimaps,
    innerJoinRanMultimaps,
    outerJoinDomMultimaps,
    outerJoinRanMultimaps,
    union,
    unions,
    unionDomainWith,
    unionRangeWith,

    -- * Converting to other data structures
    toList,
    domain,
    range,
    toMap,

    -- ** Multimap
    toMultimap,
    toUnzippedMultimap,

    -- ** Set
    dom,
    ran,
    toSet,
  )
where

import Control.DeepSeq
import Control.Monad qualified as Monad
import Data.Function (on)
import Data.List qualified as List
import Data.Map qualified as M
import Data.Map qualified as Map
import Data.Map.Internal qualified as Map
import Data.Ord (comparing)
import Data.Set qualified as S
import Data.Set qualified as Set
import Unison.Prelude hiding (bimap, empty, toList)
import Unison.Util.Map qualified as Map
import Unison.Util.Set qualified as Set
import Prelude hiding (filter, map, null)

-- |
-- This implementation avoids using @"Set (a,b)"@ because
-- it it is necessary to search for an item without knowing both @D@ and @R@.
--
-- In "Set", you must know both values to search.
--
-- Thus, we have are two maps to updated together.
--
-- 1. Always be careful with the associated set of the key.
--
-- 2. If you union two relations, apply union to the set of values.
--
-- 3. If you subtract, take care when handling the set of values.
--
-- As a multi-map, each key is associated with a Set of values v.
--
-- We do not allow the associations with the 'empty' Set.
data Relation a b = Relation
  { forall a b. Relation a b -> Map a (Set b)
domain :: Map a (Set b),
    forall a b. Relation a b -> Map b (Set a)
range :: Map b (Set a)
  }

instance (Eq a, Eq b) => Eq (Relation a b) where
  == :: Relation a b -> Relation a b -> Bool
(==) = Map a (Set b) -> Map a (Set b) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Map a (Set b) -> Map a (Set b) -> Bool)
-> (Relation a b -> Map a (Set b))
-> Relation a b
-> Relation a b
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain

instance (NFData a, NFData b) => NFData (Relation a b) where
  rnf :: Relation a b -> ()
rnf (Relation Map a (Set b)
d Map b (Set a)
r) = Map a (Set b) -> ()
forall a. NFData a => a -> ()
rnf Map a (Set b)
d () -> () -> ()
forall a b. a -> b -> b
`seq` Map b (Set a) -> ()
forall a. NFData a => a -> ()
rnf Map b (Set a)
r

instance (Ord a, Ord b) => Ord (Relation a b) where
  compare :: Relation a b -> Relation a b -> Ordering
compare = (Relation a b -> Map a (Set b))
-> Relation a b -> Relation a b -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain

instance (Show a, Show b) => Show (Relation a b) where
  show :: Relation a b -> String
show = [(a, b)] -> String
forall a. Show a => a -> String
show ([(a, b)] -> String)
-> (Relation a b -> [(a, b)]) -> Relation a b -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList

-- | Construct a relation from a mapping from the domain and range mappings.
--
-- /Precondition/: the multimaps together form a valid relation; i.e. if @x@ is related to @y@ in one map then @y@ is
-- related to @x@ in the other.
--
-- /O(1)/.
unsafeFromMultimaps :: Map a (Set b) -> Map b (Set a) -> Relation a b
unsafeFromMultimaps :: forall a b. Map a (Set b) -> Map b (Set a) -> Relation a b
unsafeFromMultimaps Map a (Set b)
domain Map b (Set a)
range =
  Relation {Map a (Set b)
domain :: Map a (Set b)
domain :: Map a (Set b)
domain, Map b (Set a)
range :: Map b (Set a)
range :: Map b (Set a)
range}

-- * Functions about relations

-- | Compute the difference of two relations.
difference :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b
difference :: forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
difference (Relation Map a (Set b)
d1 Map b (Set a)
r1) (Relation Map a (Set b)
d2 Map b (Set a)
r2) =
  Map a (Set b) -> Map b (Set a) -> Relation a b
forall a b. Map a (Set b) -> Map b (Set a) -> Relation a b
Relation
    ((Set b -> Set b -> Maybe (Set b))
-> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith Set b -> Set b -> Maybe (Set b)
forall a. Ord a => Set a -> Set a -> Maybe (Set a)
Set.difference1 Map a (Set b)
d1 Map a (Set b)
d2)
    ((Set a -> Set a -> Maybe (Set a))
-> Map b (Set a) -> Map b (Set a) -> Map b (Set a)
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith Set a -> Set a -> Maybe (Set a)
forall a. Ord a => Set a -> Set a -> Maybe (Set a)
Set.difference1 Map b (Set a)
r1 Map b (Set a)
r2)

-- | Like 'difference', but returns @Nothing@ if the difference is empty.
difference1 :: (Ord a, Ord b) => Relation a b -> Relation a b -> Maybe (Relation a b)
difference1 :: forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Maybe (Relation a b)
difference1 Relation a b
xs Relation a b
ys =
  if Relation a b -> Bool
forall a b. Relation a b -> Bool
null Relation a b
zs then Maybe (Relation a b)
forall a. Maybe a
Nothing else Relation a b -> Maybe (Relation a b)
forall a. a -> Maybe a
Just Relation a b
zs
  where
    zs :: Relation a b
zs = Relation a b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
difference Relation a b
xs Relation a b
ys

-- The size is calculated using the domain.

-- |  @size r@ returns the number of tuples in the relation.
size :: Relation a b -> Int
size :: forall a b. Relation a b -> Int
size Relation a b
r = (Set b -> Int -> Int) -> Int -> Map a (Set b) -> Int
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr' (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> (Set b -> Int) -> Set b -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set b -> Int
forall a. Set a -> Int
S.size) Int
0 (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r)

-- | Construct a relation with no elements.
empty :: Relation a b
empty :: forall a b. Relation a b
empty = Map a (Set b) -> Map b (Set a) -> Relation a b
forall a b. Map a (Set b) -> Map b (Set a) -> Relation a b
Relation Map a (Set b)
forall k a. Map k a
M.empty Map b (Set a)
forall k a. Map k a
M.empty

-- |
-- The list must be formatted like: [(k1, v1), (k2, v2),..,(kn, vn)].
fromList :: (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList :: forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList [(a, b)]
xs =
  Relation
    { domain :: Map a (Set b)
domain = (Set b -> Set b -> Set b) -> [(a, Set b)] -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
S.union ([(a, Set b)] -> Map a (Set b)) -> [(a, Set b)] -> Map a (Set b)
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> [(a, Set b)]
forall {a} {a}. [(a, a)] -> [(a, Set a)]
snd2Set [(a, b)]
xs,
      range :: Map b (Set a)
range = (Set a -> Set a -> Set a) -> [(b, Set a)] -> Map b (Set a)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union ([(b, Set a)] -> Map b (Set a)) -> [(b, Set a)] -> Map b (Set a)
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> [(b, Set a)]
forall {a} {a}. [(a, a)] -> [(a, Set a)]
flipAndSet [(a, b)]
xs
    }
  where
    snd2Set :: [(a, a)] -> [(a, Set a)]
snd2Set = ((a, a) -> (a, Set a)) -> [(a, a)] -> [(a, Set a)]
forall a b. (a -> b) -> [a] -> [b]
List.map (\(a
x, a
y) -> (a
x, a -> Set a
forall a. a -> Set a
S.singleton a
y))
    flipAndSet :: [(a, a)] -> [(a, Set a)]
flipAndSet = ((a, a) -> (a, Set a)) -> [(a, a)] -> [(a, Set a)]
forall a b. (a -> b) -> [a] -> [b]
List.map (\(a
x, a
y) -> (a
y, a -> Set a
forall a. a -> Set a
S.singleton a
x))

-- |
-- Builds a List from a Relation.
toList :: Relation a b -> [(a, b)]
toList :: forall a b. Relation a b -> [(a, b)]
toList Relation a b
r =
  ((a, Set b) -> [(a, b)]) -> [(a, Set b)] -> [(a, b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
x, Set b
y) -> [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (a -> [a]
forall a. a -> [a]
repeat a
x) (Set b -> [b]
forall a. Set a -> [a]
S.toList Set b
y)) (Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
M.toList (Map a (Set b) -> [(a, Set b)])
-> (Relation a b -> Map a (Set b)) -> Relation a b -> [(a, Set b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain (Relation a b -> [(a, Set b)]) -> Relation a b -> [(a, Set b)]
forall a b. (a -> b) -> a -> b
$ Relation a b
r)

-- | Builds a Set from a Relation
toSet :: (Ord a, Ord b) => Relation a b -> S.Set (a, b)
toSet :: forall a b. (Ord a, Ord b) => Relation a b -> Set (a, b)
toSet = [(a, b)] -> Set (a, b)
forall a. Ord a => [a] -> Set a
S.fromList ([(a, b)] -> Set (a, b))
-> (Relation a b -> [(a, b)]) -> Relation a b -> Set (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList

-- |
-- Builds a 'Relation' consiting of an association between: @x@ and @y@.
singleton :: a -> b -> Relation a b
singleton :: forall a b. a -> b -> Relation a b
singleton a
x b
y =
  Relation
    { domain :: Map a (Set b)
domain = a -> Set b -> Map a (Set b)
forall k a. k -> a -> Map k a
M.singleton a
x (b -> Set b
forall a. a -> Set a
S.singleton b
y),
      range :: Map b (Set a)
range = b -> Set a -> Map b (Set a)
forall k a. k -> a -> Map k a
M.singleton b
y (a -> Set a
forall a. a -> Set a
S.singleton a
x)
    }

-- | The 'Relation' that results from the union of two relations: @r@ and @s@.
union :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b
union :: forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
union Relation a b
r Relation a b
s =
  Relation
    { domain :: Map a (Set b)
domain = (Set b -> Set b -> Set b)
-> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
S.union (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r) (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
s),
      range :: Map b (Set a)
range = (Set a -> Set a -> Set a)
-> Map b (Set a) -> Map b (Set a) -> Map b (Set a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
r) (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
s)
    }

unionDomainWith :: (Ord a, Ord b) => (a -> Set b -> Set b -> Set b) -> Relation a b -> Relation a b -> Relation a b
unionDomainWith :: forall a b.
(Ord a, Ord b) =>
(a -> Set b -> Set b -> Set b)
-> Relation a b -> Relation a b -> Relation a b
unionDomainWith a -> Set b -> Set b -> Set b
f Relation a b
xs Relation a b
ys =
  Map a (Set b) -> Relation a b
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
fromMultimap ((a -> Set b -> Set b -> Set b)
-> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey a -> Set b -> Set b -> Set b
f (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
xs) (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
ys))

unionRangeWith :: (Ord a, Ord b) => (b -> Set a -> Set a -> Set a) -> Relation a b -> Relation a b -> Relation a b
unionRangeWith :: forall a b.
(Ord a, Ord b) =>
(b -> Set a -> Set a -> Set a)
-> Relation a b -> Relation a b -> Relation a b
unionRangeWith b -> Set a -> Set a -> Set a
f Relation a b
xs Relation a b
ys =
  Relation b a -> Relation a b
forall a b. Relation a b -> Relation b a
swap (Map b (Set a) -> Relation b a
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
fromMultimap ((b -> Set a -> Set a -> Set a)
-> Map b (Set a) -> Map b (Set a) -> Map b (Set a)
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey b -> Set a -> Set a -> Set a
f (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
xs) (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
ys)))

intersection :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b
intersection :: forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
intersection Relation a b
r Relation a b
s =
  Relation
    { domain :: Map a (Set b)
domain = (Set b -> Set b -> Set b)
-> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r) (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
s),
      range :: Map b (Set a)
range = (Set a -> Set a -> Set a)
-> Map b (Set a) -> Map b (Set a) -> Map b (Set a)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
r) (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
s)
    }

outerJoinDomMultimaps ::
  (Ord a, Ord b, Ord c) =>
  Relation a b ->
  Relation a c ->
  Map a (Set b, Set c)
outerJoinDomMultimaps :: forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a b -> Relation a c -> Map a (Set b, Set c)
outerJoinDomMultimaps Relation a b
b Relation a c
c =
  [(a, (Set b, Set c))] -> Map a (Set b, Set c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [(a
a, (a -> Relation a b -> Set b
forall a b. Ord a => a -> Relation a b -> Set b
lookupDom a
a Relation a b
b, a -> Relation a c -> Set c
forall a b. Ord a => a -> Relation a b -> Set b
lookupDom a
a Relation a c
c)) | a
a <- Set a -> [a]
forall a. Set a -> [a]
S.toList (Relation a b -> Set a
forall a b. Relation a b -> Set a
dom Relation a b
b Set a -> Set a -> Set a
forall a. Semigroup a => a -> a -> a
<> Relation a c -> Set a
forall a b. Relation a b -> Set a
dom Relation a c
c)]

outerJoinRanMultimaps ::
  (Ord a, Ord b, Ord c) =>
  Relation a c ->
  Relation b c ->
  Map c (Set a, Set b)
outerJoinRanMultimaps :: forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a c -> Relation b c -> Map c (Set a, Set b)
outerJoinRanMultimaps Relation a c
a Relation b c
b = Relation c a -> Relation c b -> Map c (Set a, Set b)
forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a b -> Relation a c -> Map a (Set b, Set c)
outerJoinDomMultimaps (Relation a c -> Relation c a
forall a b. Relation a b -> Relation b a
swap Relation a c
a) (Relation b c -> Relation c b
forall a b. Relation a b -> Relation b a
swap Relation b c
b)

-- | @innerJoinDomMultimaps xs ys@ returns the "inner join" of the domains of @xs@ and @ys@, which has intersection-like
-- semantics:
--
-- * @a@s that do not exist in both @xs@ and @ys@ are dropped.
-- * The @a@s that remain are therefore associated with non-empty sets of @b@s and @c@s.
--
-- /O(a2 * log(a1/a2 + 1)), a1 <= a2/, where /a1/ and /a2/ are the numbers of elements in each relation's domain.
innerJoinDomMultimaps ::
  (Ord a, Ord b, Ord c) =>
  Relation a b ->
  Relation a c ->
  Map a (Set b, Set c)
innerJoinDomMultimaps :: forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a b -> Relation a c -> Map a (Set b, Set c)
innerJoinDomMultimaps Relation a b
b Relation a c
c =
  (Set b -> Set c -> (Set b, Set c))
-> Map a (Set b) -> Map a (Set c) -> Map a (Set b, Set c)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,) (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
b) (Relation a c -> Map a (Set c)
forall a b. Relation a b -> Map a (Set b)
domain Relation a c
c)

-- | @innerJoinRanMultimaps xs ys@ returns the "inner join" of the ranges of @xs@ and @ys@. See 'innerJoinDomMultimaps'
-- for more info.
--
-- /O(c2 * log(c1/c2 + 1)), c1 <= c2/, where /c1/ and /c2/ are the numbers of elements in each relation's range.
innerJoinRanMultimaps ::
  (Ord a, Ord b, Ord c) =>
  Relation a c ->
  Relation b c ->
  Map c (Set a, Set b)
innerJoinRanMultimaps :: forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a c -> Relation b c -> Map c (Set a, Set b)
innerJoinRanMultimaps Relation a c
a Relation b c
b = Relation c a -> Relation c b -> Map c (Set a, Set b)
forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a b -> Relation a c -> Map a (Set b, Set c)
innerJoinDomMultimaps (Relation a c -> Relation c a
forall a b. Relation a b -> Relation b a
swap Relation a c
a) (Relation b c -> Relation c b
forall a b. Relation a b -> Relation b a
swap Relation b c
b)

joinDom :: (Ord a, Ord b, Ord c) => Relation a b -> Relation a c -> Relation a (b, c)
joinDom :: forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a b -> Relation a c -> Relation a (b, c)
joinDom Relation a b
b Relation a c
c = Relation (b, c) a -> Relation a (b, c)
forall a b. Relation a b -> Relation b a
swap (Relation (b, c) a -> Relation a (b, c))
-> Relation (b, c) a -> Relation a (b, c)
forall a b. (a -> b) -> a -> b
$ Relation b a -> Relation c a -> Relation (b, c) a
forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a c -> Relation b c -> Relation (a, b) c
joinRan (Relation a b -> Relation b a
forall a b. Relation a b -> Relation b a
swap Relation a b
b) (Relation a c -> Relation c a
forall a b. Relation a b -> Relation b a
swap Relation a c
c)

-- joinRan [(1, 'x'), (2, 'x'), (3, 'z')] [(true, 'x'), (true, 'y'), (false, 'z')]
--      == [((1,true), 'x'), ((2,true), 'x'), ((3,false), 'z')]
joinRan :: (Ord a, Ord b, Ord c) => Relation a c -> Relation b c -> Relation (a, b) c
joinRan :: forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a c -> Relation b c -> Relation (a, b) c
joinRan Relation a c
a Relation b c
b =
  [((a, b), c)] -> Relation (a, b) c
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList
    [ ((a
a, b
b), c
c)
      | c
c <- Set c -> [c]
forall a. Set a -> [a]
S.toList (Set c -> [c]) -> Set c -> [c]
forall a b. (a -> b) -> a -> b
$ Relation a c -> Set c
forall a b. Relation a b -> Set b
ran Relation a c
a Set c -> Set c -> Set c
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` Relation b c -> Set c
forall a b. Relation a b -> Set b
ran Relation b c
b,
        a
a <- Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> Set a -> [a]
forall a b. (a -> b) -> a -> b
$ c -> Relation a c -> Set a
forall b a. Ord b => b -> Relation a b -> Set a
lookupRan c
c Relation a c
a,
        b
b <- Set b -> [b]
forall a. Set a -> [a]
S.toList (Set b -> [b]) -> Set b -> [b]
forall a b. (a -> b) -> a -> b
$ c -> Relation b c -> Set b
forall b a. Ord b => b -> Relation a b -> Set a
lookupRan c
c Relation b c
b
    ]

---------------------------------------------------------------

-- |
-- This fragment provided by:
--
-- @
-- \  Module      :  Data.Map
-- \  Copyright   :  (c) Daan Leijen 2002
-- \                 (c) Andriy Palamarchuk 2008
-- \  License     :  BSD-style
-- \  Maintainer  :  libraries\@haskell.org
-- \  Stability   :  provisional
-- \  Portability :  portable
-- @
foldlStrict :: (a -> b -> a) -> a -> [b] -> a
foldlStrict :: forall a b. (a -> b -> a) -> a -> [b] -> a
foldlStrict a -> b -> a
f a
z [b]
xs = case [b]
xs of
  [] -> a
z
  (b
x : [b]
xx) -> let z' :: a
z' = a -> b -> a
f a
z b
x in a -> a -> a
forall a b. a -> b -> b
seq a
z' ((a -> b -> a) -> a -> [b] -> a
forall a b. (a -> b -> a) -> a -> [b] -> a
foldlStrict a -> b -> a
f a
z' [b]
xx)

---------------------------------------------------------------

-- | Union a list of relations using the 'empty' relation.
unions :: (Ord a, Ord b) => [Relation a b] -> Relation a b
unions :: forall a b. (Ord a, Ord b) => [Relation a b] -> Relation a b
unions = (Relation a b -> Relation a b -> Relation a b)
-> Relation a b -> [Relation a b] -> Relation a b
forall a b. (a -> b -> a) -> a -> [b] -> a
foldlStrict Relation a b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
union Relation a b
forall a b. Relation a b
empty

-- | Insert a relation @ x @ and @ y @ in the relation @ r @
insert :: (Ord a, Ord b) => a -> b -> Relation a b -> Relation a b
insert :: forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
insert a
x b
y Relation a b
r =
  -- r { domain = domain', range = range' }
  Map a (Set b) -> Map b (Set a) -> Relation a b
forall a b. Map a (Set b) -> Map b (Set a) -> Relation a b
Relation Map a (Set b)
domain' Map b (Set a)
range'
  where
    domain' :: Map a (Set b)
domain' = (Set b -> Set b -> Set b)
-> a -> Set b -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
S.union a
x (b -> Set b
forall a. a -> Set a
S.singleton b
y) (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r)
    range' :: Map b (Set a)
range' = (Set a -> Set a -> Set a)
-> b -> Set a -> Map b (Set a) -> Map b (Set a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union b
y (a -> Set a
forall a. a -> Set a
S.singleton a
x) (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
r)

-- $deletenotes
--
-- The deletion is not difficult but is delicate:
--
-- @
--   r = { domain {  (k1, {v1a, v3})
--                 ,  (k2, {v2a})
--                 ,  (k3, {v3b, v3})
--                 }
--       , range   {  (v1a, {k1}
--                 ,  (v2a, {k2{
--                 ,  (v3 , {k1, k3}
--                 ,  (v3b, {k3}
--                 }
--      }
-- @
--
--   To delete (k,v) in the relation do:
--    1. Working with the domain:
--       1a. Delete v from the Set VS associated with k.
--       1b. If VS is empty, delete k in the domain.
--    2. Working in the range:
--       2a. Delete k from the Set VS associated with v.
--       2b. If VS is empty, delete v in the range.

-- |  Delete an association in the relation.
delete :: (Ord a, Ord b) => a -> b -> Relation a b -> Relation a b
delete :: forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
delete a
x b
y Relation a b
r = Relation a b
r {domain = domain', range = range'}
  where
    domain' :: Map a (Set b)
domain' = (Set b -> Maybe (Set b)) -> a -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (b -> Set b -> Maybe (Set b)
forall {a}. Ord a => a -> Set a -> Maybe (Set a)
erase b
y) a
x (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r)
    range' :: Map b (Set a)
range' = (Set a -> Maybe (Set a)) -> b -> Map b (Set a) -> Map b (Set a)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (a -> Set a -> Maybe (Set a)
forall {a}. Ord a => a -> Set a -> Maybe (Set a)
erase a
x) b
y (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
r)
    erase :: a -> Set a -> Maybe (Set a)
erase a
e Set a
s = if a -> Set a
forall a. a -> Set a
S.singleton a
e Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== Set a
s then Maybe (Set a)
forall a. Maybe a
Nothing else Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just (Set a -> Maybe (Set a)) -> Set a -> Maybe (Set a)
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete a
e Set a
s

-- | The Set of values associated with a value in the domain.
lookupDom' :: (Ord a) => a -> Relation a b -> Maybe (Set b)
lookupDom' :: forall a b. Ord a => a -> Relation a b -> Maybe (Set b)
lookupDom' a
x Relation a b
r = a -> Map a (Set b) -> Maybe (Set b)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
x (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r)

-- | The Set of values associated with a value in the range.
lookupRan' :: (Ord b) => b -> Relation a b -> Maybe (Set a)
lookupRan' :: forall b a. Ord b => b -> Relation a b -> Maybe (Set a)
lookupRan' b
y Relation a b
r = b -> Map b (Set a) -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup b
y (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
r)

-- | True if the element exists in the domain.
memberDom :: (Ord a) => a -> Relation a b -> Bool
memberDom :: forall a b. Ord a => a -> Relation a b -> Bool
memberDom a
x Relation a b
r = a -> Map a (Set b) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member a
x (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r)

-- | True if the element exists in the range.
memberRan :: (Ord b) => b -> Relation a b -> Bool
memberRan :: forall b a. Ord b => b -> Relation a b -> Bool
memberRan b
y Relation a b
r = b -> Map b (Set a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member b
y (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
r)

filterDom :: (Ord a, Ord b) => (a -> Bool) -> Relation a b -> Relation a b
filterDom :: forall a b.
(Ord a, Ord b) =>
(a -> Bool) -> Relation a b -> Relation a b
filterDom a -> Bool
f Relation a b
r = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
S.filter a -> Bool
f (Relation a b -> Set a
forall a b. Relation a b -> Set a
dom Relation a b
r) Set a -> Relation a b -> Relation a b
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
<| Relation a b
r

filterRan :: (Ord a, Ord b) => (b -> Bool) -> Relation a b -> Relation a b
filterRan :: forall a b.
(Ord a, Ord b) =>
(b -> Bool) -> Relation a b -> Relation a b
filterRan b -> Bool
f Relation a b
r = Relation a b
r Relation a b -> Set b -> Relation a b
forall a b. (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
|> (b -> Bool) -> Set b -> Set b
forall a. (a -> Bool) -> Set a -> Set a
S.filter b -> Bool
f (Relation a b -> Set b
forall a b. Relation a b -> Set b
ran Relation a b
r)

filterDomM :: (Applicative m, Ord a, Ord b) => (a -> m Bool) -> Relation a b -> m (Relation a b)
filterDomM :: forall (m :: * -> *) a b.
(Applicative m, Ord a, Ord b) =>
(a -> m Bool) -> Relation a b -> m (Relation a b)
filterDomM a -> m Bool
f = ([(a, b)] -> Relation a b) -> m [(a, b)] -> m (Relation a b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, b)] -> Relation a b
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList (m [(a, b)] -> m (Relation a b))
-> (Relation a b -> m [(a, b)]) -> Relation a b -> m (Relation a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> m Bool) -> [(a, b)] -> m [(a, b)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
Monad.filterM (a -> m Bool
f (a -> m Bool) -> ((a, b) -> a) -> (a, b) -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) ([(a, b)] -> m [(a, b)])
-> (Relation a b -> [(a, b)]) -> Relation a b -> m [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList

filterRanM :: (Applicative m, Ord a, Ord b) => (b -> m Bool) -> Relation a b -> m (Relation a b)
filterRanM :: forall (m :: * -> *) a b.
(Applicative m, Ord a, Ord b) =>
(b -> m Bool) -> Relation a b -> m (Relation a b)
filterRanM b -> m Bool
f = ([(a, b)] -> Relation a b) -> m [(a, b)] -> m (Relation a b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, b)] -> Relation a b
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList (m [(a, b)] -> m (Relation a b))
-> (Relation a b -> m [(a, b)]) -> Relation a b -> m (Relation a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> m Bool) -> [(a, b)] -> m [(a, b)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
Monad.filterM (b -> m Bool
f (b -> m Bool) -> ((a, b) -> b) -> (a, b) -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
forall a b. (a, b) -> b
snd) ([(a, b)] -> m [(a, b)])
-> (Relation a b -> [(a, b)]) -> Relation a b -> m [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList

filter :: (Ord a, Ord b) => ((a, b) -> Bool) -> Relation a b -> Relation a b
filter :: forall a b.
(Ord a, Ord b) =>
((a, b) -> Bool) -> Relation a b -> Relation a b
filter (a, b) -> Bool
f = [(a, b)] -> Relation a b
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList ([(a, b)] -> Relation a b)
-> (Relation a b -> [(a, b)]) -> Relation a b -> Relation a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (a, b) -> Bool
f ([(a, b)] -> [(a, b)])
-> (Relation a b -> [(a, b)]) -> Relation a b -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList

filterM :: (Applicative m, Ord a, Ord b) => ((a, b) -> m Bool) -> Relation a b -> m (Relation a b)
filterM :: forall (m :: * -> *) a b.
(Applicative m, Ord a, Ord b) =>
((a, b) -> m Bool) -> Relation a b -> m (Relation a b)
filterM (a, b) -> m Bool
f = ([(a, b)] -> Relation a b) -> m [(a, b)] -> m (Relation a b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(a, b)] -> Relation a b
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList (m [(a, b)] -> m (Relation a b))
-> (Relation a b -> m [(a, b)]) -> Relation a b -> m (Relation a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> m Bool) -> [(a, b)] -> m [(a, b)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
Monad.filterM (a, b) -> m Bool
f ([(a, b)] -> m [(a, b)])
-> (Relation a b -> [(a, b)]) -> Relation a b -> m [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList

-- | Restricts the relation to domain elements having multiple range elements
filterManyDom :: (Ord a, Ord b) => Relation a b -> Relation a b
filterManyDom :: forall a b. (Ord a, Ord b) => Relation a b -> Relation a b
filterManyDom Relation a b
r = (a -> Bool) -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
(a -> Bool) -> Relation a b -> Relation a b
filterDom (a -> Relation a b -> Bool
forall a b. Ord a => a -> Relation a b -> Bool
`manyDom` Relation a b
r) Relation a b
r

-- |
-- True if the relation @r@ is the 'empty' relation.
--
-- /O(1)/.
null :: Relation a b -> Bool
null :: forall a b. Relation a b -> Bool
null Relation a b
r = Map a (Set b) -> Bool
forall k a. Map k a -> Bool
M.null (Map a (Set b) -> Bool) -> Map a (Set b) -> Bool
forall a b. (a -> b) -> a -> b
$ Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r

-- Before 2010/11/09 null::Ord b =>  Relation a b -> Bool

-- | True if the relation contains the association @x@ and @y@
member :: (Ord a, Ord b) => a -> b -> Relation a b -> Bool
member :: forall a b. (Ord a, Ord b) => a -> b -> Relation a b -> Bool
member a
x b
y Relation a b
r = case a -> Relation a b -> Maybe (Set b)
forall a b. Ord a => a -> Relation a b -> Maybe (Set b)
lookupDom' a
x Relation a b
r of
  Just Set b
s -> b -> Set b -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member b
y Set b
s
  Maybe (Set b)
Nothing -> Bool
False

-- | True if the relation /does not/ contain the association @x@ and @y@
notMember :: (Ord a, Ord b) => a -> b -> Relation a b -> Bool
notMember :: forall a b. (Ord a, Ord b) => a -> b -> Relation a b -> Bool
notMember a
x b
y Relation a b
r = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> b -> Relation a b -> Bool
forall a b. (Ord a, Ord b) => a -> b -> Relation a b -> Bool
member a
x b
y Relation a b
r

-- | True if a value appears more than one time in the relation.
manyDom :: (Ord a) => a -> Relation a b -> Bool
manyDom :: forall a b. Ord a => a -> Relation a b -> Bool
manyDom a
a = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> (Relation a b -> Int) -> Relation a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set b -> Int
forall a. Set a -> Int
S.size (Set b -> Int) -> (Relation a b -> Set b) -> Relation a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Relation a b -> Set b
forall a b. Ord a => a -> Relation a b -> Set b
lookupDom a
a

manyRan :: (Ord b) => b -> Relation a b -> Bool
manyRan :: forall b a. Ord b => b -> Relation a b -> Bool
manyRan b
b = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> (Relation a b -> Int) -> Relation a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Int
forall a. Set a -> Int
S.size (Set a -> Int) -> (Relation a b -> Set a) -> Relation a b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Relation a b -> Set a
forall b a. Ord b => b -> Relation a b -> Set a
lookupRan b
b

-- | Returns the domain in the relation, as a Set, in its entirety.
--
-- /O(a)/.
dom :: Relation a b -> Set a
dom :: forall a b. Relation a b -> Set a
dom Relation a b
r = Map a (Set b) -> Set a
forall k a. Map k a -> Set k
M.keysSet (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r)

-- | Returns the range of the relation, as a Set, in its entirety.
--
-- /O(b)/.
ran :: Relation a b -> Set b
ran :: forall a b. Relation a b -> Set b
ran Relation a b
r = Map b (Set a) -> Set b
forall k a. Map k a -> Set k
M.keysSet (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
r)

-- |
-- A compact set of sets the values of which can be @Just (Set x)@ or @Nothing@.
--
-- The cases of 'Nothing' are purged.
--
-- It is similar to 'concat'.
compactSet :: (Ord a) => Set (Maybe (Set a)) -> Set a
compactSet :: forall a. Ord a => Set (Maybe (Set a)) -> Set a
compactSet = (Maybe (Set a) -> Set a -> Set a)
-> Set a -> Set (Maybe (Set a)) -> Set a
forall a b. (a -> b -> b) -> b -> Set a -> b
S.fold (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set a -> Set a -> Set a)
-> (Maybe (Set a) -> Set a) -> Maybe (Set a) -> Set a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Maybe (Set a) -> Set a
forall a. a -> Maybe a -> a
fromMaybe Set a
forall a. Set a
S.empty) Set a
forall a. Set a
S.empty

-- $selectops
--
-- Primitive implementation for the /right selection/ and /left selection/ operators.
--
-- PICA provides both operators:
--        '|>'  and  '<|'
-- and    '|$>' and '<$|'
--
-- in this library, for working with Relations and OIS (Ordered, Inductive Sets?).
--
-- PICA exposes the operators defined here, so as not to interfere with the abstraction
-- of the Relation type and because having access to Relation hidden components is a more
-- efficient implementation of the operation of restriction.
--
-- @
--     (a <$| b) r
--
--       denotes: for every element     @b@ from the Set      @B@,
--                select an element @a@     from the Set @A@     ,
--                              if  @a@
--                   is related to      @b@
--                   in @r@
-- @
--
-- @
--     (a |$> b) r
--
--       denotes: for every element @a@      from the Set @A@    ,
--                select an element     @b@  from the Set     @B@,
--                              if  @a@
--                   is related to      @b@
--                   in @r@
-- @
--
-- With regard to domain restriction and range restriction operators
-- of the language, those are described differently and return the domain or the range.

-- |
-- @(Case b <| r a)@
(<$|) :: (Ord a, Ord b) => Set a -> Set b -> Relation a b -> Set a
(Set a
as <$| :: forall a b.
(Ord a, Ord b) =>
Set a -> Set b -> Relation a b -> Set a
<$| Set b
bs) Relation a b
r = Set a
as Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` Set b -> Set a
generarAS Set b
bs
  where
    generarAS :: Set b -> Set a
generarAS = Set (Maybe (Set a)) -> Set a
forall a. Ord a => Set (Maybe (Set a)) -> Set a
compactSet (Set (Maybe (Set a)) -> Set a)
-> (Set b -> Set (Maybe (Set a))) -> Set b -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Maybe (Set a)) -> Set b -> Set (Maybe (Set a))
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (b -> Relation a b -> Maybe (Set a)
forall b a. Ord b => b -> Relation a b -> Maybe (Set a)
`lookupRan'` Relation a b
r)

-- The subsets of the domain (a) associated with each @b@
-- such that @b@ in @B@ and (b) are in the range of the relation.
-- The expression 'S.map' returns a set of @Either (Set a)@.

-- |
-- @( Case a |> r b )@
(|$>) :: (Ord a, Ord b) => Set a -> Set b -> Relation a b -> Set b
(Set a
as |$> :: forall a b.
(Ord a, Ord b) =>
Set a -> Set b -> Relation a b -> Set b
|$> Set b
bs) Relation a b
r = Set b
bs Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` Set a -> Set b
generarBS Set a
as
  where
    generarBS :: Set a -> Set b
generarBS = Set (Maybe (Set b)) -> Set b
forall a. Ord a => Set (Maybe (Set a)) -> Set a
compactSet (Set (Maybe (Set b)) -> Set b)
-> (Set a -> Set (Maybe (Set b))) -> Set a -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe (Set b)) -> Set a -> Set (Maybe (Set b))
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (a -> Relation a b -> Maybe (Set b)
forall a b. Ord a => a -> Relation a b -> Maybe (Set b)
`lookupDom'` Relation a b
r)

-- | Domain restriction for a relation. Modeled on z.
(<|), restrictDom :: (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
restrictDom :: forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
restrictDom = Set a -> Relation a b -> Relation a b
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
(<|)
Set a
s <| :: forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
<| Relation a b
r = Set a -> Map a (Set b) -> Relation a b
forall {b} {k}.
(Ord b, Ord k) =>
Set k -> Map k (Set b) -> Relation k b
go Set a
s (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r)
  where
    go :: Set k -> Map k (Set b) -> Relation k b
go Set k
_ Map k (Set b)
Map.Tip = Relation k b
forall a. Monoid a => a
mempty
    go Set k
s Map k (Set b)
_ | Set k -> Bool
forall a. Set a -> Bool
Set.null Set k
s = Relation k b
forall a. Monoid a => a
mempty
    go Set k
s (Map.Bin Int
_ k
amid Set b
bs Map k (Set b)
l Map k (Set b)
r) = Relation k b
here Relation k b -> Relation k b -> Relation k b
forall a. Semigroup a => a -> a -> a
<> Set k -> Map k (Set b) -> Relation k b
go Set k
sl Map k (Set b)
l Relation k b -> Relation k b -> Relation k b
forall a. Semigroup a => a -> a -> a
<> Set k -> Map k (Set b) -> Relation k b
go Set k
sr Map k (Set b)
r
      where
        (Set k
sl, Bool
hasMid, Set k
sr) = k -> Set k -> (Set k, Bool, Set k)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
Set.splitMember k
amid Set k
s
        mids :: Set k
mids = k -> Set k
forall a. a -> Set a
Set.singleton k
amid
        here :: Relation k b
here =
          if Bool
hasMid
            then Map k (Set b) -> Map b (Set k) -> Relation k b
forall a b. Map a (Set b) -> Map b (Set a) -> Relation a b
Relation (k -> Set b -> Map k (Set b)
forall k a. k -> a -> Map k a
Map.singleton k
amid Set b
bs) ([(b, Set k)] -> Map b (Set k)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(b, Set k)] -> Map b (Set k)) -> [(b, Set k)] -> Map b (Set k)
forall a b. (a -> b) -> a -> b
$ (,Set k
mids) (b -> (b, Set k)) -> [b] -> [(b, Set k)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set b -> [b]
forall a. Set a -> [a]
Set.toList Set b
bs))
            else Relation k b
forall a. Monoid a => a
mempty

-- | Range restriction for a relation. Modeled on z.
(|>), restrictRan :: (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
restrictRan :: forall a b. (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
restrictRan = Relation a b -> Set b -> Relation a b
forall a b. (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
(|>)
Relation a b
r |> :: forall a b. (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
|> Set b
t = Relation b a -> Relation a b
forall a b. Relation a b -> Relation b a
swap (Set b
t Set b -> Relation b a -> Relation b a
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
<| Relation a b -> Relation b a
forall a b. Relation a b -> Relation b a
swap Relation a b
r)

-- | Restrict the range to not include these `b`s.
(||>) :: (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
r :: Relation a b
r@(Relation {Map a (Set b)
domain :: forall a b. Relation a b -> Map a (Set b)
domain :: Map a (Set b)
domain, Map b (Set a)
range :: forall a b. Relation a b -> Map b (Set a)
range :: Map b (Set a)
range}) ||> :: forall a b. (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
||> Set b
t =
  Map a (Set b) -> Map b (Set a) -> Relation a b
forall a b. Map a (Set b) -> Map b (Set a) -> Relation a b
Relation Map a (Set b)
domain' Map b (Set a)
range'
  where
    go :: Map k (Set b) -> k -> Map k (Set b)
go Map k (Set b)
m k
a = (Maybe (Set b) -> Maybe (Set b))
-> k -> Map k (Set b) -> Map k (Set b)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (Set b) -> Maybe (Set b)
g k
a Map k (Set b)
m
      where
        g :: Maybe (Set b) -> Maybe (Set b)
g Maybe (Set b)
Nothing = Maybe (Set b)
forall a. Maybe a
Nothing
        g (Just Set b
s) =
          if Set b -> Bool
forall a. Set a -> Bool
Set.null Set b
s'
            then Maybe (Set b)
forall a. Maybe a
Nothing
            else Set b -> Maybe (Set b)
forall a. a -> Maybe a
Just Set b
s'
          where
            s' :: Set b
s' = Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set b
s Set b
t
    domain' :: Map a (Set b)
domain' = (Map a (Set b) -> a -> Map a (Set b))
-> Map a (Set b) -> Set a -> Map a (Set b)
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map a (Set b) -> a -> Map a (Set b)
forall {k}. Ord k => Map k (Set b) -> k -> Map k (Set b)
go Map a (Set b)
domain ((b -> Set a) -> Set b -> Set a
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (b -> Relation a b -> Set a
forall b a. Ord b => b -> Relation a b -> Set a
`lookupRan` Relation a b
r) Set b
t)
    range' :: Map b (Set a)
range' = Map b (Set a)
range Map b (Set a) -> Set b -> Map b (Set a)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set b
t

-- | Named version of ('||>').
subtractRan :: (Ord a, Ord b) => Set b -> Relation a b -> Relation a b
subtractRan :: forall a b. (Ord a, Ord b) => Set b -> Relation a b -> Relation a b
subtractRan = (Relation a b -> Set b -> Relation a b)
-> Set b -> Relation a b -> Relation a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Relation a b -> Set b -> Relation a b
forall a b. (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
(||>)

-- | Restrict the domain to not include these `a`s.
(<||) :: (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
Set a
s <|| :: forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
<|| Relation a b
r = Relation b a -> Relation a b
forall a b. Relation a b -> Relation b a
swap (Relation a b -> Relation b a
forall a b. Relation a b -> Relation b a
swap Relation a b
r Relation b a -> Set a -> Relation b a
forall a b. (Ord a, Ord b) => Relation a b -> Set b -> Relation a b
||> Set a
s)

-- | Named version of ('<||').
subtractDom :: (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
subtractDom :: forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
subtractDom = Set a -> Relation a b -> Relation a b
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
(<||)

-- Note:
--
--    As you have seen this implementation is expensive in terms
--    of storage. Information is registered twice.
--    For the operators |> and <| we follow a pattern used in
--    the @fromList@ constructor and @toList@ flattener:
--    It is enough to know one half of the Relation (the domain or
--    the range) to create to other half.

insertManyRan ::
  (Foldable f, Ord a, Ord b) => a -> f b -> Relation a b -> Relation a b
insertManyRan :: forall (f :: * -> *) a b.
(Foldable f, Ord a, Ord b) =>
a -> f b -> Relation a b -> Relation a b
insertManyRan a
a f b
bs Relation a b
r = (Relation a b -> b -> Relation a b)
-> Relation a b -> f b -> Relation a b
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((b -> Relation a b -> Relation a b)
-> Relation a b -> b -> Relation a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> Relation a b -> Relation a b)
 -> Relation a b -> b -> Relation a b)
-> (b -> Relation a b -> Relation a b)
-> Relation a b
-> b
-> Relation a b
forall a b. (a -> b) -> a -> b
$ a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
insert a
a) Relation a b
r f b
bs

insertManyDom ::
  (Foldable f, Ord a, Ord b) => f a -> b -> Relation a b -> Relation a b
insertManyDom :: forall (f :: * -> *) a b.
(Foldable f, Ord a, Ord b) =>
f a -> b -> Relation a b -> Relation a b
insertManyDom f a
as b
b Relation a b
r = (Relation a b -> a -> Relation a b)
-> Relation a b -> f a -> Relation a b
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> Relation a b -> Relation a b)
-> Relation a b -> a -> Relation a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> Relation a b -> Relation a b)
 -> Relation a b -> a -> Relation a b)
-> (a -> Relation a b -> Relation a b)
-> Relation a b
-> a
-> Relation a b
forall a b. (a -> b) -> a -> b
$ (a -> b -> Relation a b -> Relation a b)
-> b -> a -> Relation a b -> Relation a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
insert b
b) Relation a b
r f a
as

lookupRan :: (Ord b) => b -> Relation a b -> Set a
lookupRan :: forall b a. Ord b => b -> Relation a b -> Set a
lookupRan b
b Relation a b
r = Set a -> Maybe (Set a) -> Set a
forall a. a -> Maybe a -> a
fromMaybe Set a
forall a. Set a
S.empty (Maybe (Set a) -> Set a) -> Maybe (Set a) -> Set a
forall a b. (a -> b) -> a -> b
$ b -> Relation a b -> Maybe (Set a)
forall b a. Ord b => b -> Relation a b -> Maybe (Set a)
lookupRan' b
b Relation a b
r

lookupDom :: (Ord a) => a -> Relation a b -> Set b
lookupDom :: forall a b. Ord a => a -> Relation a b -> Set b
lookupDom a
a Relation a b
r = Set b -> Maybe (Set b) -> Set b
forall a. a -> Maybe a -> a
fromMaybe Set b
forall a. Set a
S.empty (Maybe (Set b) -> Set b) -> Maybe (Set b) -> Set b
forall a b. (a -> b) -> a -> b
$ a -> Relation a b -> Maybe (Set b)
forall a b. Ord a => a -> Relation a b -> Maybe (Set b)
lookupDom' a
a Relation a b
r

-- Efficiently locate the `Set b` for which the corresponding `a` tests
-- as `EQ` according to the provided function `f`, assuming that such
-- elements are contiguous via the `Ord a`. That is, `f <$> toList (dom r)`
-- must look something like [LT,LT,EQ,EQ,EQ,GT], or more generally, 0 or
-- more LT followed by 0 or more EQ, followed by 0 or more GT.
--
-- For example, given a `Relation (Int,y) z`,
-- `searchDom (\(i,_) -> compare i 10)` will return all the `z` whose
-- associated `(Int,y)` is of the form `(10,y)` for any choice of `y`.
--
-- Takes logarithmic time to find the smallest `amin` such that `f a == EQ`,
-- and the largest `amax` such that `f amax == EQ`. The rest of the runtime is
-- just assembling the returned `Set b`, so when the returned `Set b` is small
-- or empty, this function takes time logarithmic in the number of unique keys
-- of the domain, `a`.
searchDom :: (Ord a, Ord b) => (a -> Ordering) -> Relation a b -> Set b
searchDom :: forall a b.
(Ord a, Ord b) =>
(a -> Ordering) -> Relation a b -> Set b
searchDom = (a -> Set b -> Set b) -> (a -> Ordering) -> Relation a b -> Set b
forall a c b.
(Ord a, Monoid c) =>
(a -> Set b -> c) -> (a -> Ordering) -> Relation a b -> c
searchDomG (\a
_ Set b
set -> Set b
set)

searchDomG :: (Ord a, Monoid c) => (a -> Set b -> c) -> (a -> Ordering) -> Relation a b -> c
searchDomG :: forall a c b.
(Ord a, Monoid c) =>
(a -> Set b -> c) -> (a -> Ordering) -> Relation a b -> c
searchDomG a -> Set b -> c
g a -> Ordering
f Relation a b
r = Map a (Set b) -> c
go (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r)
  where
    go :: Map a (Set b) -> c
go Map a (Set b)
Map.Tip = c
forall a. Monoid a => a
mempty
    go (Map.Bin Int
_ a
amid Set b
bs Map a (Set b)
l Map a (Set b)
r) = case a -> Ordering
f a
amid of
      Ordering
EQ -> Map a (Set b) -> c
goL Map a (Set b)
l c -> c -> c
forall a. Semigroup a => a -> a -> a
<> a -> Set b -> c
g a
amid Set b
bs c -> c -> c
forall a. Semigroup a => a -> a -> a
<> Map a (Set b) -> c
goR Map a (Set b)
r
      Ordering
LT -> Map a (Set b) -> c
go Map a (Set b)
r
      Ordering
GT -> Map a (Set b) -> c
go Map a (Set b)
l
    goL :: Map a (Set b) -> c
goL Map a (Set b)
Map.Tip = c
forall a. Monoid a => a
mempty
    goL (Map.Bin Int
_ a
amid Set b
bs Map a (Set b)
l Map a (Set b)
r) = case a -> Ordering
f a
amid of
      Ordering
EQ -> Map a (Set b) -> c
goL Map a (Set b)
l c -> c -> c
forall a. Semigroup a => a -> a -> a
<> a -> Set b -> c
g a
amid Set b
bs c -> c -> c
forall a. Semigroup a => a -> a -> a
<> (a -> Set b -> c -> c) -> c -> Map a (Set b) -> c
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\a
k Set b
v c
acc -> a -> Set b -> c
g a
k Set b
v c -> c -> c
forall a. Semigroup a => a -> a -> a
<> c
acc) c
forall a. Monoid a => a
mempty Map a (Set b)
r
      Ordering
LT -> Map a (Set b) -> c
goL Map a (Set b)
r
      Ordering
GT -> String -> c
forall a. HasCallStack => String -> a
error String
"predicate not monotone with respect to ordering"
    goR :: Map a (Set b) -> c
goR Map a (Set b)
Map.Tip = c
forall a. Monoid a => a
mempty
    goR (Map.Bin Int
_ a
amid Set b
bs Map a (Set b)
l Map a (Set b)
r) = case a -> Ordering
f a
amid of
      Ordering
EQ -> (a -> Set b -> c -> c) -> c -> Map a (Set b) -> c
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\a
k Set b
v c
acc -> a -> Set b -> c
g a
k Set b
v c -> c -> c
forall a. Semigroup a => a -> a -> a
<> c
acc) c
forall a. Monoid a => a
mempty Map a (Set b)
l c -> c -> c
forall a. Semigroup a => a -> a -> a
<> a -> Set b -> c
g a
amid Set b
bs c -> c -> c
forall a. Semigroup a => a -> a -> a
<> Map a (Set b) -> c
goR Map a (Set b)
r
      Ordering
GT -> Map a (Set b) -> c
goR Map a (Set b)
l
      Ordering
LT -> String -> c
forall a. HasCallStack => String -> a
error String
"predicate not monotone with respect to ordering"

-- Like `searchDom`, but searches the `b` of this `Relation`.
searchRan :: (Ord a, Ord b) => (b -> Ordering) -> Relation a b -> Set a
searchRan :: forall a b.
(Ord a, Ord b) =>
(b -> Ordering) -> Relation a b -> Set a
searchRan b -> Ordering
f Relation a b
r = (b -> Ordering) -> Relation b a -> Set a
forall a b.
(Ord a, Ord b) =>
(a -> Ordering) -> Relation a b -> Set b
searchDom b -> Ordering
f (Relation a b -> Relation b a
forall a b. Relation a b -> Relation b a
swap Relation a b
r)

-- | @replaceDom x y r@ replaces all @(x, _)@ with @(y, _)@ in @r@.
replaceDom :: (Ord a, Ord b) => a -> a -> Relation a b -> Relation a b
replaceDom :: forall a b.
(Ord a, Ord b) =>
a -> a -> Relation a b -> Relation a b
replaceDom a
a a
a' Relation a b
r =
  if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
    then Relation a b
r
    else case a -> Map a (Set b) -> (Maybe (Set b), Map a (Set b))
forall k v. Ord k => k -> Map k v -> (Maybe v, Map k v)
Map.deleteLookup a
a (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r) of
      (Maybe (Set b)
Nothing, Map a (Set b)
_) -> Relation a b
r
      (Just Set b
bs, Map a (Set b)
domain') ->
        Relation
          { domain :: Map a (Set b)
domain = (Set b -> Set b -> Set b)
-> a -> Set b -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.union a
a' Set b
bs Map a (Set b)
domain',
            range :: Map b (Set a)
range = (Map b (Set a) -> b -> Map b (Set a))
-> Map b (Set a) -> Set b -> Map b (Set a)
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map b (Set a)
acc b
b -> (Set a -> Set a) -> b -> Map b (Set a) -> Map b (Set a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
a' (Set a -> Set a) -> (Set a -> Set a) -> Set a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
a) b
b Map b (Set a)
acc) (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
r) Set b
bs
          }

-- | @replaceRan x y r@ replaces all @(_, x)@ with @(_, y)@ in @r@.
replaceRan :: (Ord a, Ord b) => b -> b -> Relation a b -> Relation a b
replaceRan :: forall a b.
(Ord a, Ord b) =>
b -> b -> Relation a b -> Relation a b
replaceRan b
b b
b' Relation a b
r =
  if b
b b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b'
    then Relation a b
r
    else case b -> Map b (Set a) -> (Maybe (Set a), Map b (Set a))
forall k v. Ord k => k -> Map k v -> (Maybe v, Map k v)
Map.deleteLookup b
b (Relation a b -> Map b (Set a)
forall a b. Relation a b -> Map b (Set a)
range Relation a b
r) of
      (Maybe (Set a)
Nothing, Map b (Set a)
_) -> Relation a b
r
      (Just Set a
as, Map b (Set a)
range') ->
        Relation
          { domain :: Map a (Set b)
domain = (Map a (Set b) -> a -> Map a (Set b))
-> Map a (Set b) -> Set a -> Map a (Set b)
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map a (Set b)
acc a
a -> (Set b -> Set b) -> a -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.insert b
b' (Set b -> Set b) -> (Set b -> Set b) -> Set b -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Set b -> Set b
forall a. Ord a => a -> Set a -> Set a
Set.delete b
b) a
a Map a (Set b)
acc) (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain Relation a b
r) Set a
as,
            range :: Map b (Set a)
range = (Set a -> Set a -> Set a)
-> b -> Set a -> Map b (Set a) -> Map b (Set a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union b
b' Set a
as Map b (Set a)
range'
          }

updateDom :: (Ord a, Ord b) => (a -> a) -> b -> Relation a b -> Relation a b
updateDom :: forall a b.
(Ord a, Ord b) =>
(a -> a) -> b -> Relation a b -> Relation a b
updateDom a -> a
f b
b Relation a b
r =
  (Relation a b -> a -> Relation a b)
-> Relation a b -> Set a -> Relation a b
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Relation a b
r a
a -> a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
insert (a -> a
f a
a) b
b (Relation a b -> Relation a b) -> Relation a b -> Relation a b
forall a b. (a -> b) -> a -> b
$ a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
delete a
a b
b Relation a b
r) Relation a b
r (b -> Relation a b -> Set a
forall b a. Ord b => b -> Relation a b -> Set a
lookupRan b
b Relation a b
r)

updateRan :: (Ord a, Ord b) => (b -> b) -> a -> Relation a b -> Relation a b
updateRan :: forall a b.
(Ord a, Ord b) =>
(b -> b) -> a -> Relation a b -> Relation a b
updateRan b -> b
f a
a Relation a b
r =
  (Relation a b -> b -> Relation a b)
-> Relation a b -> Set b -> Relation a b
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Relation a b
r b
b -> a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
insert a
a (b -> b
f b
b) (Relation a b -> Relation a b) -> Relation a b -> Relation a b
forall a b. (a -> b) -> a -> b
$ a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
delete a
a b
b Relation a b
r) Relation a b
r (a -> Relation a b -> Set b
forall a b. Ord a => a -> Relation a b -> Set b
lookupDom a
a Relation a b
r)

deleteRan :: (Ord a, Ord b) => b -> Relation a b -> Relation a b
deleteRan :: forall a b. (Ord a, Ord b) => b -> Relation a b -> Relation a b
deleteRan b
b Relation a b
r = (Relation a b -> a -> Relation a b)
-> Relation a b -> Set a -> Relation a b
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Relation a b
r a
a -> a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
delete a
a b
b Relation a b
r) Relation a b
r (Set a -> Relation a b) -> Set a -> Relation a b
forall a b. (a -> b) -> a -> b
$ b -> Relation a b -> Set a
forall b a. Ord b => b -> Relation a b -> Set a
lookupRan b
b Relation a b
r

deleteDom :: (Ord a, Ord b) => a -> Relation a b -> Relation a b
deleteDom :: forall a b. (Ord a, Ord b) => a -> Relation a b -> Relation a b
deleteDom a
a Relation a b
r = (Relation a b -> b -> Relation a b)
-> Relation a b -> Set b -> Relation a b
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((b -> Relation a b -> Relation a b)
-> Relation a b -> b -> Relation a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> Relation a b -> Relation a b)
 -> Relation a b -> b -> Relation a b)
-> (b -> Relation a b -> Relation a b)
-> Relation a b
-> b
-> Relation a b
forall a b. (a -> b) -> a -> b
$ a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
delete a
a) Relation a b
r (Set b -> Relation a b) -> Set b -> Relation a b
forall a b. (a -> b) -> a -> b
$ a -> Relation a b -> Set b
forall a b. Ord a => a -> Relation a b -> Set b
lookupDom a
a Relation a b
r

deleteRanWhere :: (Ord a, Ord b) => (b -> Bool) -> a -> Relation a b -> Relation a b
deleteRanWhere :: forall a b.
(Ord a, Ord b) =>
(b -> Bool) -> a -> Relation a b -> Relation a b
deleteRanWhere b -> Bool
f a
a Relation a b
r =
  (Relation a b -> b -> Relation a b)
-> Relation a b -> Set b -> Relation a b
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Relation a b
r b
b -> if b -> Bool
f b
b then a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
delete a
a b
b Relation a b
r else Relation a b
r) Relation a b
r (a -> Relation a b -> Set b
forall a b. Ord a => a -> Relation a b -> Set b
lookupDom a
a Relation a b
r)

deleteDomWhere :: (Ord a, Ord b) => (a -> Bool) -> b -> Relation a b -> Relation a b
deleteDomWhere :: forall a b.
(Ord a, Ord b) =>
(a -> Bool) -> b -> Relation a b -> Relation a b
deleteDomWhere a -> Bool
f b
b Relation a b
r =
  (Relation a b -> a -> Relation a b)
-> Relation a b -> Set a -> Relation a b
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Relation a b
r a
a -> if a -> Bool
f a
a then a -> b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
delete a
a b
b Relation a b
r else Relation a b
r) Relation a b
r (b -> Relation a b -> Set a
forall b a. Ord b => b -> Relation a b -> Set a
lookupRan b
b Relation a b
r)

map ::
  (Ord a, Ord b, Ord c, Ord d) =>
  ((a, b) -> (c, d)) ->
  Relation a b ->
  Relation c d
map :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
((a, b) -> (c, d)) -> Relation a b -> Relation c d
map (a, b) -> (c, d)
f = [(c, d)] -> Relation c d
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList ([(c, d)] -> Relation c d)
-> (Relation a b -> [(c, d)]) -> Relation a b -> Relation c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (c, d)) -> [(a, b)] -> [(c, d)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> (c, d)
f ([(a, b)] -> [(c, d)])
-> (Relation a b -> [(a, b)]) -> Relation a b -> [(c, d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList

-- aka first
mapDom :: (Ord a, Ord a', Ord b) => (a -> a') -> Relation a b -> Relation a' b
mapDom :: forall a a' b.
(Ord a, Ord a', Ord b) =>
(a -> a') -> Relation a b -> Relation a' b
mapDom a -> a'
f Relation {Map a (Set b)
domain :: forall a b. Relation a b -> Map a (Set b)
domain :: Map a (Set b)
domain, Map b (Set a)
range :: forall a b. Relation a b -> Map b (Set a)
range :: Map b (Set a)
range} =
  Relation
    { domain :: Map a' (Set b)
domain = (Set b -> Set b -> Set b)
-> (a -> a') -> Map a (Set b) -> Map a' (Set b)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
S.union a -> a'
f Map a (Set b)
domain,
      range :: Map b (Set a')
range = (Set a -> Set a') -> Map b (Set a) -> Map b (Set a')
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> a') -> Set a -> Set a'
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map a -> a'
f) Map b (Set a)
range
    }

-- | Like 'mapDom', but takes a function that must be monotonic; i.e. @compare x y == compare (f x) (f y)@.
mapDomMonotonic :: (Ord a, Ord a', Ord b) => (a -> a') -> Relation a b -> Relation a' b
mapDomMonotonic :: forall a a' b.
(Ord a, Ord a', Ord b) =>
(a -> a') -> Relation a b -> Relation a' b
mapDomMonotonic a -> a'
f Relation {Map a (Set b)
domain :: forall a b. Relation a b -> Map a (Set b)
domain :: Map a (Set b)
domain, Map b (Set a)
range :: forall a b. Relation a b -> Map b (Set a)
range :: Map b (Set a)
range} =
  Relation
    { domain :: Map a' (Set b)
domain = (a -> a') -> Map a (Set b) -> Map a' (Set b)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic a -> a'
f Map a (Set b)
domain,
      range :: Map b (Set a')
range = (Set a -> Set a') -> Map b (Set a) -> Map b (Set a')
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> a') -> Set a -> Set a'
forall a b. (a -> b) -> Set a -> Set b
S.mapMonotonic a -> a'
f) Map b (Set a)
range
    }

-- aka second
mapRan :: (Ord a, Ord b, Ord b') => (b -> b') -> Relation a b -> Relation a b'
mapRan :: forall a b b'.
(Ord a, Ord b, Ord b') =>
(b -> b') -> Relation a b -> Relation a b'
mapRan b -> b'
f Relation {Map a (Set b)
domain :: forall a b. Relation a b -> Map a (Set b)
domain :: Map a (Set b)
domain, Map b (Set a)
range :: forall a b. Relation a b -> Map b (Set a)
range :: Map b (Set a)
range} =
  Relation
    { domain :: Map a (Set b')
domain = (Set b -> Set b') -> Map a (Set b) -> Map a (Set b')
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> b') -> Set b -> Set b'
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map b -> b'
f) Map a (Set b)
domain,
      range :: Map b' (Set a)
range = (Set a -> Set a -> Set a)
-> (b -> b') -> Map b (Set a) -> Map b' (Set a)
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union b -> b'
f Map b (Set a)
range
    }

-- | Like 'mapRan', but takes a function that must be monotonic; i.e. @compare x y == compare (f x) (f y)@.
mapRanMonotonic :: (Ord a, Ord b, Ord b') => (b -> b') -> Relation a b -> Relation a b'
mapRanMonotonic :: forall a b b'.
(Ord a, Ord b, Ord b') =>
(b -> b') -> Relation a b -> Relation a b'
mapRanMonotonic b -> b'
f Relation {Map a (Set b)
domain :: forall a b. Relation a b -> Map a (Set b)
domain :: Map a (Set b)
domain, Map b (Set a)
range :: forall a b. Relation a b -> Map b (Set a)
range :: Map b (Set a)
range} =
  Relation
    { domain :: Map a (Set b')
domain = (Set b -> Set b') -> Map a (Set b) -> Map a (Set b')
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((b -> b') -> Set b -> Set b'
forall a b. (a -> b) -> Set a -> Set b
S.mapMonotonic b -> b'
f) Map a (Set b)
domain,
      range :: Map b' (Set a)
range = (b -> b') -> Map b (Set a) -> Map b' (Set a)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic b -> b'
f Map b (Set a)
range
    }

fromMap :: (Ord a, Ord b) => Map a b -> Relation a b
fromMap :: forall a b. (Ord a, Ord b) => Map a b -> Relation a b
fromMap = [(a, b)] -> Relation a b
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList ([(a, b)] -> Relation a b)
-> (Map a b -> [(a, b)]) -> Map a b -> Relation a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList

fromMultimap :: (Ord a, Ord b) => Map a (Set b) -> Relation a b
fromMultimap :: forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
fromMultimap Map a (Set b)
m =
  (Relation a b -> (a, Set b) -> Relation a b)
-> Relation a b -> [(a, Set b)] -> Relation a b
forall a b. (a -> b -> a) -> a -> [b] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Relation a b
r (a
a, Set b
bs) -> a -> Set b -> Relation a b -> Relation a b
forall (f :: * -> *) a b.
(Foldable f, Ord a, Ord b) =>
a -> f b -> Relation a b -> Relation a b
insertManyRan a
a Set b
bs Relation a b
r) Relation a b
forall a b. Relation a b
empty ([(a, Set b)] -> Relation a b) -> [(a, Set b)] -> Relation a b
forall a b. (a -> b) -> a -> b
$ Map a (Set b) -> [(a, Set b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map a (Set b)
m

toMultimap :: Relation a b -> Map a (Set b)
toMultimap :: forall a b. Relation a b -> Map a (Set b)
toMultimap = Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
domain

-- Returns Nothing if Relation isn't one-to-one.
toMap :: (Ord a) => Relation a b -> Maybe (Map a b)
toMap :: forall a b. Ord a => Relation a b -> Maybe (Map a b)
toMap Relation a b
r =
  let mm :: Map a (Set b)
mm = Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
toMultimap Relation a b
r
   in if (Set b -> Bool) -> Map a (Set b) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Set b
s -> Set b -> Int
forall a. Set a -> Int
S.size Set b
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) Map a (Set b)
mm
        then Map a b -> Maybe (Map a b)
forall a. a -> Maybe a
Just (Set b -> b
forall a. Set a -> a
S.findMin (Set b -> b) -> Map a (Set b) -> Map a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map a (Set b)
mm)
        else Maybe (Map a b)
forall a. Maybe a
Nothing

fromSet :: (Ord a, Ord b) => Set (a, b) -> Relation a b
fromSet :: forall a b. (Ord a, Ord b) => Set (a, b) -> Relation a b
fromSet = [(a, b)] -> Relation a b
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList ([(a, b)] -> Relation a b)
-> (Set (a, b) -> [(a, b)]) -> Set (a, b) -> Relation a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (a, b) -> [(a, b)]
forall a. Set a -> [a]
S.toList

fromManyRan ::
  (Foldable f, Ord a, Ord b) => a -> f b -> Relation a b
fromManyRan :: forall (f :: * -> *) a b.
(Foldable f, Ord a, Ord b) =>
a -> f b -> Relation a b
fromManyRan a
a f b
bs = a -> f b -> Relation a b -> Relation a b
forall (f :: * -> *) a b.
(Foldable f, Ord a, Ord b) =>
a -> f b -> Relation a b -> Relation a b
insertManyRan a
a f b
bs Relation a b
forall a. Monoid a => a
mempty

fromManyDom ::
  (Foldable f, Ord a, Ord b) => f a -> b -> Relation a b
fromManyDom :: forall (f :: * -> *) a b.
(Foldable f, Ord a, Ord b) =>
f a -> b -> Relation a b
fromManyDom f a
as b
b = f a -> b -> Relation a b -> Relation a b
forall (f :: * -> *) a b.
(Foldable f, Ord a, Ord b) =>
f a -> b -> Relation a b -> Relation a b
insertManyDom f a
as b
b Relation a b
forall a. Monoid a => a
mempty

swap :: Relation a b -> Relation b a
swap :: forall a b. Relation a b -> Relation b a
swap (Relation Map a (Set b)
a Map b (Set a)
b) = Map b (Set a) -> Map a (Set b) -> Relation b a
forall a b. Map a (Set b) -> Map b (Set a) -> Relation a b
Relation Map b (Set a)
b Map a (Set b)
a

bimap ::
  (Ord a, Ord b, Ord c, Ord d) =>
  (a -> c) ->
  (b -> d) ->
  Relation a b ->
  Relation c d
bimap :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
(a -> c) -> (b -> d) -> Relation a b -> Relation c d
bimap a -> c
f b -> d
g = [(c, d)] -> Relation c d
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList ([(c, d)] -> Relation c d)
-> (Relation a b -> [(c, d)]) -> Relation a b -> Relation c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (c, d)) -> [(a, b)] -> [(c, d)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
a, b
b) -> (a -> c
f a
a, b -> d
g b
b)) ([(a, b)] -> [(c, d)])
-> (Relation a b -> [(a, b)]) -> Relation a b -> [(c, d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList

bitraverse ::
  (Applicative f, Ord a, Ord b, Ord c, Ord d) =>
  (a -> f c) ->
  (b -> f d) ->
  Relation a b ->
  f (Relation c d)
bitraverse :: forall (f :: * -> *) a b c d.
(Applicative f, Ord a, Ord b, Ord c, Ord d) =>
(a -> f c) -> (b -> f d) -> Relation a b -> f (Relation c d)
bitraverse a -> f c
f b -> f d
g = ([(c, d)] -> Relation c d) -> f [(c, d)] -> f (Relation c d)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(c, d)] -> Relation c d
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList (f [(c, d)] -> f (Relation c d))
-> (Relation a b -> f [(c, d)]) -> Relation a b -> f (Relation c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> f (c, d)) -> [(a, b)] -> f [(c, d)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(a
a, b
b) -> (,) (c -> d -> (c, d)) -> f c -> f (d -> (c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a f (d -> (c, d)) -> f d -> f (c, d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
b) ([(a, b)] -> f [(c, d)])
-> (Relation a b -> [(a, b)]) -> Relation a b -> f [(c, d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList

instance (Ord a, Ord b) => Monoid (Relation a b) where
  mempty :: Relation a b
mempty = Relation a b
forall a b. Relation a b
empty

instance (Ord a, Ord b) => Semigroup (Relation a b) where
  <> :: Relation a b -> Relation a b -> Relation a b
(<>) = Relation a b -> Relation a b -> Relation a b
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
union

toUnzippedMultimap ::
  (Ord a) => (Ord b) => (Ord c) => Relation a (b, c) -> Map a (Set b, Set c)
toUnzippedMultimap :: forall a b c.
(Ord a, Ord b, Ord c) =>
Relation a (b, c) -> Map a (Set b, Set c)
toUnzippedMultimap Relation a (b, c)
r = (\Set (b, c)
s -> (((b, c) -> b) -> Set (b, c) -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (b, c) -> b
forall a b. (a, b) -> a
fst Set (b, c)
s, ((b, c) -> c) -> Set (b, c) -> Set c
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (b, c) -> c
forall a b. (a, b) -> b
snd Set (b, c)
s)) (Set (b, c) -> (Set b, Set c))
-> Map a (Set (b, c)) -> Map a (Set b, Set c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Relation a (b, c) -> Map a (Set (b, c))
forall a b. Relation a b -> Map a (Set b)
toMultimap Relation a (b, c)
r

collectRan ::
  (Ord a) =>
  (Ord c) =>
  (b -> Maybe c) ->
  Relation a b ->
  Relation a c
collectRan :: forall a c b.
(Ord a, Ord c) =>
(b -> Maybe c) -> Relation a b -> Relation a c
collectRan b -> Maybe c
f Relation a b
r = [(a, c)] -> Relation a c
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
fromList [(a
a, c
c) | (a
a, b -> Maybe c
f -> Just c
c) <- Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
toList Relation a b
r]