{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE InstanceSigs #-}

module Fuzzy.Relations.LRelation (
    LRelation(LRelation),
    FuzzySet(..),
    fromList,
    fromFuzzySet,
    fromFunction,
    mkEmptyRel,
    mkSingletonRel,
    mkUniversalRel, 
    toPairs
) where

import Lattices.ResiduatedLattice
import Data.List
import Data.Maybe
import FuzzySet
import Utils.Utils (universeToList, listToUniverse)


{- | Binary L relation is a fuzzy set on a universe of pairs -}
data (ResiduatedLattice l, Eq a) => LRelation a l = LRelation
    { forall a l.
(ResiduatedLattice l, Eq a) =>
LRelation a l -> (a, a) -> l
membership :: (a, a) -> l
    , forall a l.
(ResiduatedLattice l, Eq a) =>
LRelation a l -> [(a, a)]
universe :: ![(a, a)]
    }
    -- normally fuzzy relation is function R: X x Y -> L va 

    -- but we can create any type U =  X | Y

    -- this way we can represent the relation with one universal set

    -- so we have R: U x U -> L


instance (Eq a, Show a, Show l, ResiduatedLattice l) => Show (LRelation a l) where
    show :: LRelation a l -> String
    show :: LRelation a l -> String
show (LRelation (a, a) -> l
r [(a, a)]
u) =
        let memberships :: [((a, a), l)]
memberships = [((a, a)
p, (a, a) -> l
r (a, a)
p) | (a, a)
p <- [(a, a)]
u]
        in  String
"LRelation {\n"
        forall a. [a] -> [a] -> [a]
++ String
"  Memberships: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [((a, a), l)]
memberships forall a. [a] -> [a] -> [a]
++ String
"\n"
        forall a. [a] -> [a] -> [a]
++ String
"\n}"

instance (Eq a, ResiduatedLattice l) => FuzzySet (LRelation a l) (a, a) l where
    member :: LRelation a l -> (a, a) -> l
    member :: LRelation a l -> (a, a) -> l
member (LRelation (a, a) -> l
r [(a, a)]
_) = (a, a) -> l
r
    universe :: LRelation a l -> [(a, a)]
    universe :: LRelation a l -> [(a, a)]
universe (LRelation (a, a) -> l
_ [(a, a)]
u) = [(a, a)]
u
    mkFuzzySet :: ((a, a) -> l) -> [(a, a)] -> LRelation a l
    mkFuzzySet :: ((a, a) -> l) -> [(a, a)] -> LRelation a l
mkFuzzySet = forall a l. ((a, a) -> l) -> [(a, a)] -> LRelation a l
LRelation


{- | Construct a fuzzy relation from a fuzzy set

==== __Examples__

>>> let fuzzySet = fromPairs [((1, 2), 0.5), ((2, 3), 0.8)] :: LSet (Int, Int) UILukasiewicz
>>> let rel = fromFuzzySet fuzzySet
>>> rel
"LRelation {Memberships: [((1,2),0.5),((2,3),0.8)]}"
-}
fromFuzzySet :: (FuzzySet f (a, a) l, ResiduatedLattice l, Eq a) => f -> LRelation a l
fromFuzzySet :: forall f a l.
(FuzzySet f (a, a) l, ResiduatedLattice l, Eq a) =>
f -> LRelation a l
fromFuzzySet f
fuzzySet = forall a l. ((a, a) -> l) -> [(a, a)] -> LRelation a l
LRelation (forall set a l. FuzzySet set a l => set -> a -> l
member f
fuzzySet) (forall set a l. FuzzySet set a l => set -> [a]
FuzzySet.universe f
fuzzySet)


{- | Construct a fuzzy relation from a list of pairs-}
fromList :: (ResiduatedLattice l, Eq a) => [((a, a), l)] -> LRelation a l
fromList :: forall l a.
(ResiduatedLattice l, Eq a) =>
[((a, a), l)] -> LRelation a l
fromList [((a, a), l)]
lst = forall a l. ((a, a) -> l) -> [(a, a)] -> LRelation a l
LRelation (a, a) -> l
member (forall a. Eq a => [a] -> [(a, a)]
listToUniverse [a]
u)
    where
        member :: (a, a) -> l
member (a
x, a
y) = forall a. a -> Maybe a -> a
fromMaybe forall l. BoundedLattice l => l
bot (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (a
x, a
y) [((a, a), l)]
lst)
        u :: [a]
u = forall a. Eq a => [(a, a)] -> [a]
universeToList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [((a, a), l)]
lst)


{- | Construct a fuzzy relation from a membership function and a universe

==== __Examples__

>>> let f (x, y) = if x < y then 0.7 else 0.3
>>> let rel = fromFunction f [(1, 2), (2, 3), (3, 1)] :: LRelation Int UILukasiewicz
>>> toPairs rel
[((1,2),0.7),((2,3),0.7),((3,1),0.3)]
-}
fromFunction :: (ResiduatedLattice l, Eq a) => ((a, a) -> l) -> [a] -> LRelation a l 
fromFunction :: forall l a.
(ResiduatedLattice l, Eq a) =>
((a, a) -> l) -> [a] -> LRelation a l
fromFunction (a, a) -> l
f [a]
u = forall a l. ((a, a) -> l) -> [(a, a)] -> LRelation a l
LRelation (a, a) -> l
f (forall a. Eq a => [a] -> [(a, a)]
listToUniverse [a]
u)


{- | Construct an empty fuzzy relation

==== __Examples__

>>> let emptyRel = mkEmptyRel :: LRelation Int UILukasiewicz
>>> toPairs emptyRel
[]
-}
mkEmptyRel :: (ResiduatedLattice l, Eq a) => LRelation a l
mkEmptyRel :: forall l a. (ResiduatedLattice l, Eq a) => LRelation a l
mkEmptyRel = forall a l. ((a, a) -> l) -> [(a, a)] -> LRelation a l
LRelation (forall a b. a -> b -> a
const forall l. BoundedLattice l => l
bot) []


{- | Construct a singleton fuzzy relation

==== __Examples__

>>> let singletonRel = mkSingletonRel [(1, 2), (2, 3)] ((1, 2), 0.8) :: LRelation Int UILukasiewicz
>>> toPairs singletonRel
[((1, 2), 0.8),((2, 3), 0.0)]
-}
mkSingletonRel :: (ResiduatedLattice l, Eq a) => [a] -> ((a, a), l) -> LRelation a l
mkSingletonRel :: forall l a.
(ResiduatedLattice l, Eq a) =>
[a] -> ((a, a), l) -> LRelation a l
mkSingletonRel [a]
u ((a, a)
x, l
l) = forall a l. ((a, a) -> l) -> [(a, a)] -> LRelation a l
LRelation (a, a) -> l
f (forall a. Eq a => [a] -> [(a, a)]
listToUniverse [a]
u)
    where f :: (a, a) -> l
f (a, a)
pair = if (a, a)
pair forall a. Eq a => a -> a -> Bool
== (a, a)
x then l
l else forall l. BoundedLattice l => l
bot


{- | Construct a universal fuzzy relation

==== __Examples__

>>> let universalRel = mkUniversalRel [(1, 2), (2, 3)] :: LRelation Int UILukasiewicz
>>> toPairs universalRel
[((1, 2), 1.0),((2, 3), 1.0)]
-}
mkUniversalRel :: (ResiduatedLattice l, Eq a) => [a] -> LRelation a l
mkUniversalRel :: forall l a. (ResiduatedLattice l, Eq a) => [a] -> LRelation a l
mkUniversalRel [a]
u = forall a l. ((a, a) -> l) -> [(a, a)] -> LRelation a l
LRelation (forall a b. a -> b -> a
const forall l. BoundedLattice l => l
top) (forall a. Eq a => [a] -> [(a, a)]
listToUniverse [a]
u)


-- | Return relation as a list of pairs

toPairs :: (ResiduatedLattice l, Eq a) => LRelation a l -> [((a, a), l)]
toPairs :: forall l a.
(ResiduatedLattice l, Eq a) =>
LRelation a l -> [((a, a), l)]
toPairs (LRelation (a, a) -> l
f [(a, a)]
u) = [((a, a)
x, (a, a) -> l
f (a, a)
x) | (a, a)
x <- [(a, a)]
u]