packages feed

ContextAlgebra (empty) → 0.1.0.0

raw patch · 5 files changed

+308/−0 lines, 5 filesdep +basedep +containersdep +latticessetup-changed

Dependencies added: base, containers, lattices, multiset

Files

+ ContextAlgebra.cabal view
@@ -0,0 +1,67 @@+-- Initial ContextAlgebra.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                ContextAlgebra++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            Context Algebra++-- A longer description of the package.+description:         Context Algebra to identify typical exemplars of a concept influenced by a context.++-- The license under which the package is released.+license:        BSD3++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              juergenhah++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          hahn@geoinfo.tuwien.ac.at++-- A copyright notice.+-- copyright:           ++category:            Math++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+-- extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10+++library+  -- Modules exported by the library.+  exposed-modules:     Model, ContextLattice+  +  -- Modules included in this library but not exported.+  -- other-modules:       +  +  -- LANGUAGE extensions used by modules in this package.+  other-extensions:    FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, DeriveGeneric, InstanceSigs, UndecidableInstances+  +  -- Other library packages from which modules are imported.+  build-depends:       base >=4.7 && <4.8, containers >=0.5 && <0.6,lattices ==1.3.*, multiset ==0.3.*+  +  -- Directories containing source files.+  hs-source-dirs:      src+  +  -- Base language which the package is written in.+  default-language:    Haskell2010+
+ LICENSE view
@@ -0,0 +1,1 @@+I declare this package as public domain
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/ContextLattice.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances  #-}+{-# LANGUAGE UndecidableInstances  #-}+{-|+Module      : ContextLattice+Description : models a Lattice for a context type, the top of the lattice is represented by One and inherits a list of all subcontexts, the bottom of the lattice is represented by Zero.+Maintainer  : hahn@geoinfo.tuwien.ac.at+Stability   : beta++models a Lattice for a context type, the top of the lattice is represented by One and inherits a list of all subcontexts, the bottom of the lattice is represented by Zero. To inherit the contextlattice to a new data type the data type has to instanciate: Enumerable c, Eq c, Ord c, Show c+-}+module ContextLattice (Context (One,Ctx,Zero), getFinerContexts+                      ,extractContext, propCommutative,propIdempotent,propAssociative) where++import           Algebra.Enumerable+import           Algebra.Lattice+import qualified Data.List          as L+import qualified Debug.Trace        as T++-- | data type to represent a lattice structure, the actual context is the type variable @c@+data Context c=+ -- | constructor represents the One element of the lattice, all contexts are included in this constructor,+ -- for this constructor the model includes all contexts+ One [Context c]+ -- | constructor for one context+ | Ctx [c]+ -- | constructor represents the bottom element of the lattice, without any context+ | Zero  deriving (Show,Eq,Ord)++-- | makes the Context c type to a MeetSemiLattice by implementing the meet function+instance (Enumerable  c,Eq c,(Enumerable (Context c)))=>+  MeetSemiLattice (Context c) where++ -- | the meet funtion implements the algebraic properties of context+ meet:: Context c-> Context c-> Context c+ meet (One _) c = c -- cummutative with One element+ meet c (One _) = c -- cummutative with One element+ meet firstContext secondContext+  | null firstIntersectWithSecondContext = Zero+  | otherwise  = Ctx (L.head firstIntersectWithSecondContext)+   where firstContextList = L.concatMap extractContext $ getFinerContexts firstContext+         secondContextList = L.concatMap extractContext $ getFinerContexts secondContext+         firstIntersectWithSecondContext = firstContextList `isPartOf` secondContextList -- commutativity property++-- | extracts a context list of contexts from the element,+-- needed for the One wrapper constructor+extractContext ::+ Context c  -- ^ Context where elements are extracted from,+ -> [[c]]   -- ^ extracted context list+extractContext (One c) = extractOneContext c+extractContext (Ctx c) = [c]+extractContext Zero = []++-- | makes a list of contexts for the One constructor+extractOneContext ::+ [Context c]  -- ^ list of context c occured by constructor c+ -> [[c]]      -- ^ extracted list+extractOneContext [] = []+extractOneContext (Ctx c:cs)= c : extractOneContext cs++-- | takes a context and returns all finer+getFinerContexts :: (Eq c, (Enumerable  c),(Enumerable (Context c))) =>+ Context c      -- ^ context that is used as start+ -> [Context c] -- ^ all finer contexts of the start context included in the lattice+getFinerContexts c = L.map Ctx $ contextListWholeLattice  `isPartOf` contextListfromStart+ where contextListfromStart = extractContext c+       contextListWholeLattice = extractContext (One universe)++-- | Checks if the first context list is included in the second, if so the context is returned,+--   so far the function is does not have any order restrictions (is commutative)+--   checks also sublists, if an element of a sublist is in both lists, the whole list is included+isPartOf ::(Eq c) =>+ [[c]]      -- ^ first list that is used to check against second one+ -> [[c]]   -- ^ second list is like a reference+ -> [[c]]   -- ^ elements that are included in both lists+isPartOf = L.intersectBy (\lista listb -> all (`elem` lista) listb)+++-- * algebraic property test methods+-- | test for commutativity+--+-- >>> (Ctx [Walking]) `propCommutative` One [Ctx [Walking],Ctx [Driving],Ctx [Walking,Driving],Ctx [Uphill],Ctx [Walking,Uphill],Ctx [Driving,Uphill],Ctx [Walking,Driving,Uphill]] = (Ctx [Walking]) `meet` One [Ctx [Walking],Ctx [Driving],Ctx [Walking,Driving],Ctx [Uphill],Ctx [Walking,Uphill],Ctx [Driving,Uphill],Ctx [Walking,Driving,Uphill]] == One [Ctx [Walking],Ctx [Driving],Ctx [Walking,Driving],Ctx [Uphill],Ctx [Walking,Uphill],Ctx [Driving,Uphill],Ctx [Walking,Driving,Uphill]] `meet` (Ctx [Walking])+-- true+propCommutative ::(Eq c,Enumerable c, Enumerable (Context c)) =>+  Context c    -- ^ context one+  -> Context c -- ^ context two+  -> Bool      -- ^ true if the property is full-filled+propCommutative c1 c2 =  c1 `meet` c2 == c2 `meet` c1++-- | test for idempotency+--+-- >>> propIdempotent (Ctx [Walking]) = (Ctx [Walking]) `meet` (Ctx [Walking]) == (Ctx [Walking])+-- true+propIdempotent ::(Eq c,Enumerable c, Enumerable (Context c)) =>+  Context c-- ^ context to test+  -> Bool  -- ^ true if the property is full-filled+propIdempotent c =  c `meet` c == c++-- | test for associativity+--+-- >>> propAssociative (Ctx [Walking]) (Ctx [Driving]) (Ctx [Uphill]) =  (Ctx [Walking]) `meet` ((Ctx [Driving]) `meet` (Ctx [Uphill])) == ((Ctx [Walking]) `meet` (Ctx [Driving])) `meet` (Ctx [Uphill])+-- true+propAssociative :: (Eq c, Enumerable c, Enumerable (Context c)) =>+  Context c    -- ^ context one+  -> Context c -- ^ context two+  -> Context c -- ^ context three+  -> Bool      -- ^ true if the property is full-filled+propAssociative x y z = x `meet` (y `meet` z) == (x `meet` y) `meet` z+++-- * not needed+-- | checks in which level of the lattice the actual @Context c@ is+-- One gets level 1, Zero gets level 0, and all others are 1++level ::+ Context c -- ^ context to check level in the lattice+ -> Int    -- ^ level in the lattice+level (One _)= 1+level (Zero)=0+level (Ctx a)= L.length a
+ src/Model.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-|+Module      : Model+Description : connects the context Lattice with observation frequencies of exemplars using a multiset+Maintainer  : hahn@geoinfo.tuwien.ac.at+Stability   : beta++This module implements the necessary functions to model a concept and the context influence. The concept is represented by several exemplars. For each influencing context the exemplars have different observation frequency. This conncetion is modeled here by a multiset.+-}+module Model where++import           ContextLattice++import           Algebra.Enumerable+import qualified Data.Function      as F+import qualified Data.List          as L+import qualified Data.MultiSet      as Mset++-- | Each experience is formed by a exemplar of type e and a context c this exemplar was observed at.+data Experience c e =+  -- | constructor;  establishes an experience from a context and an exemplar+  Exp c e deriving (Ord, Show, Eq)++-- | All experiences are hold in a multiset+type Experiences c e = Mset.MultiSet (Experience c e)++-- | type synonym for better readability+type Probability = Float++-- | the class defines the necessary functions needed for the context algebra+class (Ord c, Ord e, Show c, Show e)=> InterpretationModel c e where++-- | combines the observation amount of exemplars for one context+createExperiencesForContext :: (Show c,Ord c, Show e,Ord e) =>+ c      -- ^  context in which the experiences were made+ -> [e] -- ^  exemplars which are observed+ -> [Int] -- ^  amount of observations for one exemplar in this context+ -> Experiences c e -- ^  resulting experience type+createExperiencesForContext context exemplars amounts = Mset.unions $zipWith manyfoldExperiences experiencesOnce amounts+ where experiencesOnce = map (Exp context) exemplars++-- | If an experience is made several times the amount can be specified by the @amount@+manyfoldExperiences ::  (Ord c, Show c, Ord e, Show e) =>+ Experience c e  -- ^  experience that is observed several times+ -> Mset.Occur   -- ^  amount of observations of the experience+ -> Experiences c e -- ^ experiences with the given amount and type+manyfoldExperiences exp amount= Mset.insertMany exp amount Mset.empty++-- | calculates the amount of experiences that are present+amountExperiences ::+  Experiences (Context c) e -- ^ experinces to be counted+  -> Int -- ^ amount of experiences+amountExperiences = Mset.size++-- | filters experiences for a context, gets experiences for a finer context,+-- the context c has to be more finer than the context that are included in the experiences+lambda :: ((Enumerable c), Enumerable (Context c),Ord e, Eq c,Ord c) =>+ Context c                      -- ^ context used to filter the experiences+ -> Experiences (Context c) e   -- ^ experiences to filter+ -> Experiences (Context c) e   -- ^ filtered experiences, more finer experiences are returned+lambda context experiences = Mset.unions .+ L.map (\fctx -> (Mset.filter (\(Exp c1 _)-> c1 == fctx ) experiences ) )  $ allfinerContexts+ where allfinerContexts = getFinerContexts context++-- | returns a probability of an exemplar observed in a context for the given experiences+mu ::((Enumerable c), Enumerable (Context c),Ord e,Ord c)=>+ Experience (Context c) e        -- ^ exemplar and context to look for+ -> Experiences (Context c) e    -- ^ experiences that are considered+ -> Probability                       -- ^ probability of the exemplar in this context for the given experiences+mu (Exp context exemplar) experiences = if amountContext==0 then 0+                                                            else amountExemplar /amountContext+  where observationAmounttForContext = Mset.size experiencesForContext+        exemplarOservationAmountForContext = Mset.size $ filterExemplars exemplar experiencesForContext+        experiencesForContext = lambda context experiences+        amountExemplar= fromIntegral exemplarOservationAmountForContext+        amountContext = fromIntegral observationAmounttForContext++-- | returns experiences for the exemplar given in the first argument @e@+-- in quantum mechanics called projector+filterExemplars:: (Ord c, Ord e) =>+ e                   -- ^ exemplar used to filter the experiences+ -> Experiences c e  -- ^ experiences that are filtered+ -> Experiences c e  -- ^ experiences including values for the exemplar e+filterExemplars exemplar = Mset.filter (\(Exp _ actualExemplar)-> exemplar ==actualExemplar)+++-- * functions to print and export+-- | returns the observation distribution for the context c, the type e is only used as type parameter+probAllExemplars4Context :: (Ord c, Ord e,Enum e,Bounded e,(Enumerable c), Enumerable (Context c))=>+ Context c  -- ^ context the distribution is made for+ -> e         -- ^ exemplar type, used as type parameter+ -> Experiences (Context c) e -- ^ experiences the distribution is made of+ -> [(e,Probability)] -- ^ returned distribution+probAllExemplars4Context ctx e t=  map (\e ->(e, mu (Exp ctx e) t) ) exemplars+ where exemplars= enumFromTo minBound $ maxBound `asTypeOf` e++-- | returns the most probable exemplar given by the list of tuples of (Exemplar, Probability)+getMostProbableExemplar :: (Ord e)=>+ [(e, Probability)]  -- ^ list of tupels of Exemplars and the probability value+ -> (e, Probability) -- ^ tupel with the highest probability value+getMostProbableExemplar  = L.maximumBy (compare `F.on` snd)++-- | converts the experiences type to a IO()+printExperiences :: (Show e, Show c) =>+ Experiences c e -- ^ experience to convert to IO+ -> IO() -- ^ returned IO()+printExperiences experiences = putStrLn $ Mset.showTreeWith True True experiences+++-- * functions for further development of the model+-- | adds the @new@ experience to the given experiences+addExperience :: (Ord c,Ord e) =>+ Experience c e      -- ^  new experience to add+ -> Experiences c e  -- ^  given experiences where to add the new experience+ -> Experiences c e  -- ^  resulting experiences including the new and the given experiences+addExperience = Mset.insert