{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-|
Module      : ConceptModel
Description : connects the context Lattice with observation frequencies of exemplars using a multiset
Maintainer  : hahn@geoinfo.tuwien.ac.at
Stability   : beta

This module implements the necessary functions to model a concept influenced by several contexts. The concept is represented by several exemplars. For each influencing context the exemplars have different observation frequency. The connection from exemplars and context is modeled by the data type Experience. Each Experience can be made several times where the amount is hold by a Multiset.
-}
module ConceptModel (Experience(..)
                    , Concept(..)
                    , Probability
                    ,ConceptContextModel
                    ,createConceptForContext
                    ,typicalityForExemplarsInContext
                    ,typicalExemplarInContext
                    ,printConcept
                    ,unionsConceptsForDiffContexts
                    ,filterConceptWithContext
                    ,amountExperiences) where

import           ContextLattice

import           Algebra.Enumerable
import qualified Data.Function      as F
import qualified Data.List          as L
import qualified Data.MultiSet      as Mset

-- | Each experience is formed by a exemplar of type e and a context c this exemplar was observed at.
data Experience c e =
  -- | constructor;  establishes an experience from a context and an exemplar
  Exp c e deriving (Ord, Show, Eq)

-- | All experiences are hold in a multiset
type Concept c e = Mset.MultiSet (Experience c e)

-- | type synonym for better readability
type Probability = Float

-- | the class defines the necessary functions needed for the context algebra
class (Ord c, Ord e, Show c, Show e)=> ConceptContextModel c e where

 -- | combines the observation amount of exemplars for one context
 createConceptForContext :: (Show c,Ord c, Show e,Ord e) =>
  (Context c)      -- ^  context in which the experiences were made
  -> [e] -- ^  exemplars which are observed
  -> [Int] -- ^  amount of observations for one exemplar in this context
  -> Concept (Context c) e -- ^  resulting concept with the given experiences
 createConceptForContext context exemplars amounts = Mset.unions $zipWith manyfoldExperiences experiencesOnce amounts
   where experiencesOnce = map (Exp context) exemplars

 -- | If an experience is made several times the amount can be specified by the @amount@
 manyfoldExperiences ::  (Ord c, Show c, Ord e, Show e) =>
  Experience (Context c) e  -- ^  experience that is observed several times
  -> Int   -- ^  amount of observations of the experience
  -> Concept (Context c) e -- ^ concept represented by an amount of experiences
 manyfoldExperiences exp amount= Mset.insertMany exp amount Mset.empty

 -- | calculates the amount of experiences that are present for the concept
 amountExperiences ::
  Concept (Context c) e -- ^ concept including experinces
  -> Int -- ^ amount of experiences
 amountExperiences = Mset.size

 -- | unions the experiences stored for one concept for different contexts
 unionsConceptsForDiffContexts :: (Ord e, Ord c) =>
  [Concept (Context c) e] -- ^ list of conceptualizations holding experiences for different contexts
  -> Concept (Context c) e -- ^ union of the experiences holding now all experiences for all contexts
 unionsConceptsForDiffContexts  = Mset.unions

 -- | filters a concept for a context, gets a concept for a finer context,
 -- the context c has to be more finer than the context that are included in the concept
 filterConceptWithContext :: ((Enumerable c), Enumerable (Context c),Ord e, Eq c,Ord c) =>
  Context c                      -- ^ context used to filter the experiences
  -> Concept (Context c) e   -- ^ experiences to filter
  -> Concept (Context c) e   -- ^ filtered experiences, more finer experiences are returned
 filterConceptWithContext context concept = Mset.unions . L.map (\fctx -> (Mset.filter (\(Exp c1 _)-> c1 == fctx ) concept ) )  $ allfinerContexts
  where allfinerContexts = getFinerContexts context


 -- | returns a probability of an exemplar observed in a context for the given experiences
 typicalityofExemplarInContext ::((Enumerable c), Enumerable (Context c),Ord e,Ord c)=>
  Experience (Context c) e        -- ^ exemplar and context to look for
  -> Concept (Context c) e    -- ^ concept hoding experiences that are considered
  -> Probability                -- ^ probability of the exemplar in this context for the given concept
 typicalityofExemplarInContext (Exp context exemplar) concept = if amountContext==0 then 0
   else amountExemplar /amountContext
    where observationAmounttForContext = amountExperiences experiencesForContext;
          exemplarOservationAmountForContext = amountExperiences $ filterExemplars exemplar experiencesForContext;
          experiencesForContext = filterConceptWithContext context concept
          amountExemplar= fromIntegral exemplarOservationAmountForContext
          amountContext = fromIntegral observationAmounttForContext

 -- * functions to print and export
 -- | returns the typicality distribution for each exemplar in the context c, the type e is only used as type parameter
 typicalityForExemplarsInContext :: (Ord c, Ord e,Enum e,Bounded e,(Enumerable c), Enumerable (Context c))=>
  Context c  -- ^ context the distribution is made for
  -> e         -- ^ exemplar type, used as type parameter
  -> Concept (Context c) e -- ^ concept with the experiences
  -> [(e,Probability)] -- ^ returned distribution
 typicalityForExemplarsInContext context exemplar concept=  map (\e ->(e, typicalityofExemplarInContext (Exp context e) concept) ) exemplars
  where exemplars= enumFromTo minBound $ maxBound `asTypeOf` exemplar

 -- | returns the typical exemplar of a concept for the context
 typicalExemplarInContext :: (Ord c, Ord e,Enum e,Bounded e,(Enumerable c), Enumerable (Context c))=>
  Context c  -- ^ context the distribution is made for
  -> e         -- ^ exemplar type, used as type parameter
  -> Concept (Context c) e -- ^ concept with the experiences
  -> (e, Probability) -- ^ tupel with the highest probability value
 typicalExemplarInContext context exemplar concept = L.maximumBy (compare `F.on` snd) $ typicalityForExemplarsInContext context exemplar concept


 -- | returns experiences for the exemplar given in the first argument @e@
 -- in quantum mechanics called projector
 filterExemplars:: (Ord c, Ord e) =>
  e                   -- ^ exemplar used to filter the experiences
  -> Concept (Context c) e  -- ^ concept that are filtered
  -> Concept (Context c) e  -- ^ concept including experiences for the exemplar e
 filterExemplars exemplar = Mset.filter (\(Exp _ actualExemplar)-> exemplar ==actualExemplar)


 -- | converts the experiences of the concept to a IO()
 printConcept :: (Show e, Show c) =>
  Concept c e -- ^  experiences of the concept to print
  -> IO() -- ^ returned IO()
 printConcept concept = putStrLn $ Mset.showTreeWith True True concept


 -- * functions for further development of the model
 -- | adds the @new@ experience to the given experiences
 addExperience :: (Ord c,Ord e) =>
  Experience c e      -- ^  new experience to add
  -> Concept c e  -- ^  given concept where to add the new experience
  -> Concept c e  -- ^  resulting concept including the new and the given experiences
 addExperience = Mset.insert


 forgetExperience:: (Ord c,Ord e) =>
  Experience c e      -- ^  new experience to add
  -> Concept c e  -- ^  given concept where to add the new experience
  -> Concept c e  -- ^  resulting concept including the new and the given experiences
 forgetExperience = Mset.delete