{-# 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