{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-|
Module      : NearConcept
Description : declaring all functions
License     : GPL-3
Maintainer  : hahn@geoinfo.tuwien.ac.at
Stability   : Declares

define most functions and frequency values
-}
module NearConcept (near, ctxOne, ctxWalking, ctxDriving, ctxUphill
                 , ctxWalkingDriving, ctxWalkingUphill, ctxDrivingUphill
                 , ctxWalkingDrivingUphill, ctxZero) where

import           ConceptModel
import           ContextLattice
import           NearContext
import           NearExemplar

import           Algebra.Lattice
import qualified Data.MultiSet   as Mset
import           Test.QuickCheck

-- | instance declaration for the near context
instance ConceptContextModel NearContext NearExemplar

-- * 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 :: NearContextLattice

-- | bottom element of the lattice, equals the Zero context
--
-- >>> ctxZero
-- Zero
ctxZero = Zero :: NearContextLattice


-- | produce a generator for the input contexts, this values are used by quickCheck
instance Arbitrary (Context NearContext) 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 = createConceptForContext 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 = createConceptForContext 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 = createConceptForContext ctxDriving exemplars frqDriving

expWalkingUphill = createConceptForContext ctxWalkingUphill exemplars frqWalkingUphill
expDrivingUphill = createConceptForContext ctxDrivingUphill exemplars frqDrivingUphill
expWalkingDriving = createConceptForContext ctxWalkingDriving exemplars frqWalkingDriving
expWalkingDrivingUphill= createConceptForContext 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
--          |
--          +--
near = unionsConceptsForDiffContexts [expWalking
                        ,expUphill
                        ,expDriving
                        ,expWalkingUphill
                        ,expDrivingUphill
                        ,expWalkingDriving
                        ,expWalkingDrivingUphill]