module Unison.Util.Relation
  ( Relation,

    -- * Initialization
    empty,
    singleton,
    singletonSet,
    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
    Unison.Util.Relation.foldl,
    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 Data.Set.NonEmpty (NESet)
import Data.Set.NonEmpty qualified as NESet
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)
    }

singletonSet :: a -> NESet b -> Relation a b
singletonSet :: forall a b. a -> NESet b -> Relation a b
singletonSet a
x NESet b
ys1 =
  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
unsafeFromMultimaps (a -> Set b -> Map a (Set b)
forall k a. k -> a -> Map k a
Map.singleton a
x Set b
ys) ((b -> Set a) -> Set b -> Map b (Set a)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (\b
_ -> Set a
xs) Set b
ys)
  where
    xs :: Set a
xs = a -> Set a
forall a. a -> Set a
Set.singleton a
x
    ys :: Set b
ys = NESet b -> Set b
forall a. NESet a -> Set a
NESet.toSet NESet b
ys1

-- | 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
    ]

foldl :: (c -> a -> b -> c) -> c -> Relation a b -> c
foldl :: forall c a b. (c -> a -> b -> c) -> c -> Relation a b -> c
foldl c -> a -> b -> c
f c
z Relation {Map a (Set b)
domain :: forall a b. Relation a b -> Map a (Set b)
domain :: Map a (Set b)
domain} =
  (c -> a -> Set b -> c) -> c -> Map a (Set b) -> c
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\c
acc a
x -> (c -> b -> c) -> c -> Set b -> c
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl (c -> a -> b -> c
`f` a
x) c
acc) c
z Map a (Set b)
domain

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

-- |
-- 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 a b. (a -> b -> a) -> a -> Set b -> a
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 =
  (a -> Set b -> c) -> (a -> Ordering) -> Map a (Set b) -> c
forall m k v.
Monoid m =>
(k -> v -> m) -> (k -> Ordering) -> Map k v -> m
Map.search a -> Set b -> c
g a -> Ordering
f (Map a (Set b) -> c)
-> (Relation a b -> Map a (Set b)) -> Relation a b -> c
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

-- 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 =
  (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 b a -> Set a)
-> (Relation a b -> Relation b a) -> Relation a b -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> Relation b a
forall a b. Relation a b -> Relation b a
swap

-- | @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 a b. (a -> b -> a) -> a -> Set b -> a
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 a b. (a -> b -> a) -> a -> Set b -> a
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 a b. (a -> b -> a) -> a -> Set b -> a
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 a b. (a -> b -> a) -> a -> Set b -> a
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 a b. (a -> b -> a) -> a -> Set b -> a
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 a b. (a -> b -> a) -> a -> Set b -> a
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 a b. (a -> b -> a) -> a -> Set b -> a
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 a b. (a -> b -> a) -> a -> Set b -> a
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]