huzzy (empty) → 0.1.0.0
raw patch · 11 files changed
+732/−0 lines, 11 filesdep +basedep +easyplotsetup-changed
Dependencies added: base, easyplot
Files
- Setup.hs +2/−0
- huzzy.cabal +63/−0
- src/Huzzy/Analysis/Graph.hs +10/−0
- src/Huzzy/Base/Sets.hs +163/−0
- src/Huzzy/Base/Systems.hs +37/−0
- src/Huzzy/TypeOne/Sets.hs +94/−0
- src/Huzzy/TypeOne/Systems.hs +19/−0
- src/Huzzy/TypeTwo/Interval/Sets.hs +97/−0
- src/Huzzy/TypeTwo/Interval/Systems.hs +115/−0
- src/Huzzy/TypeTwo/ZSlices/Sets.hs +103/−0
- src/Huzzy/TypeTwo/ZSlices/Systems.hs +29/−0
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ huzzy.cabal view
@@ -0,0 +1,63 @@+-- Initial huzzy.cabal generated by cabal init. For further documentation,+-- 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.+description:+ Library for creating fuzzy sets and systems.+ There are known issues with overly precise values in Type-2 sets.+ Incredibly alpha, please do not use this for controlling your shower.++ Huge thanks to Emilio Gallego for his work on ffuzz: http://www.cis.upenn.edu/~emilioga/software/ffuzz/.+ Heavily inspired by http://journals.cambridge.org/action/displayAbstract?fromPage=online&aid=44203+++license: MIT+-- license-file: LICENSE+author: Joe Nash+maintainer: joe@jna.sh+-- copyright:+-- category:+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ exposed-modules: Huzzy.Base.Sets,+ Huzzy.Base.Systems,+ Huzzy.TypeOne.Sets,+ Huzzy.TypeOne.Systems,+ Huzzy.TypeTwo.ZSlices.Sets,+ Huzzy.TypeTwo.ZSlices.Systems,+ Huzzy.TypeTwo.Interval.Sets,+ Huzzy.TypeTwo.Interval.Systems,+ Huzzy.Analysis.Graph++ --other-modules:+ -- other-extensions:+ build-depends: base >=4.7 && <4.8,+ easyplot++ hs-source-dirs: src+ default-language: Haskell2010+ default-extensions: FunctionalDependencies,+ MultiParamTypeClasses,+ FlexibleInstances,+ TypeFamilies+++--executable+-- hs-source-dirs: some-other-folderl++--test-suite tests+-- hs-source-dirs: test+-- main-is: test.hs+-- type: exitcode-stdio-1.0+-- build-depends: base >= 4.7 && < 4.8,+-- tasty,+-- tasty-quickcheck,+-- tasty-hunit,+-- huzzy++-- default-language: Haskell2010
+ src/Huzzy/Analysis/Graph.hs view
@@ -0,0 +1,10 @@+module Huzzy.Analysis.Graph where++import Graphics.EasyPlot+import Huzzy.Base.Sets+import Huzzy.TypeOne.Sets+import Huzzy.TypeTwo.Interval.Sets+import Huzzy.TypeTwo.ZSlices.Sets++--plotContT1 :: [a] -> T1Set a -> IO Bool+--plotContT1
+ src/Huzzy/Base/Sets.hs view
@@ -0,0 +1,163 @@+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+{-+class FSet a b c d | a -> b, a -> c, a -> d where+ support :: a -> [c]+ hedge :: Double -> a -> a+ is :: b -> a -> d+-}++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+b-a*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-((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)++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 = (x-a)/(b-a)+ | b <= x && x <= c = (c-x)/(c-b)+ | 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 = (x-a)/(b-a)+ | b <= x && x <= c = 1+ | c <= x && x <= d = (d-x)/(d-c)+ | 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*(x-c/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 ((x-c/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*(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
+ src/Huzzy/Base/Systems.hs view
@@ -0,0 +1,37 @@+module Huzzy.Base.Systems where++import Huzzy.Base.Sets++newtype FRule a => RuleBase a = RB [a]++class Fuzzy a => FRule a where+ type Antecedent a+ (=*>) :: Antecedent a -> a -> a+ (=|>) :: Antecedent a -> a -> a+ weight :: a -> Double -> a++instance FRule Double where+ type Antecedent Double = Double+ (=*>) a b = a * b+ (=|>) a b = a `min` b+ weight a b = a * b++instance FRule b => FRule (a -> b) where+ type Antecedent (a -> b) = Antecedent b+ (=*>) a b = \x -> a =*> b x+ (=|>) a b = \x -> a =|> b x+ weight a b = \x -> a x `weight` b++instance FRule (MF a) where+ type Antecedent (MF a) = Double+ (=*>) a (MF f) = MF (\x -> a =*> f x)+ (=|>) a (MF f) = MF (\x -> a =|> f x)+ weight (MF f) b = MF (\x -> f x `weight` b)++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
+ src/Huzzy/TypeOne/Sets.hs view
@@ -0,0 +1,94 @@+module Huzzy.TypeOne.Sets where++import Data.List(sortBy, nub, elemIndex)+import Data.Maybe(fromJust)+import Huzzy.Base.Sets++data T1Set a = T1S { mf :: MF a+ , dom :: [a]+ }++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)}++instance FSet (T1Set a) where+ type Value (T1Set a) = a+ type Support (T1Set a) = [a]+ type Returned (T1Set a) = Double+ support s = filter (\x -> (x `is` s) > 0) d+ where+ d = dom s++ hedge p s = s {mf = MF (\x -> mf' x)}+ where+ (MF f) = mf s+ mf' x | f x == 0 = 0+ | otherwise = f x ** p+ x `is` s = f x+ where+ (MF f) = mf s+{-+instance FSet (T1Set a) a a Double where+ support s = filter (\x -> (x `is` s) > 0) d+ where+ d = dom s++ hedge p s = s {mf = MF (\x -> mf' x)}+ where+ (MF f) = mf s+ mf' x | f x == 0 = 0+ | otherwise = f x ** p+ x `is` s = f x+ where+ (MF f) = mf s+-}++-- Smart Constructors+-- continuous :: a -> a -> a -> MF a -> T1Set a++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]"+ False -> T1S { mf = MF mf+ , dom = domain+ }+ where+ domain = [minB, minB+res .. maxB]+ check = any (\x -> x > 1 || x < 0) (map mf domain)++discT1 :: [a] -> MF a -> T1Set a+discT1 dom (MF mf) = case check of+ True -> error "Truth values must be in the range [0..1]"+ False -> T1S { mf = MF mf+ , dom = dom+ }+ 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+ }++unsafeMkT1 :: [a] -> MF a -> T1Set a+unsafeMkT1 = trustedDisc++alpha :: Double -> T1Set a -> [a]+alpha d s = filter (\x -> f x >= d) (dom s)+ where+ (MF f) = mf s++findCuts :: Ord a => T1Set a -> Double -> (a, a)+findCuts s d = (l, r)+ where+ as = alpha d s+ l = maximum as+ li = fromJust $ elemIndex l as+ r = maximum (snd $ splitAt li as)
+ src/Huzzy/TypeOne/Systems.hs view
@@ -0,0 +1,19 @@+module Huzzy.TypeOne.Systems where++import Huzzy.Base.Sets+import Huzzy.Base.Systems+import Huzzy.TypeOne.Sets++instance FRule (T1Set a) where+ type Antecedent (T1Set a) = Double+ (=*>) a t1s = t1s { mf = a =*> (mf t1s)}+ (=|>) a t1s = t1s { mf = a =|> (mf t1s)}+ weight t1s b = t1s {mf = (mf t1s) `weight` b}++instance Defuzzifier (T1Set Double) where+ type Result (T1Set Double) = Double+ centroid t1s = sum (zipWith (*) dom' fdom) / sum fdom+ where+ dom' = dom t1s+ (MF f) = mf t1s+ fdom = map f dom'
+ src/Huzzy/TypeTwo/Interval/Sets.hs view
@@ -0,0 +1,97 @@+module Huzzy.TypeTwo.Interval.Sets where++import Huzzy.Base.Sets+import Huzzy.TypeOne.Sets++data IT2Set a = IT2S { lmf :: MF a+ , umf :: MF a+ , idom :: [a]+ }++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)}++instance FSet (IT2Set a) where+ type Value (IT2Set a) = a+ type Support (IT2Set a) = [(a,a)]+ type Returned (IT2Set a) = (Double, Double)+ support s = filter (\(x,y) -> (fst $ xis x) > 0 || (snd $ xis y) > 0) d+ where+ xis = \x -> x `is` s+ d = zip (idom s) (idom s)++ hedge p s = s { lmf = MF (\x -> lmf' x)+ , umf = MF (\x -> umf' x)+ }+ where+ (MF l) = lmf s+ (MF u) = umf s+ lmf' x | l x == 0 = 0+ | otherwise = l x ** p+ umf' x | u x == 0 = 0+ | otherwise = u x ** p+ x `is` s = (l x, u x)+ where+ (MF l) = lmf s+ (MF u) = umf s++{-+instance FSet (IT2Set a) a (a,a) (Double, Double) where+ support s = filter (\(x,y) -> (fst $ xis x) > 0 || (snd $ xis y) > 0) d+ where+ xis = \x -> x `is` s+ d = zip (idom s) (idom s)++ hedge p s = s { lmf = MF (\x -> lmf' x)+ , umf = MF (\x -> umf' x)+ }+ where+ (MF l) = lmf s+ (MF u) = umf s+ lmf' x | l x == 0 = 0+ | otherwise = l x ** p+ umf' x | u x == 0 = 0+ | otherwise = u x ** p+ x `is` s = (l x, u x)+ where+ (MF l) = lmf s+ (MF u) = umf s+-}++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]"+ False -> case check' of+ True -> error "Truth values must be in the range [0..1]"+ False -> IT2S { lmf = MF lmf+ , umf = MF umf+ , idom = domain+ }+ where+ domain = [minB, minB+res .. maxB]+ check = any (\x -> x > 1 || x < 0) (map lmf domain)+ check' = any (\x -> x > 1 || x < 0) (map umf domain)+++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]"+ False -> case check' of+ True -> error "Truth values must be in the range [0..1]"+ False -> IT2S { lmf = MF lmf+ , umf = MF umf+ , idom = dom+ }+ where+ check = any (\x -> x > 1 || x < 0) (map lmf dom)+ check' = any (\x -> x > 1 || x < 0) (map umf dom)++unsafeMkIT2 :: [a] -> MF a -> MF a -> IT2Set a+unsafeMkIT2 dom lmf umf = IT2S { lmf = lmf+ , umf = umf+ , idom = dom }++cylExt :: Double -> Double -> IT2Set a+cylExt l u = unsafeMkIT2 [] (singleton l) (singleton u)
+ src/Huzzy/TypeTwo/Interval/Systems.hs view
@@ -0,0 +1,115 @@+module Huzzy.TypeTwo.Interval.Systems where++import Data.List+import Huzzy.Base.Sets+import Huzzy.Base.Systems+import Huzzy.TypeTwo.Interval.Sets++instance FRule (IT2Set a) where+ type Antecedent (IT2Set a) = (Double, Double)+ (=*>) (a,b) it2 = it2 { lmf = a =*> (lmf it2)+ , umf = b =*> (umf it2)+ }+ (=|>) (a,b) it2 = it2 { lmf = a =|> (lmf it2)+ , umf = b =|> (umf it2)+ }+ weight it2 b = it2 { lmf = (lmf it2) `weight` b+ , umf = (umf it2) `weight` b+ }++instance Defuzzifier (IT2Set Double) where+ type Result (IT2Set Double) = (Double, Double)+ centroid its = (yl, yr)+ where+ (yl, yr, _, _) = km its+++{-++Karnik mendel haskell+todo dirty hack fix+-}++km :: IT2Set Double -> ( Double -- yl+ , Double -- yr+ , Int -- k l+ , Int -- k r+ )+km its = case findK 0 yI xs of+ Nothing -> error "No k 1"+ Just k -> revCompCheck yI k+ where+ lrsup = unzip $ support its+ xs = getXS lrsup+ (wsl, wsu) = getWS its xs+ weightsI = getWeights (wsl, wsu)+ yI = weightedSum xs weightsI+ doLeft k' yi' = case findK k' yi' xs of+ Nothing -> error ("No k 2, k:" ++ show k' ++ " yi:" ++ show yi' )+ Just k -> revCompCheck yi' k'+ revCompCheck yi'' k' = case y' == yi'' of+ True -> (y', yr, k', kr)+ where+ (yr, kr) = kmr its+ False -> doLeft 0 y'+ where+ ws = lWeights wsl wsu k'+ y' = weightedSum xs ws++kmr :: IT2Set Double -> ( Double -- yr+ , Int -- k r+ )+kmr its = case findK 0 yI xs of+ Nothing -> error "no k 3"+ Just k -> revCompCheck yI k+ where+ lrsup = unzip $ support its+ xs = getXS lrsup+ (wsl, wsu) = getWS its xs+ weightsI = getWeights (wsl, wsu)+ yI = weightedSum xs weightsI+ doRight k' yi' = case findK k' yi' xs of+ Nothing -> error "No k 4"+ Just k -> revCompCheck yi' k'+ revCompCheck yi'' k' = case y' == yi'' of+ True -> (y', k')+ False -> doRight 0 y'+ where+ ws = rWeights wsl wsu k'+ y' = weightedSum xs ws++getXS :: Ord a => ([a], [a]) -- Supports+ -> [a] -- xs+getXS (ls, us) = sort $ nub $ ls ++ us++getWS :: IT2Set a -- Input set+ -> [a] -- xs+ -> ([Double], [Double]) --x_ x^-+getWS its xs = unzip $ map (\x -> x `is` its) xs++getWeights :: ([Double], [Double]) -- w_ w^-+ -> [Double] -- w+getWeights (lws, uws) = zipWith (\l u -> (l+u)/2) lws uws++weightedSum :: [Double] -> [Double] -> Double+weightedSum x w = sum (zipWith (*) x w) / sum w++findK :: Int -> Double -> [Double] -> Maybe Int+findK k y xs = if k >= length xs then Nothing else+ case (xs !! k) <= y && y <= (xs !! k+1) of+ True -> Just k+ False -> findK (k+1) y xs++lWeights :: [Double] -> [Double] -> Int -> [Double]+lWeights lws uws k = r' ++ l'+ where+ (r',_) = splitAt k uws+ (_,l') = splitAt k lws+++rWeights :: [Double] -> [Double] -> Int -> [Double]+rWeights lws uws k = l' ++ r'+ where+ (l',_) = splitAt k lws+ (_,r') = splitAt k uws+
+ src/Huzzy/TypeTwo/ZSlices/Sets.hs view
@@ -0,0 +1,103 @@+module Huzzy.TypeTwo.ZSlices.Sets where++import Data.Function+import Data.List+import Huzzy.Base.Sets+import Huzzy.TypeOne.Sets+import Huzzy.TypeTwo.Interval.Sets++data T2ZSet a = T2ZS { zLevels :: Int+ , zSlices :: [IT2Set a]+ , zdom :: [a]+ }++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) }++instance FSet (T2ZSet a) where+ type Value (T2ZSet a) = a+ type Support (T2ZSet a) = [(a,a)]+ type Returned (T2ZSet a) = MF Double+ support s = support (head $ zSlices s)+ hedge d s = s { zSlices = map (hedge d) (zSlices s)}+ x `is` s = discrete disPairs+ where+ its = zSlices s+ (ls, us) = unzip $ map (x`is`) its+ zs = zLevelAxis (length its)+ -- todo dirty hack to ensure max is returned+ disPairs = sortBy (flip compare `on` snd ) $ zip ls zs ++ zip us zs+++zLevelAxis :: Int -> [Double]+zLevelAxis n = 0 : (count step (n'-1))+ where+ n' = fromIntegral $ n-1+ step = 1/n'+ count s 0 = [s*n']+ count s z = (s*(n'-z)) : count s (z-1)++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]"+ False -> case check' of+ True -> error "Truth values must be in the range [0..1]"+ False -> T2ZS { zLevels = length its+ , zSlices = its+ , zdom = domain+ }+ where+ (MF lf, MF uf) = (lmf $ head its, umf $ head its)+ domain = [minB, minB+res .. maxB]+ check = any (\x -> x > 1 || x < 0) (map lf domain)+ check' = any (\x -> x > 1 || x < 0) (map uf domain)++discZT2 :: [a] -> [IT2Set a] -> T2ZSet a+discZT2 dom its = case check of+ True -> error "Truth values must be in the range [0..1]"+ False -> case check' of+ True -> error "Truth values must be in the range [0..1]"+ False -> T2ZS { zLevels = length its+ , zSlices = its+ , zdom = dom+ }+ where+ (MF lf, MF uf) = (lmf $ head its, umf $ head its)+ check = any (\x -> x > 1 || x < 0) (map lf dom)+ check' = any (\x -> x > 1 || x < 0) (map uf dom)++unsafeZT2 :: [a] -> [IT2Set a] -> T2ZSet a+unsafeZT2 dom its = T2ZS { zLevels = length its+ , zSlices = its+ , zdom = dom+ }++cylExtT2 :: T1Set Double -> Int -> T2ZSet Double+cylExtT2 s z = T2ZS { zLevels = z+ , zSlices = map (\(l, r) -> cylExt l r) lsrs+ , zdom = []+ }+ where+ 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 }+ where+ dom = [min a a' .. max c c']+ base = unsafeMkIT2 dom (tri a b c) (tri a' b' c')+ stepA = ((a-a')/fromIntegral (z-1))/2+ stepC = ((c-c')/fromIntegral (z-1))/2+ rc 0 _ _ = []+ rc z sa sc = (unsafeMkIT2+ [min (a-sa) (a'-sa) .. max (c-sc) (c'-sc)]+ (tri (a-sa) b (c-sc))+ ((tri (a'-sa) b' (c'-sc))))+ : (rc (z-1) (sa+stepA) (sc+stepC))
+ src/Huzzy/TypeTwo/ZSlices/Systems.hs view
@@ -0,0 +1,29 @@+module Huzzy.TypeTwo.ZSlices.Systems where++import Data.Function(on)+import Data.List(sortBy, nub)+import Huzzy.Base.Sets+import Huzzy.Base.Systems+import Huzzy.TypeOne.Sets+import Huzzy.TypeOne.Systems+import Huzzy.TypeTwo.Interval.Sets+import Huzzy.TypeTwo.Interval.Systems+import Huzzy.TypeTwo.ZSlices.Sets+++instance FRule (T2ZSet Double) where+ type Antecedent (T2ZSet Double) = T1Set Double+ (=*>) t1 t2 = (cylExtT2 t1 (zLevels t2)) ?|| t2+ (=|>) t1 t2 = (cylExtT2 t1 (zLevels t2)) ?|| t2+ weight t2 x = t2 {zSlices = map (\it2 -> weight it2 x) (zSlices t2)}++instance Defuzzifier (T2ZSet Double) where+ type Result (T2ZSet Double) = T1Set Double+ centroid t2s = unsafeMkT1 (ldom++rdom) $ discrete disPairs+ where+ its = zSlices t2s+ (ldom, rdom) = unzip $ support (head its)+ (ls, us) = unzip $ map centroid its+ zs = zLevelAxis (length its)+ -- todo dirty hack to ensure max is returned+ disPairs = sortBy (flip compare `on` snd ) $ zip ls zs ++ zip us zs