Universe

fuzzySets.cabal

@@ -49,6 +49,14 @@ library
     build-depends:    
         base,
 
+    default-extensions:
+        InstanceSigs
+        MultiParamTypeClasses
+        FlexibleContexts
+        FlexibleInstances
+        FunctionalDependencies
+
+
 test-suite test
     type:             exitcode-stdio-1.0
     main-is:          Tests.hs
@@ -67,3 +75,5 @@ test-suite test
         Fuzzy.Sets.LSetTest
         Fuzzy.Sets.MembershipFunctionsTest
         Fuzzy.Sets.PropertiesTest
+        Fuzzy.Relations.LRelationTest
+        Fuzzy.Relations.PropertiesTest

src/Fuzzy/Relations/LRelation.hs

@@ -19,6 +19,7 @@ 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 -}
@@ -63,10 +64,10 @@ fromFuzzySet fuzzySet = LRelation (member fuzzySet) (FuzzySet.universe fuzzySet)
 
 {- | Construct a fuzzy relation from a list of pairs-}
 fromList :: (ResiduatedLattice l, Eq a) => [((a, a), l)] -> LRelation a l
-fromList lst = LRelation member u
+fromList lst = LRelation member (listToUniverse u)
     where
         member (x, y) = fromMaybe bot (lookup (x, y) lst)
-        u = map fst lst
+        u = universeToList (map fst lst)
 
 
 {- | Construct a fuzzy relation from a membership function and a universe
@@ -78,8 +79,8 @@ fromList lst = LRelation member u
 >>> toPairs rel
 [((1,2),0.7),((2,3),0.7),((3,1),0.3)]
 -}
-fromFunction :: (ResiduatedLattice l, Eq a) => ((a, a) -> l) -> [(a, a)] -> LRelation a l 
-fromFunction = LRelation
+fromFunction :: (ResiduatedLattice l, Eq a) => ((a, a) -> l) -> [a] -> LRelation a l 
+fromFunction f u = LRelation f (listToUniverse u)
 
 
 {- | Construct an empty fuzzy relation
@@ -102,8 +103,8 @@ mkEmptyRel = LRelation (const bot) []
 >>> toPairs singletonRel
 [((1, 2), 0.8),((2, 3), 0.0)]
 -}
-mkSingletonRel :: (ResiduatedLattice l, Eq a) => [(a, a)] -> ((a, a), l) -> LRelation a l
-mkSingletonRel u (x, l) = LRelation f u
+mkSingletonRel :: (ResiduatedLattice l, Eq a) => [a] -> ((a, a), l) -> LRelation a l
+mkSingletonRel u (x, l) = LRelation f (listToUniverse u)
     where f pair = if pair == x then l else bot
 
 
@@ -115,8 +116,9 @@ mkSingletonRel u (x, l) = LRelation f u
 >>> toPairs universalRel
 [((1, 2), 1.0),((2, 3), 1.0)]
 -}
-mkUniversalRel :: (ResiduatedLattice l, Eq a) => [(a, a)] -> LRelation a l
-mkUniversalRel = LRelation (const top)
+mkUniversalRel :: (ResiduatedLattice l, Eq a) => [a] -> LRelation a l
+mkUniversalRel u = LRelation (const top) (listToUniverse u)
+
 
 -- | Return relation as a list of pairs
 toPairs :: (ResiduatedLattice l, Eq a) => LRelation a l -> [((a, a), l)]

src/Fuzzy/Relations/Properties.hs

@@ -10,6 +10,7 @@ module Fuzzy.Relations.Properties (
 import Fuzzy.Relations.LRelation
 import Lattices.ResiduatedLattice
 import Utils.Utils(universeToList)
+import Lattices.UnitIntervalStructures.Godel
 
 -- functions determining degree of properties of fuzzy relations
 
@@ -31,7 +32,7 @@ An 'LRelation' is reflexive if \(ref \: rel =\) 'top'
 -}
 ref :: (Eq a, ResiduatedLattice l) => LRelation a l -> l
 ref (LRelation f u) =
-    foldr (/\) top [f (x, x) | x <- universe]
+    foldr (/\) top [f x | x <- u,  uncurry (==) x]
     where universe = universeToList u
 
 
@@ -42,7 +43,7 @@ An 'LRelation' is symmetric if \(sym \: rel =\) 'top'
 ==== __Examples__
 
 >>> let u = [(1, 2), (2, 1), (2, 3), (3, 2)]
->>> let rel = LRelation (\_ ->  0.5) u :: LRelation Int UILukasiewicz
+>>> let rel = LRelation (const  0.5) u :: LRelation Int UILukasiewicz
 >>> sym rel
 1.0
 
@@ -67,13 +68,14 @@ An 'LRelation' is transitive if \(tra \: rel =\) 'top'
 >>> tra rel
 1.0
 
->>> let rel = LRelation (\(x, y) -> if x < y then 0.7 else bot) u :: LRelation Int UILukasiewicz
+>>> let rel = LRelation (\(x, y) -> if x == y then 0.2 else 0.7) u :: LRelation Int UILukasiewicz
 >>> tra rel
-0.7
+0.5
 -}
 tra :: (Eq a,ResiduatedLattice l) => LRelation a l -> l
 tra (LRelation f u) =
-    foldr (/\) top [f (x, y) /\ f (y, z) --> f (x, z) | x <- universe, y <- universe, z <- universe]
+    foldr (/\) top [f (x, y) /\ f (y, z) --> f (x, z) |
+                      x <- universe, y <- universe, z <- universe]
     where universe = universeToList u
 
 
@@ -93,8 +95,8 @@ An 'LRelation' is irreflexive if \(irref \: rel =\) 'top'
 0.3
 -}
 irref :: (Eq a,ResiduatedLattice l) => LRelation a l -> l
-irref (LRelation f u) = negation $
-    foldr (/\) top [f (x, x) | x <- universe]
+irref (LRelation f u) =
+    foldr (/\) top [negation (f x) | x <- u,  uncurry (==) x]
     where universe = universeToList u
 
 

src/FuzzySet.hs

@@ -14,9 +14,10 @@ module FuzzySet(
 
 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) => FuzzySet set a l | set -> a l where
+class (ResiduatedLattice l, Eq a) => FuzzySet set a l | set -> a l where
     mkFuzzySet :: (a -> l) -> [a] -> set
     -- | membership function 
     member :: set -> a -> l
@@ -66,7 +67,7 @@ alphaCut alpha set = [x | x <- u, f x >= alpha]
           u = universe set
 
 
-{- | Fuzzy set union A ∪ B
+{- | Fuzzy set union A ∪ B. Universe of the new set is union of universes from A and B.
 
 ==== __Examples__
 
@@ -86,15 +87,15 @@ union :: (FuzzySet set a l) => set -> set -> set
 union set1 set2 = mkFuzzySet (\x -> f x \/ g x) u
     where f = member set1
           g = member set2
-          u = universe set1
+          u = SetOp.union (universe set1) (universe set2)
 
 
 -- | 'union' over a list of sets
 unions :: (FuzzySet set a l, Eq a) => [set] -> set
 unions sets@(set:_) = foldr union (mkUniversalSet (universe set)) sets
 
 
-{- | Fuzzy set intersection A ∩ B
+{- | Fuzzy set intersection A ∩ B. Universe of the new set is intersection of universes from A and B.
 
 ==== __Examples__
 
@@ -114,7 +115,7 @@ intersection :: (FuzzySet set a l) => set -> set -> set
 intersection set1 set2 = mkFuzzySet (\x ->  f x /\ g x) u
     where f = member set1
           g = member set2
-          u = universe set1
+          u = SetOp.intersect (universe set1) (universe set2)
 
 -- | 'intersection' over a list of sets
 intersections :: (FuzzySet set a l, Eq a) => [set] -> set
@@ -133,12 +134,11 @@ intersections = foldr intersection mkEmptySet
 [(1, 0), (2, 0)]
 -}
 complement :: (FuzzySet set a l) => set -> set
-complement set = mkFuzzySet (negation . f)  u
+complement set = mkFuzzySet (negation . f)  (universe set)
     where f = member set
-          u = universe set
 
 
-{- | Apply a t-norm operation over two fuzzy sets
+{- | Apply a t-norm operation over two fuzzy sets. Both sets should be defined on the same 'universe'.
 
 ==== __Examples__
 
@@ -154,7 +154,7 @@ setTnorm set1 set2 = mkFuzzySet (\x -> f x `tnorm` g x) u
           u = universe set1
 
 
-{- | Apply a residuum operation over two fuzzy sets
+{- | Apply a residuum operation over two fuzzy sets. Both sets should be defined on the same 'universe'.
 
 ==== __Examples__
 

src/Utils/Utils.hs

@@ -1,6 +1,7 @@
 module Utils.Utils(
     universeToList,
     crop,
+    listToUniverse
 ) where
 
 import Data.List(nub)
@@ -11,6 +12,9 @@ flattenPairs = foldr (\(x ,y) -> (++) [x, y]) []
 universeToList :: (Eq a) => [(a, a)] -> [a]
 universeToList = nub . flattenPairs
 
+listToUniverse :: (Eq a) => [a] -> [(a, a)] 
+listToUniverse u = [(x, y) | x <- u, y <- u]
+
 -- | Round real number to 6 digits
 crop :: RealFloat a => a -> a
 crop x = fromInteger (round (x * (10^6))) / (10.0^^6)

test/Fuzzy/Relations/LRelationTest.hs

@@ -34,7 +34,7 @@ testFromList = do
 testFromFunction :: Assertion
 testFromFunction = do
     let f (x, y) = if x == y then top else bot
-    let u = [(1, 1), (1, 2), (2, 1), (2, 2)]
+    let u = [1, 2]
     let rel = fromFunction f u :: LRelation Int UILukasiewicz
     assertEqual "Membership (1,1)" (mkLattice 1.0) (member rel (1, 1))
     assertEqual "Membership (1,2)" (mkLattice 0.0) (member rel (1, 2))
@@ -49,15 +49,15 @@ testMkEmptySet = do
 -- Test mkSingletonSet
 testMkSingletonSet :: Assertion
 testMkSingletonSet = do
-    let u = [(1, 1), (1, 2), (2, 1), (2, 2)]
+    let u = [1, 2]
     let rel = mkSingletonRel u ((1, 1), mkLattice 0.8) :: LRelation Int UILukasiewicz
     assertEqual "Membership (1,1)" (mkLattice 0.8) (member rel (1, 1))
     assertEqual "Membership (1,2)" bot (member rel (1, 2))
 
 -- Test mkUniversalSet
 testMkUniversalSet :: Assertion
 testMkUniversalSet = do
-    let u = [(1, 1), (1, 2), (2, 1), (2, 2)]
+    let u = [1, 2]
     let rel = mkUniversalRel u :: LRelation Int UILukasiewicz
     assertEqual "Membership (1,1)" top (member rel (1, 1))
     assertEqual "Membership (1,2)" top (member rel (1, 2))
@@ -75,4 +75,4 @@ testUniverse :: Assertion
 testUniverse = do
     let lst = [((1, 1), mkLattice 0.8), ((1, 2), mkLattice 0.4)]
     let rel = fromList lst :: LRelation Int UILukasiewicz
-    assertEqual "Universe" [(1, 1), (1, 2)] (universe rel)
+    assertEqual "Universe" [(1, 1), (1, 2), (2, 1), (2, 2)] (universe rel)