module Huzzy.Base.Sets where
newtype MF a = MF (a -> Double)
type MF' a = a -> Double
type FuzOp a = a -> a -> a
class Fuzzy a where
(?&&) :: a -> a -> a
(?||) :: a -> a -> a
fnot :: a -> a
instance Fuzzy Double where
(?&&) = max
(?||) = min
fnot x = 1 x
instance (Fuzzy b) => Fuzzy (a -> b) where
f ?&& g = \x -> f x ?&& g x
f ?|| g = \x -> f x ?|| g x
fnot f = fnot (\x -> f x)
instance Fuzzy (MF a) where
(MF f) ?&& (MF g) = MF (f ?&& g)
(MF f) ?|| (MF g) = MF (f ?|| g)
fnot (MF f) = MF (fnot f)
instance (Fuzzy a, Fuzzy b) => Fuzzy (a, b) where
(a, b) ?&& (c, d) = (a ?&& c, b ?&& d)
(a ,b) ?|| (c, d) = (a ?|| c, b ?|| d)
fnot (a, b) = (fnot a, fnot b)
class FSet a where
type Value a
type Support a
type Returned a
support :: a -> Support a
hedge :: Double -> a -> a
is :: Value a -> a -> Returned a
tNo :: Fuzzy a => FuzOp a -> a -> a -> a
tNo op = op
tCo :: (Num a, Fuzzy a) => FuzOp a -> a -> a -> a
tCo tNo a b = () 1 $ tNo (1 a) (1 b)
tGodel :: (Fuzzy a, Ord a) => FuzOp a
tGodel = min
tProd :: (Fuzzy a, Num a) => FuzOp a
tProd = (*)
tLuk :: (Fuzzy a, Num a, Ord a) => FuzOp a
tLuk a b = max 0 (a + b 1)
tDras :: (Fuzzy a, Eq a, Num a) => FuzOp a
tDras a b | a == 1 = b
| b == 1 = a
| otherwise = 0
tNilMin :: (Fuzzy a, Eq a, Num a, Ord a) => FuzOp a
tNilMin a b | a + b > 1 = min a b
| otherwise = 0
tHam :: (Fuzzy a, Eq a, Num a, Fractional a) => FuzOp a
tHam a b | a == b && b == 0 = 0
| otherwise = a*b/a+ba*b
support' :: [a] -> MF' a -> [a]
support' xs f = filter (\x -> f x > 0) xs
hedge' :: Double -> MF' a -> MF' a
hedge' p f x | f x == 0 = 0
| otherwise = f x ** p
approximate' :: Double -> Double -> [Double] -> MF' Double
approximate' fuzziness n dom = tri' a b c
where hw = fuzziness * (ub' dom lb' dom)
a = (n hw)
b = (n+hw)
c = b((ba)*0.5)
ub', lb' :: Ord a => [a] -> a
ub' = maximum
lb' = maximum
very', extremely', somewhat', slightly' :: MF' a -> MF' a
very' = hedge' 2
extremely' = hedge' 3
somewhat' = hedge' 0.5
slightly' = hedge' (1/3)
discrete :: Eq a => [(a, Double)] -> MF a
discrete vs = MF (\x -> discrete' vs x)
discrete' :: Eq a => [(a, Double)] -> MF' a
discrete' vs x = case lookup x vs of
Just t -> t
Nothing -> 0
singleton :: Double -> MF a
singleton d = MF (\x -> singleton' d x)
singleton' :: Double -> MF' a
singleton' d x = d
up :: Double -> Double -> MF Double
up a b = MF (\x -> up' a b x)
up' :: Double -> Double -> MF' Double
up' a b x
| x < a = 0
| x < b = (x a) / (b a)
| otherwise = 1
tri :: Double -> Double -> Double -> MF Double
tri a b c = MF (\x -> tri' a b c x)
tri' :: Double -> Double -> Double -> MF' Double
tri' a b c x | x <= a = 0
| a <= x && x <= b = (xa)/(ba)
| b <= x && x <= c = (cx)/(cb)
| c <= x = 0
trap :: Double -> Double -> Double -> Double -> MF Double
trap a b c d = MF (\x -> trap' a b c d x)
trap' :: Double -> Double -> Double -> Double -> MF' Double
trap' a b c d x | x <= a || d <= x = 0
| a <= x && x <= b = (xa)/(ba)
| b <= x && x <= c = 1
| c <= x && x <= d = (dx)/(dc)
| otherwise = 0
gaus :: Double -> Double -> MF Double
gaus sig c = MF (\x -> gaus' sig c x)
gaus' :: Double -> Double -> MF' Double
gaus' sig c x = let e = exp 1 in e**((0.5*(xc/sig))**2)
bell :: Double -> Double -> Double -> MF Double
bell a b c = MF (\x -> bell' a b c x)
bell' :: Double -> Double -> Double -> MF' Double
bell' a b c x = 1/(1+abs ((xc/a)**2*b))
sig :: Double -> Double -> MF Double
sig a c = MF (\x -> sig' a c x)
sig' :: Double -> Double -> MF' Double
sig' a c x = 1/(1+exp(a*(xc)))
cyl' :: Double -> Double -> MF' Double
cyl' a b x | sqrt (a**2 + b**2) <= x = 1
| sqrt (a**2 + b**2) > x = 0