-- | This module contains functions that determine degree of properties of a 'LRelation'

module Fuzzy.Relations.Properties (
    ref,
    sym,
    tra,
    irref,
    asym,
) where

import Fuzzy.Relations.LRelation
import Lattices.ResiduatedLattice
import Utils.Utils(universeToList)
import Lattices.UnitIntervalStructures.Godel

-- functions determining degree of properties of fuzzy relations



{- | Degree to which 'LRelation' is reflexive.

An 'LRelation' is reflexive if \(ref \: rel =\) 'top'

==== __Examples__

>>> let u = [(1, 1), (2, 2), (3, 3)]
>>> let rel = LRelation (\(x, y) -> if x == y then top else bot) u :: LRelation Int UIGodel
>>> ref rel
1.0

>>> let rel = LRelation (\(x, y) -> bot) u :: LRelation Int UIGodel
>>> ref rel
0.0
-}
ref :: (Eq a, ResiduatedLattice l) => LRelation a l -> l
ref :: forall a l. (Eq a, ResiduatedLattice l) => LRelation a l -> l
ref (LRelation (a, a) -> l
f [(a, a)]
u) =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall l. BoundedLattice l => l -> l -> l
(/\) forall l. BoundedLattice l => l
top [(a, a) -> l
f (a, a)
x | (a, a)
x <- [(a, a)]
u,  forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(==) (a, a)
x]
    where universe :: [a]
universe = forall a. Eq a => [(a, a)] -> [a]
universeToList [(a, a)]
u


{- | Degree to which 'LRelation' is symmetric.

An 'LRelation' is symmetric if \(sym \: rel =\) 'top'

==== __Examples__

>>> let u = [(1, 2), (2, 1), (2, 3), (3, 2)]
>>> let rel = LRelation (const  0.5) u :: LRelation Int UILukasiewicz
>>> sym rel
1.0

>>> let rel = LRelation (\(x, y) -> if x < y then 0.7 else 0.3) u :: LRelation Int UILukasiewicz
>>> sym rel
0.6
-}
sym :: (Eq a,ResiduatedLattice l) => LRelation a l -> l
sym :: forall a l. (Eq a, ResiduatedLattice l) => LRelation a l -> l
sym (LRelation (a, a) -> l
f [(a, a)]
u) =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall l. BoundedLattice l => l -> l -> l
(/\) forall l. BoundedLattice l => l
top [(a, a) -> l
f (a
x, a
y) forall l. ResiduatedLattice l => l -> l -> l
--> (a, a) -> l
f (a
y, a
x) | a
x <- [a]
universe, a
y <- [a]
universe]
    where universe :: [a]
universe = forall a. Eq a => [(a, a)] -> [a]
universeToList [(a, a)]
u


{- | Degree to which 'LRelation' is transitive.

An 'LRelation' is transitive if \(tra \: rel =\) 'top'

==== __Examples__

>>> let u = [(1, 2), (2, 3), (1, 3)]
>>> let rel = LRelation (\(x, y) -> if x < y then 0.7 else 0.3) u :: LRelation Int UILukasiewicz
>>> tra rel
1.0

>>> let rel = LRelation (\(x, y) -> if x == y then 0.2 else 0.7) u :: LRelation Int UILukasiewicz
>>> tra rel
0.5
-}
tra :: (Eq a,ResiduatedLattice l) => LRelation a l -> l
tra :: forall a l. (Eq a, ResiduatedLattice l) => LRelation a l -> l
tra (LRelation (a, a) -> l
f [(a, a)]
u) =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall l. BoundedLattice l => l -> l -> l
(/\) forall l. BoundedLattice l => l
top [(a, a) -> l
f (a
x, a
y) forall l. BoundedLattice l => l -> l -> l
/\ (a, a) -> l
f (a
y, a
z) forall l. ResiduatedLattice l => l -> l -> l
--> (a, a) -> l
f (a
x, a
z) |
                      a
x <- [a]
universe, a
y <- [a]
universe, a
z <- [a]
universe]
    where universe :: [a]
universe = forall a. Eq a => [(a, a)] -> [a]
universeToList [(a, a)]
u


{- | Degree to which 'LRelation' is irreflexive.

An 'LRelation' is irreflexive if \(irref \: rel =\) 'top'

==== __Examples__

>>> let u = [(1, 1), (2, 2), (3, 3)]
>>> let rel = LRelation (\(x, y) -> if x == y then bot else top) u :: LRelation Int UILukasiewicz
>>> irref rel
1.0

>>> let rel = LRelation (\(x, y) -> if x == y then 0.7 else bot) u :: LRelation Int UILukasiewicz
>>> irref rel
0.3
-}
irref :: (Eq a,ResiduatedLattice l) => LRelation a l -> l
irref :: forall a l. (Eq a, ResiduatedLattice l) => LRelation a l -> l
irref (LRelation (a, a) -> l
f [(a, a)]
u) =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall l. BoundedLattice l => l -> l -> l
(/\) forall l. BoundedLattice l => l
top [forall l. ResiduatedLattice l => l -> l
negation ((a, a) -> l
f (a, a)
x) | (a, a)
x <- [(a, a)]
u,  forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(==) (a, a)
x]
    where universe :: [a]
universe = forall a. Eq a => [(a, a)] -> [a]
universeToList [(a, a)]
u


{- | Degree to which 'LRelation' is asymmetric.

An 'LRelation' is asymmetric if \(asym \: rel =\) 'top'

==== __Examples__

>>> let u = [(1, 2), (2, 3), (3, 1)]
>>> let rel = LRelation (\(x, y) -> if x < y then 0.7 else bot) u :: LRelation Int UILukasiewicz
>>> asym rel
1.0
-}
asym :: (Eq a,ResiduatedLattice l) => LRelation a l -> l
asym :: forall a l. (Eq a, ResiduatedLattice l) => LRelation a l -> l
asym (LRelation (a, a) -> l
f [(a, a)]
u) =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall l. BoundedLattice l => l -> l -> l
(/\) forall l. BoundedLattice l => l
top [(a, a) -> l
f (a
x, a
y) forall l. ResiduatedLattice l => l -> l -> l
--> forall l. ResiduatedLattice l => l -> l
negation ((a, a) -> l
f (a
y, a
x)) | a
x <- [a]
universe, a
y <- [a]
universe]
    where universe :: [a]
universe = forall a. Eq a => [(a, a)] -> [a]
universeToList [(a, a)]
u