{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-|
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
nStability : beta
Use case of the context algebra for the concept near and the contexts: walking, driving, uphill
-}
module Main where
import ConceptModel
import ContextLattice
import NearConcept
import NearContext
import NearExemplar
-- 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 $ typicalityForExemplarsInContext ctxOne M50 near
putStrLn "\nthe most probable distance is now: the distance with the highest probability"
print . typicalExemplarInContext ctxOne M50 $ near
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 $ typicalityForExemplarsInContext (ctxOne `meet` ctxWalking) M50 near
putStrLn "the most probable distance is now: the distance with the highest probability"
print . typicalExemplarInContext (ctxOne `meet` ctxWalking) M50 $ near
putStrLn "+++++++++++++++ adding a CONTEXT +++++++++++++++"
putStrLn "\nfrom LIDAR data we know that the user is walking uphill, what can also refine the concept"
print $ typicalityForExemplarsInContext (ctxOne `meet` ctxWalking `meet` ctxUphill) M50 near
putStrLn "\n the most probable exemplar influenced by the contexts: walking and uphill"
print .typicalExemplarInContext (ctxOne `meet` ctxWalking `meet` ctxUphill) M50 $ near
putStrLn "+++++++++++++++ SUMMARY +++++++++++++++"
putStrLn "\n To summarize, the typicality has changes without context:"
print . typicalExemplarInContext ctxOne M50 $ near
putStrLn "\n influenced by the context walking to:"
print . typicalExemplarInContext (ctxOne `meet` ctxWalking) M50 $ near
putStrLn "\n further refined and influenced by the context walking uphill, the most typical exemplar is:"
print . typicalExemplarInContext (ctxOne `meet` ctxWalking `meet` ctxUphill) M50 $ near
-- * test algebraic properties
-- | Idempotency test, prints the input values and the result
--
-- @
-- Context c `meet` Context c == Context c
-- @
testIdemPropertyPrinted = verboseCheck (propIdempotent :: Context NearContext -> Bool)
-- | Idempotency test, prints the result
--
-- @
-- Context c `meet` Context c == Context c
-- @
testIdemProperty = quickCheck (propIdempotent :: Context NearContext -> Bool)
-- | Commutative test,prints the input values and the result
--
-- @
-- Context x meet Context y == Context y meet Context x
-- @
testCommPropertyPrinted = verboseCheck (propCommutative :: Context NearContext -> Context NearContext -> Bool)
-- | Commutative test, prints the result
--
-- @
-- Context x meet Context y == Context y meet Context x
-- @
testCommProperty = quickCheck (propCommutative :: Context NearContext -> Context NearContext -> 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 NearContext -> Context NearContext -> Context NearContext-> 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 NearContext -> Context NearContext -> Context NearContext-> 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
nearWalking = filterConceptWithContext ctxWalking near
-- | 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
nearDriving = filterConceptWithContext ctxDriving near
-- | 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
nearDrivingUphill = filterConceptWithContext (ctxDrivingUphill `meet` ctxDriving) near
-- | sum the experiences for the context one
sumExp4Contexts ::((BoundedMeetSemiLattice NearContextLattice))=> [([NearContext],Int)]
sumExp4Contexts= zipWith (\sum ctx -> (ctx,sum)) s c
where s = map ((amountExperiences . flip filterConceptWithContext near). Ctx) c
c = extractContext ctxOne