diff --git a/huzzy.cabal b/huzzy.cabal --- a/huzzy.cabal +++ b/huzzy.cabal @@ -2,8 +2,8 @@ -- see http://haskell.org/cabal/users-guide/ name: huzzy -version: 0.1.0.0 -synopsis: Fuzzy logic library with support for Type-1, Interval type-2 and zSlices enabled type-2 fuzzy sets and systems. +version: 0.1.5.0 +synopsis: Fuzzy logic library with support for T1, IT2, GT2. description: Library for creating fuzzy sets and systems. There are known issues with overly precise values in Type-2 sets. diff --git a/src/Huzzy/Base/Sets.hs b/src/Huzzy/Base/Sets.hs --- a/src/Huzzy/Base/Sets.hs +++ b/src/Huzzy/Base/Sets.hs @@ -1,20 +1,57 @@ -module Huzzy.Base.Sets where +module Huzzy.Base.Sets +( MF(..) +, Fuzzy(..) +, FSet(..) +, tCo +, tGodel +, tProd +, tLuk +, tDras +, tNilMin +, tHam +, discrete +, singleton +, tri +, trap +, bell +, gaus +, up +, down +, sig +) where +-- | Type representing type-1 membership functions. newtype MF a = MF (a -> Double) +-- | Used internally to represent type-1 membership functions. +-- Not exported for safety reasons. +-- Library users, use the newtype. type MF' a = a -> Double +-- | FuzOp is used to denote functions expecting operators on fuzzy sets. type FuzOp a = a -> a -> a +-- | Standard operations on fuzzy sets. +-- Instantiated for each kind of fuzzy set. +-- If you want to overload with a t-norm, instantiate against a newtype or instantiated set. class Fuzzy a where + -- | Union over fuzzy values. (?&&) :: a -> a -> a + -- | Intersection over fuzzy values. (?||) :: a -> a -> a + -- | Fuzzy complement. fnot :: a -> a +-- | Standard definitions for operations as defined by Zadeh (1965) instance Fuzzy Double where + -- | Equivalent to use of the Godel t-conorm, + -- > (?&&) = tCo tGodel (?&&) = max + -- | Equivalent to use of the Godel t-norm, + -- > (?||) = tGodel (?||) = min fnot x = 1 - x +-- | Fuzzy operators for membership functions. instance (Fuzzy b) => Fuzzy (a -> b) where f ?&& g = \x -> f x ?&& g x f ?|| g = \x -> f x ?|| g x @@ -25,19 +62,29 @@ (MF f) ?|| (MF g) = MF (f ?|| g) fnot (MF f) = MF (fnot f) +-- | Instance for tuple needed for interval type-2 fuzzy sets. 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) +-- | Specifically for fuzzy sets, as opposed to fuzzy values. +-- Support is all elements of domain for which membership is non-zero. +-- Hedge is a modifier of fuzzy sets. +-- `is` is for application of a value to a fuzzy set. class FSet a where + -- | A single value of the domain. type Value a + -- | A list of values from the domain for which membership is non-zero. type Support a + -- | Degree of membership from applying a value to membership function. type Returned a support :: a -> Support a hedge :: Double -> a -> a is :: Value a -> a -> Returned a -{- + +{- Old functional dependency definition, remains for +report purposes. class FSet a b c d | a -> b, a -> c, a -> d where support :: a -> [c] hedge :: Double -> a -> a @@ -47,9 +94,11 @@ tNo :: Fuzzy a => FuzOp a -> a -> a -> a tNo op = op +-- | Produces the dual t-conorm from a t-norm tCo :: (Num a, Fuzzy a) => FuzOp a -> a -> a -> a tCo tNo a b = (-) 1 $ tNo (1 - a) (1 - b) +-- | Standard t-norm used for intersection. tGodel :: (Fuzzy a, Ord a) => FuzOp a tGodel = min @@ -79,23 +128,14 @@ 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-((b-a)*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) +-- | Ensure that input list is correctly ordered for desired performance. +-- I.e. if desired property is that for a u with 2 values of z, max is chosen, order descending on right value of tuple. discrete :: Eq a => [(a, Double)] -> MF a discrete vs = MF (\x -> discrete' vs x) @@ -104,6 +144,7 @@ Just t -> t Nothing -> 0 +-- | Used for type-2 defuzzification. singleton :: Double -> MF a singleton d = MF (\x -> singleton' d x) @@ -119,6 +160,15 @@ | x < b = (x - a) / (b - a) | otherwise = 1 +down :: Double -> Double -> MF Double +down a b = MF (\x -> down' a b x) + +down' :: Double -> Double -> MF' Double +down' a b x + | x < a = 1.0 + | x < b = (x-b)/(a-b) + | otherwise = 0.0 + tri :: Double -> Double -> Double -> MF Double tri a b c = MF (\x -> tri' a b c x) @@ -155,9 +205,3 @@ sig' :: Double -> Double -> MF' Double sig' a c x = 1/(1+exp(-a*(x-c))) - --- Probably shit - -cyl' :: Double -> Double -> MF' Double -cyl' a b x | sqrt (a**2 + b**2) <= x = 1 - | sqrt (a**2 + b**2) > x = 0 diff --git a/src/Huzzy/Base/Systems.hs b/src/Huzzy/Base/Systems.hs --- a/src/Huzzy/Base/Systems.hs +++ b/src/Huzzy/Base/Systems.hs @@ -1,13 +1,19 @@ -module Huzzy.Base.Systems where +module Huzzy.Base.Systems +( FRule(..) +, Defuzzifier(..) +) where import Huzzy.Base.Sets -newtype FRule a => RuleBase a = RB [a] - +-- | Allows overloading of functions used in rule definition. class Fuzzy a => FRule a where + -- | Firing strength type Antecedent a + -- | Scaling implication. (=*>) :: Antecedent a -> a -> a + -- | Truncate implication. (=|>) :: Antecedent a -> a -> a + -- | Weight a rule weight :: a -> Double -> a instance FRule Double where @@ -28,10 +34,8 @@ (=|>) a (MF f) = MF (\x -> a =|> f x) weight (MF f) b = MF (\x -> f x `weight` b) +-- | Overloaded defuzzification functions. class FRule a => Defuzzifier a where type Result a centroid :: a -> Result a - -aggregate :: FRule a => RuleBase a -> (a -> a -> a) -> a -aggregate (RB rules) agg = foldr1 agg rules diff --git a/src/Huzzy/TypeOne/Sets.hs b/src/Huzzy/TypeOne/Sets.hs --- a/src/Huzzy/TypeOne/Sets.hs +++ b/src/Huzzy/TypeOne/Sets.hs @@ -1,21 +1,38 @@ -module Huzzy.TypeOne.Sets where +module Huzzy.TypeOne.Sets +( T1Set(mf, dom) +, Fuzzy(..) +, FSet(..) +, contT1 +, discT1 +, unsafeMkT1 +, alpha +, findCuts +)where import Data.List(sortBy, nub, elemIndex) import Data.Maybe(fromJust) import Huzzy.Base.Sets + +-- | Type-1 fuzzy sets, with associated membership function and domain. Use smart constructors to create. data T1Set a = T1S { mf :: MF a , dom :: [a] } +-- | Fuzzy operators are supported on T1Sets. +-- Applies operator to membership functions inside T1Set type. instance Fuzzy (T1Set a) where a ?&& b = a { mf = (mf a) ?&& (mf b)} a ?|| b = a { mf = (mf a) ?|| (mf b)} fnot a = a { mf = fnot (mf a)} +-- | Type-1 fuzzy sets are the most basic fuzzy set. instance FSet (T1Set a) where + -- | Single element of the domain. type Value (T1Set a) = a + -- | List of elements from the domain with non-zero membership. type Support (T1Set a) = [a] + -- | Type-1 membership functions return a double, hopefully in the range 0 to 1. type Returned (T1Set a) = Double support s = filter (\x -> (x `is` s) > 0) d where @@ -45,9 +62,7 @@ (MF f) = mf s -} --- Smart Constructors --- continuous :: a -> a -> a -> MF a -> T1Set a - +-- | Smart constructor for continuous membership functions. Warning, fine resolutions will make this a very slow construction. contT1 :: (Num a, Enum a) => a -> a -> a -> MF a -> T1Set a contT1 minB maxB res (MF mf) = case check of True -> error "Truth values must be in the range [0..1]" @@ -58,6 +73,7 @@ domain = [minB, minB+res .. maxB] check = any (\x -> x > 1 || x < 0) (map mf domain) +-- | Smart constructor for discrete continuous membership functions. Avoid large domains. discT1 :: [a] -> MF a -> T1Set a discT1 dom (MF mf) = case check of True -> error "Truth values must be in the range [0..1]" @@ -67,24 +83,19 @@ where check = any (\x -> x > 1 || x < 0) (map mf dom) -trustedCont :: (Num a, Enum a) => a -> a -> a -> MF a -> T1Set a -trustedCont minB maxB res mf = T1S { mf = mf - , dom = [minB, minB+res .. maxB] - } - -trustedDisc :: [a] -> MF a -> T1Set a -trustedDisc dom mf = T1S { mf = mf - , dom = dom - } - +-- | Only use this if you're sure your membership functions are safe, or your domain is huge. unsafeMkT1 :: [a] -> MF a -> T1Set a -unsafeMkT1 = trustedDisc +unsafeMkT1 dom mf = T1S { mf = mf + , dom = dom + } +-- | Cuts a type-1 fuzzy set at a given degree of membership. alpha :: Double -> T1Set a -> [a] alpha d s = filter (\x -> f x >= d) (dom s) where (MF f) = mf s +-- | Performs a cut and then finds the x values on the curve at point of cut. findCuts :: Ord a => T1Set a -> Double -> (a, a) findCuts s d = (l, r) where diff --git a/src/Huzzy/TypeOne/Systems.hs b/src/Huzzy/TypeOne/Systems.hs --- a/src/Huzzy/TypeOne/Systems.hs +++ b/src/Huzzy/TypeOne/Systems.hs @@ -1,10 +1,15 @@ -module Huzzy.TypeOne.Systems where +module Huzzy.TypeOne.Systems +( FRule(..) +, Defuzzifier(..) +) where import Huzzy.Base.Sets import Huzzy.Base.Systems import Huzzy.TypeOne.Sets +-- | Simple type-1 fuzzy rule systems. instance FRule (T1Set a) where + -- | Firing strength of Type-1 rules is just membership grade. type Antecedent (T1Set a) = Double (=*>) a t1s = t1s { mf = a =*> (mf t1s)} (=|>) a t1s = t1s { mf = a =|> (mf t1s)} @@ -12,6 +17,8 @@ instance Defuzzifier (T1Set Double) where type Result (T1Set Double) = Double + -- | Centroid can be a computationally costly operation. + -- Reducing resolution of the domain can reduce costs. centroid t1s = sum (zipWith (*) dom' fdom) / sum fdom where dom' = dom t1s diff --git a/src/Huzzy/TypeTwo/Interval/Sets.hs b/src/Huzzy/TypeTwo/Interval/Sets.hs --- a/src/Huzzy/TypeTwo/Interval/Sets.hs +++ b/src/Huzzy/TypeTwo/Interval/Sets.hs @@ -1,21 +1,38 @@ -module Huzzy.TypeTwo.Interval.Sets where +module Huzzy.TypeTwo.Interval.Sets +( IT2Set(lmf, umf, idom) +, Fuzzy(..) +, FSet(..) +, contIT2 +, discIT2 +, unsafeMkIT2 +, cylExt +)where import Huzzy.Base.Sets import Huzzy.TypeOne.Sets +-- | Interval Type-2 Fuzzy sets. +-- Defined entirely by the footprint of uncertainty, +-- lmf and umf are the bounds of this area. data IT2Set a = IT2S { lmf :: MF a , umf :: MF a , idom :: [a] } +-- | Interval Type-2 fuzzy sets allow us to work in type-1 concepts. +-- Operators are defined through application to lower and upper membership functions. instance Fuzzy (IT2Set a) where a ?&& b = a { lmf = lmf a ?&& lmf b, umf = umf a ?&& umf b} a ?|| b = a { lmf = lmf a ?|| lmf b, umf = umf a ?|| umf b} fnot a = a { lmf = fnot (lmf a), umf = fnot (umf a)} +-- | Enables use of support, hedge and `is` on interval type-2 fuzzy sets. instance FSet (IT2Set a) where + -- | Single value from the domain. type Value (IT2Set a) = a + -- | List of pairs with non-zero membership to lmf and umf. type Support (IT2Set a) = [(a,a)] + -- | Applying a value to an interval set gives an interval membership value. type Returned (IT2Set a) = (Double, Double) support s = filter (\(x,y) -> (fst $ xis x) > 0 || (snd $ xis y) > 0) d where @@ -60,6 +77,7 @@ (MF u) = umf s -} +-- | Smart constructor for continuos interval type-2 membership functions. Watch that resolution! contIT2 :: (Num a, Enum a) => a -> a -> a -> MF a -> MF a -> IT2Set a contIT2 minB maxB res (MF lmf) (MF umf) = case check of True -> error "Truth values must be in the range [0..1]" @@ -74,7 +92,7 @@ check = any (\x -> x > 1 || x < 0) (map lmf domain) check' = any (\x -> x > 1 || x < 0) (map umf domain) - +-- | Smart constructor for discrete interval type-2 membership functions. Be wary of domain size. discIT2 :: [a] -> MF a -> MF a -> IT2Set a discIT2 dom (MF lmf) (MF umf) = case check of True -> error "Truth values must be in the range [0..1]" @@ -88,10 +106,12 @@ check = any (\x -> x > 1 || x < 0) (map lmf dom) check' = any (\x -> x > 1 || x < 0) (map umf dom) +-- | Only use this if you trust your functions or have no other recourse. unsafeMkIT2 :: [a] -> MF a -> MF a -> IT2Set a unsafeMkIT2 dom lmf umf = IT2S { lmf = lmf , umf = umf , idom = dom } +-- | Used in zSlices type-2 defuzzification cylExt :: Double -> Double -> IT2Set a cylExt l u = unsafeMkIT2 [] (singleton l) (singleton u) diff --git a/src/Huzzy/TypeTwo/Interval/Systems.hs b/src/Huzzy/TypeTwo/Interval/Systems.hs --- a/src/Huzzy/TypeTwo/Interval/Systems.hs +++ b/src/Huzzy/TypeTwo/Interval/Systems.hs @@ -1,4 +1,8 @@ -module Huzzy.TypeTwo.Interval.Systems where +module Huzzy.TypeTwo.Interval.Systems +( FRule(..) +, Defuzzifier(..) +, km +) where import Data.List import Huzzy.Base.Sets @@ -6,6 +10,7 @@ import Huzzy.TypeTwo.Interval.Sets instance FRule (IT2Set a) where + -- | Firing strength is membership grade of both lmf and umf. type Antecedent (IT2Set a) = (Double, Double) (=*>) (a,b) it2 = it2 { lmf = a =*> (lmf it2) , umf = b =*> (umf it2) @@ -24,12 +29,8 @@ (yl, yr, _, _) = km its -{- - -Karnik mendel haskell -todo dirty hack fix --} - +-- | Karnik-Mendel algorithm. +-- Currently needs a big overhaul. km :: IT2Set Double -> ( Double -- yl , Double -- yr , Int -- k l diff --git a/src/Huzzy/TypeTwo/ZSlices/Sets.hs b/src/Huzzy/TypeTwo/ZSlices/Sets.hs --- a/src/Huzzy/TypeTwo/ZSlices/Sets.hs +++ b/src/Huzzy/TypeTwo/ZSlices/Sets.hs @@ -1,24 +1,39 @@ -module Huzzy.TypeTwo.ZSlices.Sets where +module Huzzy.TypeTwo.ZSlices.Sets +( T2ZSet(zLevels, zSlices, zdom) +, Fuzzy(..) +, FSet(..) +, contZT2 +, discZT2 +, unsafeZT2 +, cylExtT2 +, mkT2Tri +, zLevelAxis +)where -import Data.Function -import Data.List +import Data.Function(on) +import Data.List(sortBy) import Huzzy.Base.Sets import Huzzy.TypeOne.Sets import Huzzy.TypeTwo.Interval.Sets +-- | A zSlices based type-2 set requires the number of z levels, and a list of zslices. data T2ZSet a = T2ZS { zLevels :: Int , zSlices :: [IT2Set a] , zdom :: [a] } - +-- | Operations on zSlices fuzzy sets are simply defined as higher order funcitons over the list of zSlices. instance Fuzzy (T2ZSet a) where a ?&& b = a { zLevels = zLevels a, zSlices = zipWith (?&&) (zSlices a) (zSlices b) } a ?|| b = a { zLevels = zLevels a, zSlices = zipWith (?||) (zSlices a) (zSlices b) } fnot a = a { zLevels = zLevels a, zSlices = map (fnot) (zSlices a) } +-- | Currently the most complex supported fuzzy set. instance FSet (T2ZSet a) where + -- | Single value of the domain. type Value (T2ZSet a) = a + -- | Supprt in zSlices only works on the base interval set. type Support (T2ZSet a) = [(a,a)] + -- | Type-2 membership functions return a vertical slice, a type-1 membership function. type Returned (T2ZSet a) = MF Double support s = support (head $ zSlices s) hedge d s = s { zSlices = map (hedge d) (zSlices s)} @@ -27,7 +42,7 @@ its = zSlices s (ls, us) = unzip $ map (x`is`) its zs = zLevelAxis (length its) - -- todo dirty hack to ensure max is returned + -- | Order the list to ensure maximum z value is returned in case of multiple z values existing for a given u. disPairs = sortBy (flip compare `on` snd ) $ zip ls zs ++ zip us zs @@ -39,6 +54,9 @@ count s 0 = [s*n'] count s z = (s*(n'-z)) : count s (z-1) + +-- | Smart constructor for continuous type-2 fuzzy membership functions. +-- Works only on the base interval set, make sure you trust your zSlices. contZT2 :: (Enum a, Num a) => a -> a -> a -> [IT2Set a] -> T2ZSet a contZT2 minB maxB res its = case check of True -> error "Truth values must be in the range [0..1]" @@ -54,6 +72,8 @@ check = any (\x -> x > 1 || x < 0) (map lf domain) check' = any (\x -> x > 1 || x < 0) (map uf domain) +-- | Smart constructor for discrete type-2 fuzzy membership functions. +-- Works only on the base interval set, make sure you trust your zSlices. discZT2 :: [a] -> [IT2Set a] -> T2ZSet a discZT2 dom its = case check of True -> error "Truth values must be in the range [0..1]" @@ -68,12 +88,14 @@ check = any (\x -> x > 1 || x < 0) (map lf dom) check' = any (\x -> x > 1 || x < 0) (map uf dom) +-- | Unsafe constructor, only use if you trust your membership functions or domain is very large. unsafeZT2 :: [a] -> [IT2Set a] -> T2ZSet a unsafeZT2 dom its = T2ZS { zLevels = length its , zSlices = its , zdom = dom } +-- | Used in defuzzification. cylExtT2 :: T1Set Double -> Int -> T2ZSet Double cylExtT2 s z = T2ZS { zLevels = z , zSlices = map (\(l, r) -> cylExt l r) lsrs @@ -83,13 +105,19 @@ zs = zLevelAxis z lsrs = map (findCuts s) zs -t2Tri :: (Double, Double) -> - (Double, Double) -> - (Double, Double) -> - Int -> T2ZSet Double -t2Tri (a,a') (b,b') (c,c') z = T2ZS { zLevels = z - , zSlices = base : rc (z-1) stepA stepC - , zdom = dom } +-- | Constructor for triangular type-2 fuzzy set. +-- Arguements are pairs of points for defining a base Interval type-2 fuzzy set. +-- The left element of each pair is for the lower membership function, +-- The right element is for the upper membership function, +-- Order is: left corner, peak, right corner. +-- Int is number of zSlices desired, the level of discretisation. +mkT2Tri :: (Double, Double) -> + (Double, Double) -> + (Double, Double) -> + Int -> T2ZSet Double +mkT2Tri (a,a') (b,b') (c,c') z = T2ZS { zLevels = z + , zSlices = base : rc (z-1) stepA stepC + , zdom = dom } where dom = [min a a' .. max c c'] base = unsafeMkIT2 dom (tri a b c) (tri a' b' c') diff --git a/src/Huzzy/TypeTwo/ZSlices/Systems.hs b/src/Huzzy/TypeTwo/ZSlices/Systems.hs --- a/src/Huzzy/TypeTwo/ZSlices/Systems.hs +++ b/src/Huzzy/TypeTwo/ZSlices/Systems.hs @@ -1,4 +1,7 @@ -module Huzzy.TypeTwo.ZSlices.Systems where +module Huzzy.TypeTwo.ZSlices.Systems +( FRule(..) +, Defuzzifier(..) +) where import Data.Function(on) import Data.List(sortBy, nub) @@ -10,7 +13,7 @@ import Huzzy.TypeTwo.Interval.Systems import Huzzy.TypeTwo.ZSlices.Sets - +-- | In zSlices type-2 fuzzy sets, both implicators are the same. instance FRule (T2ZSet Double) where type Antecedent (T2ZSet Double) = T1Set Double (=*>) t1 t2 = (cylExtT2 t1 (zLevels t2)) ?|| t2