{-# LANGUAGE FunctionalDependencies #-}

module FuzzySet(
    FuzzySet(..),
    alphaCut,
    union,
    unions,
    intersection,
    intersections,
    complement,
    setTnorm,
    setResiduum,
) where

import Lattices.ResiduatedLattice
import Lattices.UnitIntervalStructures.Lukasiewicz
import qualified Data.List as SetOp(union, intersect)

-- | Type class defines the basic behavior for a fuzzy set

class (ResiduatedLattice l, Eq a) => FuzzySet set a l | set -> a l where
    mkFuzzySet :: (a -> l) -> [a] -> set
    -- | membership function 

    member :: set -> a -> l
    universe :: set -> [a]
    truthDegrees :: set -> [l]
    truthDegrees set
set = [set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set a
x | a
x <- set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set]
    universeCardinality :: set -> Int
    universeCardinality set
s = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
s


-- | construct a empty fuzzy set

mkEmptySet :: (FuzzySet set a l) => set
mkEmptySet :: forall set a l. FuzzySet set a l => set
mkEmptySet = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet (l -> a -> l
forall a b. a -> b -> a
const l
forall l. BoundedLattice l => l
bot) []

-- | construct a singleton fuzzy set

mkSingletonSet :: (FuzzySet set a l, Eq a) => [a] -> (a, l) -> set
mkSingletonSet :: forall set a l. (FuzzySet set a l, Eq a) => [a] -> (a, l) -> set
mkSingletonSet [a]
u (a
x, l
l) = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet a -> l
f [a]
u
    where
        f :: a -> l
f a
y
            | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = l
l
            | Bool
otherwise = l
forall l. BoundedLattice l => l
bot

-- | construct universal fuzzy set

mkUniversalSet :: (FuzzySet set a l, Eq a) => [a] -> set
mkUniversalSet :: forall set a l. (FuzzySet set a l, Eq a) => [a] -> set
mkUniversalSet = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet (l -> a -> l
forall a b. a -> b -> a
const l
forall l. BoundedLattice l => l
top)


{- | list of all values from 'universe' that have ('member' u) >= alpha

==== __Examples__

>>> let set = fromPairs [(1, 0.1), (2, 0.2), (3. 0.4)]
>>> alphaCut 0.15 set 
[2, 3]

>>> alphaCut 0.3 set
[3]

>>> alphaCut 0.5 set
[]
>>> alphaCut 1 (mkUniversalSet [1..10])
[1, 2, 3, 4, 5, 6, 7, 8, 9, 10] 
-}
alphaCut :: (FuzzySet set a l) => l -> set -> [a]
alphaCut :: forall set a l. FuzzySet set a l => l -> set -> [a]
alphaCut l
alpha set
set = [a
x | a
x <- [a]
u, a -> l
f a
x l -> l -> Bool
forall a. Ord a => a -> a -> Bool
>= l
alpha]
    where f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set
          u :: [a]
u = set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set


{- | Fuzzy set union A ∪ B. Universe of the new set is union of universes from A and B.

==== __Examples__

>>> let set1 = fromPairs [(1, 0.2), (2, 0.7), (3, 0.1)] :: LSet Int UILukasiewicz 
>>> let set2 = fromPairs [(1, 0.3), (2, 0.4)] :: LSet Int UILukasiewicz 
>>> let set3 = fromPairs [(1, 0.5), (2, 0.1), (4, 0.8)] :: LSet Int UILukasiewicz
>>> toPairs $ union set1 set2
[(1, 0.3),(2, 0.7), (3, 0.1)]

>>> toPairs $ union set1 set3
[(1, 0.5), (2, 0.7), (3, 0.1), (4, 0.8)]

>>> toPairs $ union set1 mkEmptySet
[(1, 0.2), (2, 0.7), (3, 0.1)]
-}
union :: (FuzzySet set a l) => set -> set -> set
union :: forall set a l. FuzzySet set a l => set -> set -> set
union set
set1 set
set2 = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet (\a
x -> a -> l
f a
x l -> l -> l
forall l. BoundedLattice l => l -> l -> l
\/ a -> l
g a
x) [a]
u
    where f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set1
          g :: a -> l
g = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set2
          u :: [a]
u = [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
SetOp.union (set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set1) (set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set2)


-- | 'union' over a list of sets

unions :: (FuzzySet set a l, Eq a) => [set] -> set
unions :: forall set a l. (FuzzySet set a l, Eq a) => [set] -> set
unions sets :: [set]
sets@(set
set:[set]
_) = (set -> set -> set) -> set -> [set] -> set
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr set -> set -> set
forall set a l. FuzzySet set a l => set -> set -> set
union ([a] -> set
forall set a l. (FuzzySet set a l, Eq a) => [a] -> set
mkUniversalSet (set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set)) [set]
sets


{- | Fuzzy set intersection A ∩ B. Universe of the new set is intersection of universes from A and B.

==== __Examples__

>>> let set1 = fromPairs [(1, 0.2), (2, 0.7), (3, 0.1)]
>>> let set2 = fromPairs [(1, 0.3), (2, 0.4)]
>>> let set3 = fromPairs [(1, 0.5), (2, 0.1), (4, 0.8)] :: LSet Int UILukasiewicz
>>> toPairs $ intersection set1 set2
[(1, 0.2), (2, 0.4), (3, 0.0)]

>>> toPairs $ intersection set1 set3
[(1, 0.2), (2, 0.1), (3, 0.0), (4, 0.0)]

>>> toPairs $ intersection set1 mkEmptySet
[(1, 0.0), (2, 0.0), (3, 0.0)]
-}
intersection :: (FuzzySet set a l) => set -> set -> set
intersection :: forall set a l. FuzzySet set a l => set -> set -> set
intersection set
set1 set
set2 = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet (\a
x ->  a -> l
f a
x l -> l -> l
forall l. BoundedLattice l => l -> l -> l
/\ a -> l
g a
x) [a]
u
    where f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set1
          g :: a -> l
g = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set2
          u :: [a]
u = [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
SetOp.intersect (set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set1) (set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set2)

-- | 'intersection' over a list of sets

intersections :: (FuzzySet set a l, Eq a) => [set] -> set
intersections :: forall set a l. (FuzzySet set a l, Eq a) => [set] -> set
intersections = (set -> set -> set) -> set -> [set] -> set
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr set -> set -> set
forall set a l. FuzzySet set a l => set -> set -> set
intersection set
forall set a l. FuzzySet set a l => set
mkEmptySet

{- | Complement of a fuzzy set A'

==== __Examples__

>>> let set1 = fromPairs [(1, 0.2), (2, 0.7)] :: LSet Int UILukasiewicz
>>> toPairs $ complement set1
[(1, 0.8),(2, 0.3)]

>>> let set2 = fromPairs [(1, 1), (2, 1)]
>>> toPairs $ complement set2
[(1, 0), (2, 0)]
-}
complement :: (FuzzySet set a l) => set -> set
complement :: forall set a l. FuzzySet set a l => set -> set
complement set
set = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet (l -> l
forall l. ResiduatedLattice l => l -> l
negation (l -> l) -> (a -> l) -> a -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> l
f)  (set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set)
    where f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set


{- | Apply a t-norm operation over two fuzzy sets. Both sets should be defined on the same 'universe'.

==== __Examples__

>>> let set1 = fromPairs [(1, 0.2), (2, 0.7)] :: LSet Int UILukasiewicz
>>> let set2 = fromPairs [(1, 0.3), (2, 0.4)] :: LSet Int UILukasiewicz
>>> toPairs $ setTnorm set1 set2
[(1,0.2), (2,0.4)]
-}
setTnorm :: (FuzzySet set a l) => set -> set -> set
setTnorm :: forall set a l. FuzzySet set a l => set -> set -> set
setTnorm set
set1 set
set2 = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet (\a
x -> a -> l
f a
x l -> l -> l
forall l. ResiduatedLattice l => l -> l -> l
`tnorm` a -> l
g a
x) [a]
u
    where f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set1
          g :: a -> l
g = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set2
          u :: [a]
u = set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set1


{- | Apply a residuum operation over two fuzzy sets. Both sets should be defined on the same 'universe'.

==== __Examples__

>>> let set1 = fromPairs [(1, 0.2), (2, 0.7)] :: LSet Int UILukasiewicz
>>> let set2 = fromPairs [(1, 0.3), (2, 0.4)] :: LSet Int UILukasiewicz
>>> toPairs $ setResiduum set1 set2
[(1,1.0), (2,0.7)]
-} 
setResiduum :: (FuzzySet set a l) => set -> set -> set
setResiduum :: forall set a l. FuzzySet set a l => set -> set -> set
setResiduum set
set1 set
set2 = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet (\a
x -> a -> l
f a
x l -> l -> l
forall l. ResiduatedLattice l => l -> l -> l
--> a -> l
g a
x) [a]
u
    where f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set1
          g :: a -> l
g = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set2
          u :: [a]
u = set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set1


{- | Modify the membership function of a fuzzy set by applying another function to its elements

==== __Examples__

>>> let set = fromPairs [(1, 0.2), (2, 0.7)] :: LSet Int UILukasiewicz
>>> let modifiedSet = mapMembership set (\x -> x + 1)
>>> toPairs modifiedSet
[(1,0.0),(2,0.0),(3,0.2)]
-}
mapMembership :: (FuzzySet set a l) => set -> (a -> a) -> set
mapMembership :: forall set a l. FuzzySet set a l => set -> (a -> a) -> set
mapMembership set
set a -> a
g = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet (a -> l
f (a -> l) -> (a -> a) -> a -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
g) [a]
u
    where 
        u :: [a]
u = set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set
        f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set


{- | Filter values of a fuzzy set based on a predicate

==== __Examples__

>>> let set = fromPairs [(1, 0.2), (2, 0.7), (3, 0.4)] :: LSet Int UILukasiewicz
>>> let filteredSet = filterMembership set (\x -> x > 1)
>>> toPairs filteredSet
[(1,0.0),(2,0.7),(3,0.4)]
-}
filterMembership :: (FuzzySet set a l) => set -> (a -> Bool) -> set
filterMembership :: forall set a l. FuzzySet set a l => set -> (a -> Bool) -> set
filterMembership set
set a -> Bool
pred =  (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet a -> l
h [a]
u
    where 
        h :: a -> l
h a
x = if a -> Bool
pred a
x then a -> l
f a
x else l
forall l. BoundedLattice l => l
bot
        f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set
        u :: [a]
u = set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set


{- | Modify the universe of a fuzzy set by applying a function to its elements

==== __Examples__

>>> let set = fromPairs [(1, 0.2), (2, 0.7)] :: LSet Int UILukasiewicz
>>> let modifiedSet = mapU set (\x -> x * 2)
>>> toPairs modifiedSet
[(2,0.2),(4,0.7)]
-}
mapU :: (FuzzySet set a l) => set -> (a -> a) -> set
mapU :: forall set a l. FuzzySet set a l => set -> (a -> a) -> set
mapU set
set a -> a
g = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet a -> l
f [a]
u
    where 
        f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set
        u :: [a]
u = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
g (set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set)


{- | Filter the universe of a fuzzy set based on a predicate

==== __Examples__

>>> let set = fromPairs [(1, 0.2), (2, 0.7), (3, 0.4)] :: LSet Int UILukasiewicz
>>> let filteredSet = filterU set (\x -> x > 1)
>>> toPairs filteredSet
[(2,0.7),(3,0.4)]
-}
filterU :: (FuzzySet set a l) => set -> (a -> Bool) -> set
filterU :: forall set a l. FuzzySet set a l => set -> (a -> Bool) -> set
filterU set
set a -> Bool
pred = (a -> l) -> [a] -> set
forall set a l. FuzzySet set a l => (a -> l) -> [a] -> set
mkFuzzySet a -> l
f [a]
u
    where 
        f :: a -> l
f = set -> a -> l
forall set a l. FuzzySet set a l => set -> a -> l
member set
set
        u :: [a]
u = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
pred (set -> [a]
forall set a l. FuzzySet set a l => set -> [a]
universe set
set)