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