packages feed

NearContextAlgebra (empty) → 0.1.0.0

raw patch · 7 files changed

+612/−0 lines, 7 filesdep +ContextAlgebradep +QuickCheckdep +basesetup-changed

Dependencies added: ContextAlgebra, QuickCheck, base, containers, lattices, multiset

Files

+ LICENSE view
@@ -0,0 +1,1 @@+I declare this package as public domain
+ NearContextAlgebra.cabal view
@@ -0,0 +1,75 @@+-- Initial NearContextAlgebra.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                NearContextAlgebra++-- 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 of near++-- A longer description of the package.+description:    Model of the concept near influenced by several contexts++-- The license under which the package is +license:        BSD3++-- The file containing the license text.+license-file:        LICENSE+-- 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+++executable NearContextAlgebra+  -- .hs or .lhs file containing the Main module.+  main-is:             Main.hs+  +  -- Modules included in this executable, other than Main.+  other-modules:       NearContext, +                       NearModel, +                       NearExemplar+  +  -- LANGUAGE extensions used by modules in this package.+  other-extensions:    FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, DeriveGeneric, InstanceSigs+  +  -- Other library packages from which modules are imported.+  build-depends:       ContextAlgebra >=0.1 && <0.2+                     , QuickCheck >= 2.6+                     , base >=4.7 && <4.8+                     , containers >=0.5 && <0.6+                     , lattices >=1.3 && <1.4+                     , multiset >=0.3 && <0.4+  +  -- Directories containing source files.+  hs-source-dirs:      src+  +  -- Base language which the package is written in.+  default-language:    Haskell2010+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Main.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-|+Module      : Main+Description : Main module for the model of the exemplars (NearExemplar module) of the concept near influenced by several contexts (NearContext module). Including algebraic test+Maintainer  : hahn@geoinfo.tuwien.ac.at+Stability   : beta++Use case of the context algebra for the concept near and the contexts: walking, driving, uphill+-}+module Main where+import           ContextLattice+import           Model++import           NearContext+import           NearExemplar+import           NearModel++-- needed for the function meet+import           Algebra.Lattice+-- needed for the algebraic tests+import qualified Data.List       as L+import           Test.QuickCheck++-- | print a use case of the model+main = do+  putStrLn "Model of the concept near influenced by contexts"+  print ctxOne+  putStrLn "+++ ALGEBRAIC TESTS FOR CONTEXT LATTICE +++++++"+  putStrLn "Idempotency tests:"+  testIdemProperty+  putStrLn "Commutativity tests:"+  testCommProperty+  putStrLn "Associativity tests:"+  testAssocProperty+  putStrLn "+++++++++++++++ MODEL A USE CASE ++++++++++++++"+  refineNear+++refineNear :: IO()+refineNear = do+  putStrLn "somebody is looking for a near restaurant, by quering an information retrieval engine"+  putStrLn "the problem for the IR is which distance is meant by near"+  putStrLn "our model is able to interpret the concept 'near' influenced by several context"+  putStrLn "in this situation no context is given, the model can calculate probability values for given distances (exemplars)"+  print $  probAllExemplars4Context ctxOne M50 allExperiences+  putStrLn "\nthe most probable distance is now: the distance with the highest probability"+  print . getMostProbableExemplar . probAllExemplars4Context ctxOne M50 $ allExperiences+  putStrLn "+++++++++++++++ adding a CONTEXT +++++++++++++++"+  putStrLn "\nfrom a sensor we get context information that the user is walking, therefore the model is able to refine the concept near and influence it with the context near"+  print $  probAllExemplars4Context (ctxOne `meet` ctxWalking) M50 allExperiences+  putStrLn "the most probable distance is now: the distance with the highest probability"+  print . getMostProbableExemplar . probAllExemplars4Context (ctxOne `meet` ctxWalking) M50 $ allExperiences+  putStrLn "+++++++++++++++ adding a CONTEXT +++++++++++++++"+  putStrLn "\nfrom LIDAR data we know that the user is walking uphill, what can also refine the concept"+  print $  probAllExemplars4Context (ctxOne `meet` ctxWalking `meet` ctxUphill) M50 allExperiences+  putStrLn "\n the most probable exemplar influenced by the contexts: walking and uphill"+  print . getMostProbableExemplar . probAllExemplars4Context (ctxOne `meet` ctxWalking `meet` ctxUphill) M50 $ allExperiences+  putStrLn "+++++++++++++++ SUMMARY +++++++++++++++"+  putStrLn "\n To summarize, the typicality has changes without context:"+  print . getMostProbableExemplar . probAllExemplars4Context ctxOne M50 $ allExperiences+  putStrLn "\n influenced by the context walking to:"+  print . getMostProbableExemplar . probAllExemplars4Context (ctxOne `meet` ctxWalking) M50 $ allExperiences+  putStrLn "\n further refined and influenced by the context walking uphill, the most typical exemplar is:"+  print . getMostProbableExemplar . probAllExemplars4Context (ctxOne `meet` ctxWalking `meet` ctxUphill) M50 $ allExperiences++-- * test algebraic properties+-- | Idempotency test, prints the input values and the result+--+-- @+-- Context c `meet` Context c == Context c+-- @+testIdemPropertyPrinted = verboseCheck (propIdempotent :: Context Transportation -> Bool)++-- | Idempotency test,  prints the result+--+-- @+-- Context c `meet` Context c == Context c+-- @+testIdemProperty = quickCheck (propIdempotent :: Context Transportation -> Bool)+++-- | Commutative test,prints the input values and the result+--+-- @+-- Context x meet Context y == Context y meet Context x+-- @+testCommPropertyPrinted = verboseCheck (propCommutative :: Context Transportation -> Context Transportation -> Bool)++-- | Commutative test, prints the result+--+-- @+--  Context x meet Context y == Context y meet Context x+-- @+testCommProperty = quickCheck (propCommutative :: Context Transportation -> Context Transportation -> Bool)+++-- | Associative test, prints the input values and the result+--+-- @+-- Context x `meet` (Context y `meet` Context z) == (Context x `meet` Context y) `meet` Context z+-- @+testAssocPropertyPrinted = verboseCheck (propAssociative ::Context Transportation -> Context Transportation  -> Context Transportation-> Bool)++-- | Associative test, prints the result+--+-- @+-- Context x `meet` (Context y `meet` Context z) == (Context x `meet` Context y) `meet` Context z+-- @+testAssocProperty = quickCheck (propAssociative ::Context Transportation -> Context Transportation  -> Context Transportation-> Bool)+++-- * functionality of the model++-- | get all experiences for the context walking+--+-- >>> printExperiences experiencesWalking+-- (6*)Exp (Ctx [Walking]) 450 m+-- |+-- +--(4*)Exp (Ctx [Walking]) 150 m+-- |  |+-- |  +--(2*)Exp (Ctx [Walking]) 100 m+-- |  |+-- |  +--(6*)Exp (Ctx [Walking]) 300 m+-- |+-- +--(3*)Exp (Ctx [Walking,Uphill]) 100 m+--    |+--    +--(1*)Exp (Ctx [Walking]) 5000 m+--    |  |+--    |  +--(4*)Exp (Ctx [Walking]) 1000 m+--    |  |+--    |  +--(4*)Exp (Ctx [Walking,Uphill]) 50 m+--    |+--    +--(2*)Exp (Ctx [Walking,Uphill]) 150 m+--       |+--       +--|+--       |+--       +--(1*)Exp (Ctx [Walking,Uphill]) 300 m+experiencesWalking = lambda ctxWalking allExperiences+++-- | get all experiences for the context driving+--+-- >>> printExperiences experiencesDriving+-- (2*)Exp (Ctx [Driving,Uphill]) 100 m+-- |+-- +--(1*)Exp (Ctx [Driving]) 450 m+-- |  |+-- |  +--(3*)Exp (Ctx [Driving]) 150 m+-- |  |  |+-- |  |  +--(1*)Exp (Ctx [Driving]) 100 m+-- |  |  |+-- |  |  +--(1*)Exp (Ctx [Driving]) 300 m+-- |  |+-- |  +--(2*)Exp (Ctx [Driving]) 5000 m+-- |     |+-- |     +--(2*)Exp (Ctx [Driving]) 1000 m+-- |     |+-- |     +--(2*)Exp (Ctx [Driving]) 10000 m+-- |+-- +--(6*)Exp (Ctx [Driving,Uphill]) 450 m+--    |+--    +--(1*)Exp (Ctx [Driving,Uphill]) 150 m+--    |  |+--    |  +--|+--    |  |+--    |  +--(5*)Exp (Ctx [Driving,Uphill]) 300 m+--    |+--    +--(8*)Exp (Ctx [Driving,Uphill]) 5000 m+--       |+--       +--(7*)Exp (Ctx [Driving,Uphill]) 1000 m+--       |+--       +--(5*)Exp (Ctx [Driving,Uphill]) 10000 m+experiencesDriving = lambda ctxDriving allExperiences+++-- | prints the experiences form the resulting context of driving uphill and driving+--+-- >>>  printExperiences experiencesDrivingUphill+-- (6*)Exp (Ctx [Driving,Uphill]) 450 m+-- |+-- +--(1*)Exp (Ctx [Driving,Uphill]) 150 m+-- |  |+-- |  +--(2*)Exp (Ctx [Driving,Uphill]) 100 m+-- |  |+-- |  +--(5*)Exp (Ctx [Driving,Uphill]) 300 m+-- |+-- +--(8*)Exp (Ctx [Driving,Uphill]) 5000 m+--    |+--    +--(7*)Exp (Ctx [Driving,Uphill]) 1000 m+--    |+--    +--(5*)Exp (Ctx [Driving,Uphill]) 10000 m+experiencesDrivingUphill = lambda (ctxDrivingUphill `meet` ctxDriving) allExperiences+++-- | sum the experiences for the context one+sumExp4Contexts ::((BoundedMeetSemiLattice TransportationContext))=>  [([Transportation],Int)]+sumExp4Contexts= zipWith (\sum ctx -> (ctx,sum)) s c+ where s = map ((amountExperiences . flip lambda allExperiences). Ctx)  c+       c = extractContext ctxOne
+ src/NearContext.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-|+Module      : NearContext+Description : declares all data types to represent the contexts used in the near example+Maintainer  : hahn@geoinfo.tuwien.ac.at+Stability   : beta++Models the contexts of the concept near+-}+module NearContext (Transportation(..),TransportationContext(..), universe, top, arbitrary) where++import           ContextLattice++import           Algebra.Enumerable+import           Algebra.Lattice+import qualified Data.List          as L+import           Test.QuickCheck+++-- * the context type used to model the concept near+-- | this data type represents all contexts that are used in the near model, make sure to derive all the type classes+data Transportation =+ -- | constructor represents the context walking+ Walking+ -- | constructor represents the context driving+ | Driving+ -- | constructor for the context uphill+ | Uphill+ deriving (Show,Eq,Ord,Enum,Bounded)++-- | type synonym+type TransportationContext = Context Transportation++-- | to provide the model with the function universe we make an instance of Enumerable from the Algebra.Enumerable module+instance Enumerable Transportation where+ -- | returns all contexts, needs the type classes Bounded and Enum to work+ --+ -- >>> universe ::[Transportation]+ -- [Walking,Driving,Uphill]+ universe = universeBounded++-- | also the wrapped type has to be an instance of Enumerable+instance Enumerable TransportationContext where++ -- | returns all TransportationContexts+ --+ -- >>>  universe ::[TransportationContext]+ -- [Ctx [Walking],Ctx [Driving],Ctx [Walking,Driving],Ctx [Uphill],Ctx [Walking,Uphill],Ctx [Driving,Uphill],Ctx [Walking,Driving,Uphill]]+ universe =  tail. L.map Ctx . L.subsequences  $ (universe::[Transportation])++-- | the context type forms a lattice with a upper bound that can be retrieved by the function top+instance BoundedMeetSemiLattice TransportationContext where++ -- | returns the contexts active in the upper contexts, what means no context is active, synonym for one in my thesis+ --+ -- >>> top ::TransportationContext+ -- One [Ctx [Walking],Ctx [Driving],Ctx [Walking,Driving],Ctx [Uphill],Ctx [Walking,Uphill],Ctx [Driving,Uphill],Ctx [Walking,Driving,Uphill]]+ top = One (universe::[Context Transportation])+++++++
+ src/NearExemplar.hs view
@@ -0,0 +1,50 @@+{-|+Module      : NearExemplar+Description : declares the exemplars used for the near Model+License     : GPL-3+Maintainer  : hahn@geoinfo.tuwien.ac.at+Stability   : Declares++Includes all data types and functions needed by the near Model module.+The exemplars are represented by a data type deriving some type classes.+-}+module NearExemplar where+-- | This data defines the exemplars that are handled by the model+-- be sure to have for all of these frequency values.+-- The data type must derive following type classes:+-- (Show, Eq, Ord, Enum,Bounded)+data Exemplar =+ -- | represents the fifty metres exemplar+ M50+ -- | represents the 100 metres exemplar+ | M100+ -- | represents the 150 metres exemplar+ | M150+ -- | represents the 300 metres exemplar+ | M300+ -- | represents the 450 metres exemplar+ | M450+ -- | represents the 450 metres exemplar+ | M1000+ -- | represents the 5000 metres exemplar+ | M5000+ -- | represents the 10.000 metres exemplar+ | M10000+ deriving (Eq, Ord, Enum,Bounded)++-- | returns a list of the exemplars+--+-- >>> exemplars+-- [M50,M100,M150,M300,M450,M1000,M5000,M10000]+exemplars = enumFromTo minBound $ maxBound `asTypeOf` M50++-- | pretty print for the Exemplar type+instance Show Exemplar where+  show M50 = "50 m"+  show M100 = "100 m"+  show M150 = "150 m"+  show M300 = "300 m"+  show M450 = "450 m"+  show M1000= "1000 m"+  show M5000 = "5000 m"+  show M10000 = "10000 m"
+ src/NearModel.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances  #-}+{-|+Module      : NearModel+Description : declaring all functions+License     : GPL-3+Maintainer  : hahn@geoinfo.tuwien.ac.at+Stability   : Declares++define most functions and frequency values+-}+module NearModel (allExperiences, ctxOne, ctxWalking, ctxDriving, ctxUphill+                 , ctxWalkingDriving, ctxWalkingUphill, ctxDrivingUphill+                 , ctxWalkingDrivingUphill, ctxZero) where++import           ContextLattice+import           Model+import           NearContext+import           NearExemplar++import           Algebra.Lattice+import qualified Data.MultiSet   as Mset+import           Test.QuickCheck++-- | instance declaration for the transportation context+-- , needed to have the functions: lambda, mu and the meet present+instance InterpretationModel TransportationContext Exemplar++++-- * frequencies for contexts and exemplars+-- | list of observation frequencies for a particular context, the order equals the order of the exemplars+--+-- >>> zipWith (\exe frq-> (exe,frq)) exemplars frqWalking+-- [(50 m,0),(100 m,2),(150 m,4),(300 m,6),(450 m,6),(1000 m,4),(5000 m,1),(10000 m,0)]+frqWalking= [0,2,4,6,6,4,1,0]+frqUphill= [0,2,3,0,0,1,1,0]+frqDriving= [0,1,3,1,1,2,2,2]+frqWalkingUphill= [4,3,2,1,0,0,0,0]+frqDrivingUphill= [0,2,1,5,6,7,8,5]+frqWalkingDriving= [0,0,0,0,0,0,0,0]+frqWalkingDrivingUphill= [0,0,0,0,0,0,0,0]++-- * wrap the basic types into the context type+-- | context type for walking+--+-- >>> ctxWalking+-- Ctx [Walking]+ctxWalking = Ctx [Walking]+ctxDriving = Ctx [Driving]+ctxUphill = Ctx [Uphill]++-- | example of an combined context of walking and uphill+--+-- >>> ctxWalkingUphill+-- Ctx [Walking, Uphill]+ctxWalkingUphill = Ctx [Walking, Uphill]+ctxDrivingUphill =   Ctx [Driving, Uphill]+ctxWalkingDriving =  Ctx [Walking, Driving]+ctxWalkingDrivingUphill =  Ctx [Walking,Driving,Uphill]++-- | top element of the lattice, equals the One context+--+-- >>> ctxOne+-- One [Ctx [Walking],Ctx [Driving],Ctx [Walking,Driving],Ctx [Uphill],Ctx [Walking,Uphill],Ctx [Driving,Uphill],Ctx [Walking,Driving,Uphill]]+ctxOne = top :: Context Transportation++-- | bottom element of the lattice, equals the Zero context+--+-- >>> ctxZero+-- Zero+ctxZero = Zero :: Context Transportation+++-- | produce a generator for the input contexts, this values are used by quickCheck+instance Arbitrary (Context Transportation) where+  -- | represents a list of all possible contexts+  arbitrary = elements [ ctxOne, ctxWalking, ctxDriving, ctxUphill+                 , ctxWalkingDriving, ctxWalkingUphill, ctxDrivingUphill+                 , ctxWalkingDrivingUphill, ctxZero]+++-- * initialization of experiences+-- | creates a multiset including all exemplars and frequency values for the context walking+--+-- >>>  printExperiences walkingExperiences+-- (6*)Exp (Ctx [Walking]) 450 m+-- |+-- +--(4*)Exp (Ctx [Walking]) 150 m+-- |  |+-- |  +--(2*)Exp (Ctx [Walking]) 100 m+-- |  |+-- |  +--(6*)Exp (Ctx [Walking]) 300 m+-- |+-- +--(1*)Exp (Ctx [Walking]) 5000 m+--    |+--    +--(4*)Exp (Ctx [Walking]) 1000 m+--    |+-- +--|+expWalking = createExperiencesForContext ctxWalking exemplars frqWalking++-- | creates the multiset for the context uphill+--+-- >>> printExperiences expUphill+-- (3*)Exp (Ctx [Uphill]) 150 m+-- |+-- +--(2*)Exp (Ctx [Uphill]) 100 m+-- |+-- +--(1*)Exp (Ctx [Uphill]) 5000 m+--    |+--    +--(1*)Exp (Ctx [Uphill]) 1000 m+--    |+--    +--|+expUphill = createExperiencesForContext ctxUphill exemplars frqUphill++-- | creates the multiset for the context driving+--+-- >>> printExperiences expDriving+-- (1*)Exp (Ctx [Driving]) 450 m+-- |+-- +--(3*)Exp (Ctx [Driving]) 150 m+-- |  |+-- |  +--(1*)Exp (Ctx [Driving]) 100 m+-- |  |+-- |  +--(1*)Exp (Ctx [Driving]) 300 m+-- |+-- +--(2*)Exp (Ctx [Driving]) 5000 m+--    |+--    +--(2*)Exp (Ctx [Driving]) 1000 m+--    |+--    +--(2*)Exp (Ctx [Driving]) 10000 m+expDriving = createExperiencesForContext ctxDriving exemplars frqDriving++expWalkingUphill = createExperiencesForContext ctxWalkingUphill exemplars frqWalkingUphill+expDrivingUphill = createExperiencesForContext ctxDrivingUphill exemplars frqDrivingUphill+expWalkingDriving = createExperiencesForContext ctxWalkingDriving exemplars frqWalkingDriving+expWalkingDrivingUphill= createExperiencesForContext ctxWalkingDrivingUphill exemplars frqWalkingDrivingUphill+++-- | resulting multiset including all experiences for all contexts+--+-- >>> printExperiences allExperiences+-- (1*)Exp (Ctx [Driving]) 450 m+-- |+-- +--(6*)Exp (Ctx [Walking]) 450 m+-- |  |+-- |  +--(4*)Exp (Ctx [Walking]) 150 m+-- |  |  |+-- |  |  +--(2*)Exp (Ctx [Walking]) 100 m+-- |  |  |+-- |  |  +--(6*)Exp (Ctx [Walking]) 300 m+-- |  |+-- |  +--(1*)Exp (Ctx [Walking,Uphill]) 300 m+-- |     |+-- |     +--(1*)Exp (Ctx [Walking]) 5000 m+-- |     |  |+-- |     |  +--(4*)Exp (Ctx [Walking]) 1000 m+-- |     |  |+-- |     |  +--(3*)Exp (Ctx [Walking,Uphill]) 100 m+-- |     |     |+-- |     |     +--(4*)Exp (Ctx [Walking,Uphill]) 50 m+-- |     |     |+-- |     |     +--(2*)Exp (Ctx [Walking,Uphill]) 150 m+-- |     |+-- |     +--(3*)Exp (Ctx [Driving]) 150 m+-- |        |+-- |        +--(1*)Exp (Ctx [Driving]) 100 m+-- |        |+-- |        +--(1*)Exp (Ctx [Driving]) 300 m+-- |+-- +--(6*)Exp (Ctx [Driving,Uphill]) 450 m+--    |+--    +--(2*)Exp (Ctx [Driving,Uphill]) 100 m+--    |  |+--    |  +--(2*)Exp (Ctx [Driving]) 5000 m+--    |  |  |+--    |  |  +--(2*)Exp (Ctx [Driving]) 1000 m+--    |  |  |+--    |  |  +--(2*)Exp (Ctx [Driving]) 10000 m+--    |  |+--    |  +--(1*)Exp (Ctx [Driving,Uphill]) 150 m+--    |     |+--    |     +--|+--    |     |+--    |     +--(5*)Exp (Ctx [Driving,Uphill]) 300 m+--    |+--    +--(3*)Exp (Ctx [Uphill]) 150 m+--       |+--       +--(8*)Exp (Ctx [Driving,Uphill]) 5000 m+--       |  |+--       |  +--(7*)Exp (Ctx [Driving,Uphill]) 1000 m+--       |  |+--       |  +--(5*)Exp (Ctx [Driving,Uphill]) 10000 m+--       |     |+--       |     +--|+--       |     |+--       |     +--(2*)Exp (Ctx [Uphill]) 100 m+--       |+--    +--(1*)Exp (Ctx [Uphill]) 5000 m+--          |+--          +--(1*)Exp (Ctx [Uphill]) 1000 m+--          |+--          +--+allExperiences = Mset.unions [expWalking+                        ,expUphill+                        ,expDriving+                        ,expWalkingUphill+                        ,expDrivingUphill+                        ,expWalkingDriving+                        ,expWalkingDrivingUphill]++++