{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
{- |
Module      :  ./Common/Lib/Rel.hs
Description :  Relations, based on maps
Copyright   :  (c) Uni Bremen 2003-2005
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

supply a simple data type for (precedence or subsort) relations. A
relation is conceptually a set of (ordered) pairs,
but the hidden implementation is based on a map of sets.
An alternative view is that of a directed Graph possibly
with isolated nodes.

'Rel' is a directed graph with elements (Ord a) as (uniquely labelled) nodes
and (unlabelled) edges (with a multiplicity of at most one).

Usage: start with an 'empty' relation, 'insert' edges, and test for
an edge 'member' (before or after calling 'transClosure').

It is possible to insert self edges or bigger cycles.  But rather than
inserting self edges and element can be mapped to the empty set.

Checking for a 'path' corresponds to checking for a member in the
transitive (possibly non-reflexive) closure. A further 'insert', however,
may destroy the closedness property of a relation.

-}

module Common.Lib.Rel
    ( Rel, empty, nullKeys, rmNullSets
    , insertPair, insertDiffPair, insertKeyOrPair
    , member, toMap, map
    , noPairs, insertKey, deleteKey, memberKey, keysSet
    , fromKeysSet
    , reflexive
    , getCycles
    , union, intersection, isSubrelOf, difference, path
    , delete, succs, predecessors, irreflex, sccOfClosure
    , transClosure, fromList, toList, toPrecMap
    , intransKernel, mostRight, restrict, delSet
    , toSet, fromSet, topSort, depSort, nodes, collaps
    , transpose, transReduce
    , fromMap, locallyFiltered
    , flatSet, partSet, partList, leqClasses
    ) where

import Prelude hiding (map, null)
import Data.Data
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.List as List

import GHC.Generics (Generic)

import qualified Common.Lib.MapSet as MapSet

-- | no invariant is ensured for relations!
newtype Rel a = Rel { Rel a -> Map a (Set a)
toMap :: Map.Map a (Set.Set a) }
  deriving (Rel a -> Rel a -> Bool
(Rel a -> Rel a -> Bool) -> (Rel a -> Rel a -> Bool) -> Eq (Rel a)
forall a. Eq a => Rel a -> Rel a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rel a -> Rel a -> Bool
$c/= :: forall a. Eq a => Rel a -> Rel a -> Bool
== :: Rel a -> Rel a -> Bool
$c== :: forall a. Eq a => Rel a -> Rel a -> Bool
Eq, Eq (Rel a)
Eq (Rel a) =>
(Rel a -> Rel a -> Ordering)
-> (Rel a -> Rel a -> Bool)
-> (Rel a -> Rel a -> Bool)
-> (Rel a -> Rel a -> Bool)
-> (Rel a -> Rel a -> Bool)
-> (Rel a -> Rel a -> Rel a)
-> (Rel a -> Rel a -> Rel a)
-> Ord (Rel a)
Rel a -> Rel a -> Bool
Rel a -> Rel a -> Ordering
Rel a -> Rel a -> Rel a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Rel a)
forall a. Ord a => Rel a -> Rel a -> Bool
forall a. Ord a => Rel a -> Rel a -> Ordering
forall a. Ord a => Rel a -> Rel a -> Rel a
min :: Rel a -> Rel a -> Rel a
$cmin :: forall a. Ord a => Rel a -> Rel a -> Rel a
max :: Rel a -> Rel a -> Rel a
$cmax :: forall a. Ord a => Rel a -> Rel a -> Rel a
>= :: Rel a -> Rel a -> Bool
$c>= :: forall a. Ord a => Rel a -> Rel a -> Bool
> :: Rel a -> Rel a -> Bool
$c> :: forall a. Ord a => Rel a -> Rel a -> Bool
<= :: Rel a -> Rel a -> Bool
$c<= :: forall a. Ord a => Rel a -> Rel a -> Bool
< :: Rel a -> Rel a -> Bool
$c< :: forall a. Ord a => Rel a -> Rel a -> Bool
compare :: Rel a -> Rel a -> Ordering
$ccompare :: forall a. Ord a => Rel a -> Rel a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Rel a)
Ord, Typeable, Typeable (Rel a)
Constr
DataType
Typeable (Rel a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Rel a -> c (Rel a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Rel a))
-> (Rel a -> Constr)
-> (Rel a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Rel a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Rel a)))
-> ((forall b. Data b => b -> b) -> Rel a -> Rel a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Rel a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Rel a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Rel a -> m (Rel a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rel a -> m (Rel a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rel a -> m (Rel a))
-> Data (Rel a)
Rel a -> Constr
Rel a -> DataType
(forall d. Data d => c (t d)) -> Maybe (c (Rel a))
(forall b. Data b => b -> b) -> Rel a -> Rel a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rel a -> c (Rel a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rel a)
forall a. (Data a, Ord a) => Typeable (Rel a)
forall a. (Data a, Ord a) => Rel a -> Constr
forall a. (Data a, Ord a) => Rel a -> DataType
forall a.
(Data a, Ord a) =>
(forall b. Data b => b -> b) -> Rel a -> Rel a
forall a u.
(Data a, Ord a) =>
Int -> (forall d. Data d => d -> u) -> Rel a -> u
forall a u.
(Data a, Ord a) =>
(forall d. Data d => d -> u) -> Rel a -> [u]
forall a r r'.
(Data a, Ord a) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r
forall a r r'.
(Data a, Ord a) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r
forall a (m :: * -> *).
(Data a, Ord a, Monad m) =>
(forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
forall a (m :: * -> *).
(Data a, Ord a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
forall a (c :: * -> *).
(Data a, Ord a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rel a)
forall a (c :: * -> *).
(Data a, Ord a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rel a -> c (Rel a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Ord a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Rel a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Ord a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Rel a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Rel a -> u
forall u. (forall d. Data d => d -> u) -> Rel a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rel a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rel a -> c (Rel a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Rel a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Rel a))
$cRel :: Constr
$tRel :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, Ord a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
gmapMp :: (forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, Ord a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
gmapM :: (forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Ord a, Monad m) =>
(forall d. Data d => d -> m d) -> Rel a -> m (Rel a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Rel a -> u
$cgmapQi :: forall a u.
(Data a, Ord a) =>
Int -> (forall d. Data d => d -> u) -> Rel a -> u
gmapQ :: (forall d. Data d => d -> u) -> Rel a -> [u]
$cgmapQ :: forall a u.
(Data a, Ord a) =>
(forall d. Data d => d -> u) -> Rel a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r
$cgmapQr :: forall a r r'.
(Data a, Ord a) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r
$cgmapQl :: forall a r r'.
(Data a, Ord a) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Rel a -> r
gmapT :: (forall b. Data b => b -> b) -> Rel a -> Rel a
$cgmapT :: forall a.
(Data a, Ord a) =>
(forall b. Data b => b -> b) -> Rel a -> Rel a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Rel a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Ord a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Rel a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Rel a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Ord a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Rel a))
dataTypeOf :: Rel a -> DataType
$cdataTypeOf :: forall a. (Data a, Ord a) => Rel a -> DataType
toConstr :: Rel a -> Constr
$ctoConstr :: forall a. (Data a, Ord a) => Rel a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rel a)
$cgunfold :: forall a (c :: * -> *).
(Data a, Ord a) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rel a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rel a -> c (Rel a)
$cgfoldl :: forall a (c :: * -> *).
(Data a, Ord a) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rel a -> c (Rel a)
$cp1Data :: forall a. (Data a, Ord a) => Typeable (Rel a)
Data, (forall x. Rel a -> Rep (Rel a) x)
-> (forall x. Rep (Rel a) x -> Rel a) -> Generic (Rel a)
forall x. Rep (Rel a) x -> Rel a
forall x. Rel a -> Rep (Rel a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Rel a) x -> Rel a
forall a x. Rel a -> Rep (Rel a) x
$cto :: forall a x. Rep (Rel a) x -> Rel a
$cfrom :: forall a x. Rel a -> Rep (Rel a) x
Generic)

instance Show a => Show (Rel a) where
    show :: Rel a -> String
show = Map a (Set a) -> String
forall a. Show a => a -> String
show (Map a (Set a) -> String)
-> (Rel a -> Map a (Set a)) -> Rel a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

instance (Ord a, Read a) => Read (Rel a) where
    readsPrec :: Int -> ReadS (Rel a)
readsPrec d :: Int
d = ((Map a (Set a), String) -> (Rel a, String))
-> [(Map a (Set a), String)] -> [(Rel a, String)]
forall a b. (a -> b) -> [a] -> [b]
List.map (\ (m :: Map a (Set a)
m, r :: String
r) -> (Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
fromMap Map a (Set a)
m , String
r)) ([(Map a (Set a), String)] -> [(Rel a, String)])
-> (String -> [(Map a (Set a), String)]) -> ReadS (Rel a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Map a (Set a), String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
d

fromMap :: Map.Map a (Set.Set a) -> Rel a
fromMap :: Map a (Set a) -> Rel a
fromMap = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel

-- | the empty relation
empty :: Rel a
empty :: Rel a
empty = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel Map a (Set a)
forall k a. Map k a
Map.empty

-- | test for 'empty'
nullKeys :: Rel a -> Bool
nullKeys :: Rel a -> Bool
nullKeys (Rel m :: Map a (Set a)
m) = Map a (Set a) -> Bool
forall k a. Map k a -> Bool
Map.null Map a (Set a)
m

-- | keys of the relation
keysSet :: Rel a -> Set.Set a
keysSet :: Rel a -> Set a
keysSet = Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a (Set a) -> Set a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

rmNullSets :: Ord a => Rel a -> Rel a
rmNullSets :: Rel a -> Rel a
rmNullSets = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Set a) -> Map a (Set a)
forall a b. Ord a => Map a (Set b) -> Map a (Set b)
MapSet.rmNullSets (Map a (Set a) -> Map a (Set a))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | test for 'empty'
noPairs :: Ord a => Rel a -> Bool
noPairs :: Rel a -> Bool
noPairs = Rel a -> Bool
forall a. Rel a -> Bool
nullKeys (Rel a -> Bool) -> (Rel a -> Rel a) -> Rel a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Rel a
forall a. Ord a => Rel a -> Rel a
rmNullSets

-- | difference of two relations
difference :: Ord a => Rel a -> Rel a -> Rel a
difference :: Rel a -> Rel a -> Rel a
difference (Rel m :: Map a (Set a)
m) = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set a -> Maybe (Set a))
-> Map a (Set a) -> Map a (Set a) -> Map a (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)
MapSet.setDifference Map a (Set a)
m (Map a (Set a) -> Map a (Set a))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | union of two relations
union :: Ord a => Rel a -> Rel a -> Rel a
union :: Rel a -> Rel a -> Rel a
union (Rel m :: Map a (Set a)
m) = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set a -> Set a)
-> Map a (Set a) -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Map a (Set a)
m (Map a (Set a) -> Map a (Set a))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | intersection of two relations
intersection :: Ord a => Rel a -> Rel a -> Rel a
intersection :: Rel a -> Rel a -> Rel a
intersection (Rel m :: Map a (Set a)
m) = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set a -> Set a)
-> Map a (Set a) -> Map a (Set a) -> Map a (Set a)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Map a (Set a)
m (Map a (Set a) -> Map a (Set a))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | is the first relation a sub-relation of the second
isSubrelOf :: Ord a => Rel a -> Rel a -> Bool
isSubrelOf :: Rel a -> Rel a -> Bool
isSubrelOf (Rel m :: Map a (Set a)
m) = (Set a -> Set a -> Bool) -> Map a (Set a) -> Map a (Set a) -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Map a (Set a)
m (Map a (Set a) -> Bool)
-> (Rel a -> Map a (Set a)) -> Rel a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | insert an ordered pair
insertPair :: Ord a => a -> a -> Rel a -> Rel a
insertPair :: a -> a -> Rel a -> Rel a
insertPair a :: a
a b :: a
b = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Map a (Set a) -> Map a (Set a)
forall k a.
(Ord k, Ord a) =>
k -> a -> Map k (Set a) -> Map k (Set a)
MapSet.setInsert a
a a
b (Map a (Set a) -> Map a (Set a))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | insert a pair only if both sides are different
insertDiffPair :: Ord a => a -> a -> Rel a -> Rel a
insertDiffPair :: a -> a -> Rel a -> Rel a
insertDiffPair a :: a
a b :: a
b = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then Rel a -> Rel a
forall a. a -> a
id else a -> a -> Rel a -> Rel a
forall a. Ord a => a -> a -> Rel a -> Rel a
insertPair a
a a
b

-- | insert a pair only if both sides are different
insertKeyOrPair :: Ord a => a -> a -> Rel a -> Rel a
insertKeyOrPair :: a -> a -> Rel a -> Rel a
insertKeyOrPair a :: a
a b :: a
b = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then a -> Rel a -> Rel a
forall a. Ord a => a -> Rel a -> Rel a
insertKey a
a else a -> a -> Rel a -> Rel a
forall a. Ord a => a -> a -> Rel a -> Rel a
insertPair a
a a
b

-- | insert an unrelated node
insertKey :: Ord a => a -> Rel a -> Rel a
insertKey :: a -> Rel a -> Rel a
insertKey k :: a
k r :: Rel a
r@(Rel m :: Map a (Set a)
m) = if a -> Map a (Set a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member a
k Map a (Set a)
m then Rel a
r else
  Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a) -> Map a (Set a) -> Rel a
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert a
k Set a
forall a. Set a
Set.empty Map a (Set a)
m

-- | delete an ordered pair
delete :: Ord a => a -> a -> Rel a -> Rel a
delete :: a -> a -> Rel a -> Rel a
delete a :: a
a b :: a
b (Rel m :: Map a (Set a)
m) =
    let t :: Set a
t = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
b (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ a -> Map a (Set a) -> Set a
forall a b. Ord a => a -> Map a (Set b) -> Set b
MapSet.setLookup a
a Map a (Set a)
m in
    Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a) -> Map a (Set a) -> Rel a
forall a b. (a -> b) -> a -> b
$ if Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
t then a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
a Map a (Set a)
m else a -> Set a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert a
a Set a
t Map a (Set a)
m

-- | delete a node and all its relations
deleteKey :: Ord a => a -> Rel a -> Rel a
deleteKey :: a -> Rel a -> Rel a
deleteKey k :: a
k = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
k (Map a (Set a) -> Map a (Set a))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | test for an (previously inserted) ordered pair
member :: Ord a => a -> a -> Rel a -> Bool
member :: a -> a -> Rel a -> Bool
member a :: a
a b :: a
b r :: Rel a
r = a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
b (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Rel a -> a -> Set a
forall a. Ord a => Rel a -> a -> Set a
succs Rel a
r a
a

memberKey :: Ord a => a -> Rel a -> Bool
memberKey :: a -> Rel a -> Bool
memberKey k :: a
k = a -> Map a (Set a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member a
k (Map a (Set a) -> Bool)
-> (Rel a -> Map a (Set a)) -> Rel a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | get direct successors
succs :: Ord a => Rel a -> a -> Set.Set a
succs :: Rel a -> a -> Set a
succs (Rel m :: Map a (Set a)
m) a :: a
a = Set a -> a -> Map a (Set a) -> Set a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set a
forall a. Set a
Set.empty a
a Map a (Set a)
m

-- | get all transitive successors
reachable :: Ord a => Rel a -> a -> Set.Set a
reachable :: Rel a -> a -> Set a
reachable r :: Rel a
r a :: a
a = (a -> Set a -> Set a) -> Set a -> Set a -> Set a
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold a -> Set a -> Set a
reach Set a
forall a. Set a
Set.empty (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Rel a -> a -> Set a
forall a. Ord a => Rel a -> a -> Set a
succs Rel a
r a
a where
    reach :: a -> Set a -> Set a
reach e :: a
e s :: Set a
s = if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
e Set a
s then Set a
s
                    else (a -> Set a -> Set a) -> Set a -> Set a -> Set a
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold a -> Set a -> Set a
reach (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
e Set a
s) (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Rel a -> a -> Set a
forall a. Ord a => Rel a -> a -> Set a
succs Rel a
r a
e

-- | predecessors of one node in the given set of a nodes
preds :: Ord a => Rel a -> a -> Set.Set a -> Set.Set a
preds :: Rel a -> a -> Set a -> Set a
preds r :: Rel a
r a :: a
a = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ( \ s :: a
s -> a -> a -> Rel a -> Bool
forall a. Ord a => a -> a -> Rel a -> Bool
member a
s a
a Rel a
r)

-- | get direct predecessors
predecessors :: Ord a => Rel a -> a -> Set.Set a
predecessors :: Rel a -> a -> Set a
predecessors (Rel m :: Map a (Set a)
m) a :: a
a = Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a (Set a) -> Set a) -> Map a (Set a) -> Set a
forall a b. (a -> b) -> a -> b
$ (Set a -> Bool) -> Map a (Set a) -> Map a (Set a)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
a) Map a (Set a)
m

-- | test for 'member' or transitive membership (non-empty path)
path :: Ord a => a -> a -> Rel a -> Bool
path :: a -> a -> Rel a -> Bool
path a :: a
a b :: a
b r :: Rel a
r = a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
b (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Rel a -> a -> Set a
forall a. Ord a => Rel a -> a -> Set a
reachable Rel a
r a
a

-- | compute transitive closure (make all transitive members direct members)
transClosure :: Ord a => Rel a -> Rel a
transClosure :: Rel a -> Rel a
transClosure r :: Rel a
r@(Rel m :: Map a (Set a)
m) = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a) -> Map a (Set a) -> Rel a
forall a b. (a -> b) -> a -> b
$ (a -> Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey ( \ k :: a
k _ -> Rel a -> a -> Set a
forall a. Ord a => Rel a -> a -> Set a
reachable Rel a
r a
k) Map a (Set a)
m

-- | get transposed relation (losing unrelated keys)
transpose :: Ord a => Rel a -> Rel a
transpose :: Rel a -> Rel a
transpose = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapSet a a -> Map a (Set a)
forall a b. MapSet a b -> Map a (Set b)
MapSet.toMap (MapSet a a -> Map a (Set a))
-> (Rel a -> MapSet a a) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapSet a a -> MapSet a a
forall a b. (Ord a, Ord b) => MapSet a b -> MapSet b a
MapSet.transpose (MapSet a a -> MapSet a a)
-> (Rel a -> MapSet a a) -> Rel a -> MapSet a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Set a) -> MapSet a a
forall a b. Ord a => Map a (Set b) -> MapSet a b
MapSet.fromMap (Map a (Set a) -> MapSet a a)
-> (Rel a -> Map a (Set a)) -> Rel a -> MapSet a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | make relation irreflexive
irreflex :: Ord a => Rel a -> Rel a
irreflex :: Rel a -> Rel a
irreflex = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete (Map a (Set a) -> Map a (Set a))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | add all keys as reflexive elements
reflexive :: Ord a => Rel a -> Rel a
reflexive :: Rel a -> Rel a
reflexive = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert (Map a (Set a) -> Map a (Set a))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | get entries that contain the key as element
getCycles :: Ord a => Rel a -> Rel a
getCycles :: Rel a -> Rel a
getCycles = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Rel a -> Map a (Set a)) -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a -> Bool) -> Map a (Set a) -> Map a (Set a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Map a (Set a) -> Map a (Set a))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | compute strongly connected components for a transitively closed relation
sccOfClosure :: Ord a => Rel a -> [Set.Set a]
sccOfClosure :: Rel a -> [Set a]
sccOfClosure r :: Rel a
r@(Rel m :: Map a (Set a)
m) =
        if Map a (Set a) -> Bool
forall k a. Map k a -> Bool
Map.null Map a (Set a)
m then []
        else let ((k :: a
k, v :: Set a
v), p :: Map a (Set a)
p) = Map a (Set a) -> ((a, Set a), Map a (Set a))
forall k a. Map k a -> ((k, a), Map k a)
Map.deleteFindMin Map a (Set a)
m in
             if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
k Set a
v then -- has a cycle
                let c :: Set a
c = Rel a -> a -> Set a -> Set a
forall a. Ord a => Rel a -> a -> Set a -> Set a
preds Rel a
r a
k Set a
v in -- get the cycle
                Set a
c Set a -> [Set a] -> [Set a]
forall a. a -> [a] -> [a]
: Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
sccOfClosure (Set a -> Rel a -> Rel a
forall a. Ord a => Set a -> Rel a -> Rel a
delSet Set a
c Rel a
r)
             else Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
sccOfClosure (Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel Map a (Set a)
p)

{- | restrict strongly connected components to its minimal representative
     (input sets must be non-null). Direct cycles may remain. -}
collaps :: Ord a => [Set.Set a] -> Rel a -> Rel a
collaps :: [Set a] -> Rel a -> Rel a
collaps = Set a -> Rel a -> Rel a
forall a. Ord a => Set a -> Rel a -> Rel a
delSet (Set a -> Rel a -> Rel a)
-> ([Set a] -> Set a) -> [Set a] -> Rel a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set a] -> Set a) -> ([Set a] -> [Set a]) -> [Set a] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set a) -> [Set a] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
List.map Set a -> Set a
forall a. Set a -> Set a
Set.deleteMin

{- | transitive reduction (minimal relation with the same transitive closure)
     of a transitively closed DAG (i.e. without cycles)! -}
transReduce :: Ord a => Rel a -> Rel a
transReduce :: Rel a -> Rel a
transReduce (Rel m :: Map a (Set a)
m) = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel
-- keep all (i, j) in rel for which no c with (i, c) and (c, j) in rel
  (Map a (Set a) -> Rel a) -> Map a (Set a) -> Rel a
forall a b. (a -> b) -> a -> b
$ (a -> Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey ( \ i :: a
i s :: Set a
s -> let d :: Map a a
d = Set a -> Map a a
forall a. Ord a => Set a -> Map a a
MapSet.setToMap (Set a -> Map a a) -> Set a -> Map a a
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
i Set a
s in
        (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ( \ j :: a
j ->
            Map a (Set a) -> Bool
forall k a. Map k a -> Bool
Map.null (Map a (Set a) -> Bool) -> Map a (Set a) -> Bool
forall a b. (a -> b) -> a -> b
$ (Set a -> Bool) -> Map a (Set a) -> Map a (Set a)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
j)
                (Map a (Set a) -> Map a (Set a)) -> Map a (Set a) -> Map a (Set a)
forall a b. (a -> b) -> a -> b
$ Map a (Set a) -> Map a a -> Map a (Set a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map a (Set a)
m (Map a a -> Map a (Set a)) -> Map a a -> Map a (Set a)
forall a b. (a -> b) -> a -> b
$ a -> Map a a -> Map a a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
j Map a a
d) Set a
s) Map a (Set a)
m

-- | convert a list of ordered pairs to a relation
fromList :: Ord a => [(a, a)] -> Rel a
fromList :: [(a, a)] -> Rel a
fromList = ((a, a) -> Rel a -> Rel a) -> Rel a -> [(a, a)] -> Rel a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> Rel a -> Rel a) -> (a, a) -> Rel a -> Rel a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Rel a -> Rel a
forall a. Ord a => a -> a -> Rel a -> Rel a
insertPair) Rel a
forall a. Rel a
empty

-- | convert a relation to a list of ordered pairs (this loses isolated keys!)
toList :: Rel a -> [(a, a)]
toList :: Rel a -> [(a, a)]
toList (Rel m :: Map a (Set a)
m) = ((a, Set a) -> [(a, a)]) -> [(a, Set a)] -> [(a, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ (a :: a
a , bs :: Set a
bs) -> (a -> (a, a)) -> [a] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
List.map ( \ b :: a
b -> (a
a, a
b) )
                            (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
bs)) ([(a, Set a)] -> [(a, a)]) -> [(a, Set a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ Map a (Set a) -> [(a, Set a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map a (Set a)
m

-- | map the values of a relation
map :: (Ord a, Ord b) => (a -> b) -> Rel a -> Rel b
map :: (a -> b) -> Rel a -> Rel b
map f :: a -> b
f = Map b (Set b) -> Rel b
forall a. Map a (Set a) -> Rel a
Rel (Map b (Set b) -> Rel b)
-> (Rel a -> Map b (Set b)) -> Rel a -> Rel b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set b -> Set b -> Set b)
-> (a -> b) -> Map a (Set b) -> Map b (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
Set.union a -> b
f (Map a (Set b) -> Map b (Set b))
-> (Rel a -> Map a (Set b)) -> Rel a -> Map b (Set b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> Set b) -> Map a (Set a) -> Map a (Set b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((a -> b) -> Set a -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> b
f) (Map a (Set a) -> Map a (Set b))
-> (Rel a -> Map a (Set a)) -> Rel a -> Map a (Set b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

-- | Restriction of a relation under a set
restrict :: Ord a => Rel a -> Set.Set a -> Rel a
restrict :: Rel a -> Set a -> Rel a
restrict r :: Rel a
r s :: Set a
s = Set a -> Rel a -> Rel a
forall a. Ord a => Set a -> Rel a -> Rel a
delSet (Rel a -> Set a
forall a. Ord a => Rel a -> Set a
nodes Rel a
r Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
s) Rel a
r

-- | restrict to elements not in the input set
delSet :: Ord a => Set.Set a -> Rel a -> Rel a
delSet :: Set a -> Rel a -> Rel a
delSet s :: Set a
s (Rel m :: Map a (Set a)
m) = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a) -> Map a (Set a) -> Rel a
forall a b. (a -> b) -> a -> b
$ (Set a -> Set a) -> Map a (Set a) -> Map a (Set a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
s) (Map a (Set a) -> Map a (Set a)) -> Map a (Set a) -> Map a (Set a)
forall a b. (a -> b) -> a -> b
$ Map a (Set a)
m Map a (Set a) -> Map a a -> Map a (Set a)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Set a -> Map a a
forall a. Ord a => Set a -> Map a a
MapSet.setToMap Set a
s

-- | convert a relation to a set of ordered pairs
toSet :: Ord a => Rel a -> Set.Set (a, a)
toSet :: Rel a -> Set (a, a)
toSet = [(a, a)] -> Set (a, a)
forall a. [a] -> Set a
Set.fromDistinctAscList ([(a, a)] -> Set (a, a))
-> (Rel a -> [(a, a)]) -> Rel a -> Set (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> [(a, a)]
forall a. Rel a -> [(a, a)]
toList

-- | convert a set of ordered pairs to a relation
fromSet :: Ord a => Set.Set (a, a) -> Rel a
fromSet :: Set (a, a) -> Rel a
fromSet = [(a, a)] -> Rel a
forall a. Ord a => [(a, a)] -> Rel a
fromAscList ([(a, a)] -> Rel a)
-> (Set (a, a) -> [(a, a)]) -> Set (a, a) -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (a, a) -> [(a, a)]
forall a. Set a -> [a]
Set.toList

-- | convert a plain node set to a relation
fromKeysSet :: Ord a => Set.Set a -> Rel a
fromKeysSet :: Set a -> Rel a
fromKeysSet = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> (Set a -> Map a (Set a)) -> Set a -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Map a (Set a) -> Map a (Set a))
-> Map a (Set a) -> Set a -> Map a (Set a)
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold (a -> Set a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
`Map.insert` Set a
forall a. Set a
Set.empty) Map a (Set a)
forall k a. Map k a
Map.empty

-- | convert a sorted list of ordered pairs to a relation
fromAscList :: Ord a => [(a, a)] -> Rel a
fromAscList :: [(a, a)] -> Rel a
fromAscList = Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a)
-> ([(a, a)] -> Map a (Set a)) -> [(a, a)] -> Rel a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, Set a)] -> Map a (Set a)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList
                  ([(a, Set a)] -> Map a (Set a))
-> ([(a, a)] -> [(a, Set a)]) -> [(a, a)] -> Map a (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, a)] -> (a, Set a)) -> [[(a, a)]] -> [(a, Set a)]
forall a b. (a -> b) -> [a] -> [b]
List.map ( \ l :: [(a, a)]
l -> ((a, a) -> a
forall a b. (a, b) -> a
fst ([(a, a)] -> (a, a)
forall a. [a] -> a
head [(a, a)]
l),
                                  [a] -> Set a
forall a. [a] -> Set a
Set.fromDistinctAscList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ ((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
List.map (a, a) -> a
forall a b. (a, b) -> b
snd [(a, a)]
l))
                        ([[(a, a)]] -> [(a, Set a)])
-> ([(a, a)] -> [[(a, a)]]) -> [(a, a)] -> [(a, Set a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> (a, a) -> Bool) -> [(a, a)] -> [[(a, a)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy ( \ (a :: a
a, _) (b :: a
b, _) -> a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b)

-- | all nodes of the edges
nodes :: Ord a => Rel a -> Set.Set a
nodes :: Rel a -> Set a
nodes (Rel m :: Map a (Set a)
m) = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set a)
m) (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Map a (Set a) -> Set a
forall b a. Ord b => Map a (Set b) -> Set b
MapSet.setElems Map a (Set a)
m

{- | Construct a precedence map from a closed relation. Indices range
   between 1 and the second value that is output. -}
toPrecMap :: Ord a => Rel a -> (Map.Map a Int, Int)
toPrecMap :: Rel a -> (Map a Int, Int)
toPrecMap = ((Map a Int, Int) -> Set a -> (Map a Int, Int))
-> (Map a Int, Int) -> [Set a] -> (Map a Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ( \ (m1 :: Map a Int
m1, c :: Int
c) s :: Set a
s -> let n :: Int
n = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 in
                    ((a -> Map a Int -> Map a Int) -> Map a Int -> Set a -> Map a Int
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold (a -> Int -> Map a Int -> Map a Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
`Map.insert` Int
n) Map a Int
m1 Set a
s, Int
n))
                 (Map a Int
forall k a. Map k a
Map.empty, 0) ([Set a] -> (Map a Int, Int))
-> (Rel a -> [Set a]) -> Rel a -> (Map a Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
topSort

topSortDAG :: Ord a => Rel a -> [Set.Set a]
topSortDAG :: Rel a -> [Set a]
topSortDAG r :: Rel a
r@(Rel m :: Map a (Set a)
m) = if Map a (Set a) -> Bool
forall k a. Map k a -> Bool
Map.null Map a (Set a)
m then [] else
    let es :: Set a
es = Map a (Set a) -> Set a
forall b a. Ord b => Map a (Set b) -> Set b
MapSet.setElems Map a (Set a)
m
        ml :: Set a
ml = Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set a)
m Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
es -- most left
        Rel m2 :: Map a (Set a)
m2 = Set a -> Rel a -> Rel a
forall a. Ord a => Set a -> Rel a -> Rel a
delSet Set a
ml Rel a
r
        rs :: Set a
rs = Set a
es Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet Map a (Set a)
m2 -- re-insert loose ends
    in Set a
ml Set a -> [Set a] -> [Set a]
forall a. a -> [a] -> [a]
: Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
topSortDAG (Map a (Set a) -> Rel a
forall a. Map a (Set a) -> Rel a
Rel (Map a (Set a) -> Rel a) -> Map a (Set a) -> Rel a
forall a b. (a -> b) -> a -> b
$ (a -> Map a (Set a) -> Map a (Set a))
-> Map a (Set a) -> Set a -> Map a (Set a)
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold (a -> Set a -> Map a (Set a) -> Map a (Set a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
`Map.insert` Set a
forall a. Set a
Set.empty) Map a (Set a)
m2 Set a
rs)

-- | topologically sort a closed relation (ignore isolated cycles)
topSort :: Ord a => Rel a -> [Set.Set a]
topSort :: Rel a -> [Set a]
topSort r :: Rel a
r = let cs :: [Set a]
cs = Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
sccOfClosure Rel a
r in
      (Set a -> Set a) -> [Set a] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
List.map ([Set a] -> Set a -> Set a
forall a. Ord a => [Set a] -> Set a -> Set a
expandCycle [Set a]
cs) ([Set a] -> [Set a]) -> [Set a] -> [Set a]
forall a b. (a -> b) -> a -> b
$ Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
topSortDAG (Rel a -> [Set a]) -> Rel a -> [Set a]
forall a b. (a -> b) -> a -> b
$ Rel a -> Rel a
forall a. Ord a => Rel a -> Rel a
irreflex (Rel a -> Rel a) -> Rel a -> Rel a
forall a b. (a -> b) -> a -> b
$ [Set a] -> Rel a -> Rel a
forall a. Ord a => [Set a] -> Rel a -> Rel a
collaps [Set a]
cs Rel a
r

-- | find the cycle and add it to the result set
expandCycle :: Ord a => [Set.Set a] -> Set.Set a -> Set.Set a
expandCycle :: [Set a] -> Set a -> Set a
expandCycle cs :: [Set a]
cs s :: Set a
s = case [Set a]
cs of
  [] -> Set a
s
  c :: Set a
c : r :: [Set a]
r ->
    if Set a -> Bool
forall a. Set a -> Bool
Set.null (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set a
c Set a
s then [Set a] -> Set a -> Set a
forall a. Ord a => [Set a] -> Set a -> Set a
expandCycle [Set a]
r Set a
s else Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set a
c Set a
s

-- dependency sort
depSort :: Ord a => Rel a -> [Set.Set a]
depSort :: Rel a -> [Set a]
depSort r :: Rel a
r = let cs :: [Set a]
cs = Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
sccOfClosure Rel a
r in
  (Set a -> [Set a]) -> [Set a] -> [Set a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap ((a -> Set a) -> [a] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
List.map ([Set a] -> a -> Set a
forall a. Ord a => [Set a] -> a -> Set a
depCycle [Set a]
cs) ([a] -> [Set a]) -> (Set a -> [a]) -> Set a -> [Set a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList)
    ([Set a] -> [Set a]) -> [Set a] -> [Set a]
forall a b. (a -> b) -> a -> b
$ Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
topSortDAG (Rel a -> [Set a]) -> Rel a -> [Set a]
forall a b. (a -> b) -> a -> b
$ Rel a -> Rel a
forall a. Ord a => Rel a -> Rel a
irreflex (Rel a -> Rel a) -> Rel a -> Rel a
forall a b. (a -> b) -> a -> b
$ [Set a] -> Rel a -> Rel a
forall a. Ord a => [Set a] -> Rel a -> Rel a
collaps [Set a]
cs Rel a
r

depCycle :: Ord a => [Set.Set a] -> a -> Set.Set a
depCycle :: [Set a] -> a -> Set a
depCycle cs :: [Set a]
cs a :: a
a = case [Set a]
cs of
  [] -> a -> Set a
forall a. a -> Set a
Set.singleton a
a
  c :: Set a
c : r :: [Set a]
r ->
    if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
a Set a
c then Set a
c else [Set a] -> a -> Set a
forall a. Ord a => [Set a] -> a -> Set a
depCycle [Set a]
r a
a

-- | gets the most right elements of a relation,
mostRightOfCollapsed :: Ord a => Rel a -> Set.Set a
mostRightOfCollapsed :: Rel a -> Set a
mostRightOfCollapsed r :: Rel a
r@(Rel m :: Map a (Set a)
m) =
  Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Rel a -> Set a
forall a. Ord a => Rel a -> Set a
nodes Rel a
r) (Set a -> Set a)
-> (Map a (Set a) -> Set a) -> Map a (Set a) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a (Set a) -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a (Set a) -> Set a) -> Map a (Set a) -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Set a -> Bool) -> Map a (Set a) -> Map a (Set a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
  (\ i :: a
i s :: Set a
s -> Bool -> Bool
not (Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
s) Bool -> Bool -> Bool
&& Set a
s Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> Set a
forall a. a -> Set a
Set.singleton a
i) Map a (Set a)
m

{- |
find s such that x in s => forall y . yRx or not yRx and not xRy

 * precondition: (transClosure r == r)

 * strongly connected components (cycles) are treated as a compound node
-}

mostRight :: Ord a => Rel a -> Set.Set a
mostRight :: Rel a -> Set a
mostRight r :: Rel a
r = let
    cs :: [Set a]
cs = Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
sccOfClosure Rel a
r
    in [Set a] -> Set a -> Set a
forall a. Ord a => [Set a] -> Set a -> Set a
expandCycle [Set a]
cs (Rel a -> Set a
forall a. Ord a => Rel a -> Set a
mostRightOfCollapsed (Rel a -> Set a) -> Rel a -> Set a
forall a b. (a -> b) -> a -> b
$ [Set a] -> Rel a -> Rel a
forall a. Ord a => [Set a] -> Rel a -> Rel a
collaps [Set a]
cs Rel a
r)

{- |
intransitive kernel of a reflexive and transitive closure

 * precondition: (transClosure r == r)
 * cycles are uniquely represented (according to Ord)
-}
intransKernel :: Ord a => Rel a -> Rel a
intransKernel :: Rel a -> Rel a
intransKernel r :: Rel a
r =
    let cs :: [Set a]
cs = Rel a -> [Set a]
forall a. Ord a => Rel a -> [Set a]
sccOfClosure Rel a
r
    in (Set a -> Rel a -> Rel a) -> Rel a -> [Set a] -> Rel a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set a -> Rel a -> Rel a
forall a. Ord a => Set a -> Rel a -> Rel a
addCycle (Rel a -> Rel a
forall a. Ord a => Rel a -> Rel a
transReduce (Rel a -> Rel a) -> Rel a -> Rel a
forall a b. (a -> b) -> a -> b
$ [Set a] -> Rel a -> Rel a
forall a. Ord a => [Set a] -> Rel a -> Rel a
collaps [Set a]
cs Rel a
r) [Set a]
cs

-- add a cycle given by a set in the collapsed node
addCycle :: Ord a => Set.Set a -> Rel a -> Rel a
addCycle :: Set a -> Rel a -> Rel a
addCycle c :: Set a
c r :: Rel a
r = if Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
c then String -> Rel a
forall a. HasCallStack => String -> a
error "Common.Lib.Rel.addCycle" else
    let (a :: a
a, b :: Set a
b) = Set a -> (a, Set a)
forall a. Set a -> (a, Set a)
Set.deleteFindMin Set a
c
        (m :: a
m, d :: Set a
d) = Set a -> (a, Set a)
forall a. Set a -> (a, Set a)
Set.deleteFindMax Set a
c
    in a -> a -> Rel a -> Rel a
forall a. Ord a => a -> a -> Rel a -> Rel a
insertPair a
m a
a (Rel a -> Rel a) -> Rel a -> Rel a
forall a b. (a -> b) -> a -> b
$ ((a, a) -> Rel a -> Rel a) -> Rel a -> [(a, a)] -> Rel a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> Rel a -> Rel a) -> (a, a) -> Rel a -> Rel a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Rel a -> Rel a
forall a. Ord a => a -> a -> Rel a -> Rel a
insertPair) (a -> a -> Rel a -> Rel a
forall a. Ord a => a -> a -> Rel a -> Rel a
delete a
a a
a Rel a
r) ([(a, a)] -> Rel a) -> [(a, a)] -> Rel a
forall a b. (a -> b) -> a -> b
$
       [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
d) (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
b)

{- | calculates if two given elements have a common left element

 * if one of the arguments is not present False is returned
-}
haveCommonLeftElem :: Ord a => a -> a -> Rel a -> Bool
haveCommonLeftElem :: a -> a -> Rel a -> Bool
haveCommonLeftElem t1 :: a
t1 t2 :: a
t2 =
    (Set a -> Bool -> Bool) -> Bool -> Map a (Set a) -> Bool
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (\ e :: Set a
e -> (Bool -> Bool -> Bool
|| a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
t1 Set a
e Bool -> Bool -> Bool
&& a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
t2 Set a
e)) Bool
False (Map a (Set a) -> Bool)
-> (Rel a -> Map a (Set a)) -> Rel a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rel a -> Map a (Set a)
forall a. Rel a -> Map a (Set a)
toMap

{- | partitions a set into a list of disjoint non-empty subsets
determined by the given function as equivalence classes -}
partSet :: Ord a => (a -> a -> Bool) -> Set.Set a -> [Set.Set a]
partSet :: (a -> a -> Bool) -> Set a -> [Set a]
partSet f :: a -> a -> Bool
f = ([a] -> Set a) -> [[a]] -> [Set a]
forall a b. (a -> b) -> [a] -> [b]
List.map [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([[a]] -> [Set a]) -> (Set a -> [[a]]) -> Set a -> [Set a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> Set a -> [[a]]
forall a. Ord a => (a -> a -> Bool) -> Set a -> [[a]]
leqClasses a -> a -> Bool
f

{- | partitions a list into a list of disjoint non-empty lists
determined by the given function as equivalence classes -}
partList :: (a -> a -> Bool) -> [a] -> [[a]]
partList :: (a -> a -> Bool) -> [a] -> [[a]]
partList f :: a -> a -> Bool
f l :: [a]
l = case [a]
l of
  [] -> []
  x :: a
x : r :: [a]
r -> let
    (ds :: [[a]]
ds, es :: [[a]]
es) = ([a] -> Bool) -> [[a]] -> ([[a]], [[a]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> a -> Bool
f a
x)) ([[a]] -> ([[a]], [[a]])) -> [[a]] -> ([[a]], [[a]])
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
partList a -> a -> Bool
f [a]
r
    in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
es) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
ds

-- | Divide a Set (List) into equivalence classes w.r.t. eq
leqClasses :: Ord a => (a -> a -> Bool) -> Set.Set a -> [[a]]
leqClasses :: (a -> a -> Bool) -> Set a -> [[a]]
leqClasses f :: a -> a -> Bool
f = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
partList a -> a -> Bool
f ([a] -> [[a]]) -> (Set a -> [a]) -> Set a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList

{- | flattens a list of non-empty sets and uses the minimal element of
each set to represent the set -}
flatSet :: Ord a => [Set.Set a] -> Set.Set a
flatSet :: [Set a] -> Set a
flatSet = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> ([Set a] -> [a]) -> [Set a] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> a) -> [Set a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
List.map (\ s :: Set a
s -> if Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
s
                         then String -> a
forall a. HasCallStack => String -> a
error "Common.Lib.Rel.flatSet"
                         else Set a -> a
forall a. Set a -> a
Set.findMin Set a
s)

{- | checks if a given relation is locally filtered

 * precondition: the relation must already be closed by transitive closure
-}
locallyFiltered :: Ord a => Rel a -> Bool
locallyFiltered :: Rel a -> Bool
locallyFiltered rel :: Rel a
rel = Set a -> Bool
check (Set a -> Bool) -> (Set a -> Set a) -> Set a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set a] -> Set a
forall a. Ord a => [Set a] -> Set a
flatSet ([Set a] -> Set a) -> (Set a -> [Set a]) -> Set a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> Set a -> [Set a]
forall a. Ord a => (a -> a -> Bool) -> Set a -> [Set a]
partSet a -> a -> Bool
iso (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Rel a -> Set a
forall a. Ord a => Rel a -> Set a
mostRight Rel a
rel
    where iso :: a -> a -> Bool
iso x :: a
x y :: a
y = a -> a -> Rel a -> Bool
forall a. Ord a => a -> a -> Rel a -> Bool
member a
x a
y Rel a
rel Bool -> Bool -> Bool
&& a -> a -> Rel a -> Bool
forall a. Ord a => a -> a -> Rel a -> Bool
member a
y a
x Rel a
rel
          check :: Set a -> Bool
check s :: Set a
s = Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
s Bool -> Bool -> Bool
||
                  (a -> Bool -> Bool) -> Bool -> Set a -> Bool
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold (\ y :: a
y ->
                            (Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> a -> Rel a -> Bool
forall a. Ord a => a -> a -> Rel a -> Bool
haveCommonLeftElem a
x a
y Rel a
rel))) Bool
True Set a
s'
                  Bool -> Bool -> Bool
&& Set a -> Bool
check Set a
s'
              where (x :: a
x, s' :: Set a
s') = Set a -> (a, Set a)
forall a. Set a -> (a, Set a)
Set.deleteFindMin Set a
s