Assess.hs

-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me project team. This file is distributed under 
-- the terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------

module Task.TheatreRate.Assess where

  import Data.Monoid
  import Domain.Math.Data.Relation
  import Recognize.Data.Approach
  import Bayes.Evidence
  import Recognize.Data.Attribute hiding (Other)
  import Recognize.Data.Diagnosis as S
  import Recognize.Data.RuleId
  import Recognize.Data.Step
  import Recognize.Expr.Symbols
  import Recognize.SubExpr.Symbols
  import Recognize.Model.Assess
  import Recognize.Model.Connectives
  import Recognize.Model.EvidenceBuilder
  import Task.Network.TheatreRate

  assess' :: Diagnosis -> Evidence
  assess' sd =
    stringNode (apprtostring appr) ans2Strat <> --check which approach has been used
    answerCorrect 8 attrs ans2 <> --check if the answer is indeed 8
    generateEvidence buildStepsEvidence appr attrs
    where attrs = map (snd . getValue) $ steps sd
          appr  = approach sd
          apprtostring Algebraic = Just "Algebraic"
          apprtostring Numerical = Just "Numeric"
          apprtostring _         = Nothing

  buildStepsEvidence :: Approach -> EvBuilder ()
  buildStepsEvidence Algebraic = stepsABuilder
  buildStepsEvidence Numerical = stepsNBuilder
  buildStepsEvidence _             = return ()

  stepsABuilder :: EvBuilder ()
  stepsABuilder = do
    giveNodeAndCollect ans2Strat1Step21 $ withoutFailure (exists1 (Label "R1"))
    giveNodeAndCollect ans2Strat1Step22 $ withoutFailure (exists1 (Label "R2"))
    giveNodeAndCollect ans2Strat1Step3 $ withoutFailure ((exists1 (Label "setup equation")) <?>> (exists1 (Label "setup inequation")))
    --The equality path:
    giveNodeAndCollect ans2Strat1Step41 $ withoutFailure (exists1 (Label "setup equation"))
    giveNodeAndCollect ans2Strat1Step51 $ withoutFailure (exists1 (ARuleR Coverup_OneVar_Plus (wildcard .==. wildcard) (wildcard .==. wildcard)))
    giveNodeAndCollect ans2Strat1Step61 $ withoutFailure (exists1 (ARuleR Coverup_Times_Positive (wildcard .==. wildcard) (wildcard .==. wildcard)))
    --The inequality path:
    --We have to think about all options regarding the symbols < and >
    giveNodeAndCollect ans2Strat1Step42 $ withoutFailure (exists1 (Label "setup inequation"))
    giveNodeAndCollect ans2Strat1Step52 $ withoutFailure ((exists1 (ARuleR Coverup_OneVar_Plus (wildcard .<. wildcard) (wildcard .>. wildcard))) <?>> (exists1 (ARuleR Coverup_OneVar_Plus (wildcard .>. wildcard) (wildcard .<. wildcard)))
      <?>> (exists1 (ARuleR Coverup_OneVar_Plus (wildcard .>. wildcard) (wildcard .>. wildcard))) <?>> (exists1 (ARuleR Coverup_OneVar_Plus (wildcard .<. wildcard) (wildcard .<. wildcard))))
    giveNodeAndCollect ans2Strat1Step62 $ withoutFailure ((exists1 (ARuleR Coverup_Times_Positive (wildcard .<. wildcard) (wildcard .>. wildcard))) <?>> (exists1 (ARuleR Coverup_Times_Positive (wildcard .>. wildcard) (wildcard .<. wildcard)))
      <?>> (exists1 (ARuleR Coverup_Times_Positive (wildcard .>. wildcard) (wildcard .>. wildcard))) <?>> (exists1 (ARuleR Coverup_Times_Positive (wildcard .<. wildcard) (wildcard .<. wildcard))))

    giveNodeAndCollect ans2Strat1Step7 (exists1 (FinalAnswer 8))

  stepsNBuilder :: EvBuilder ()
  stepsNBuilder = do
    giveNodeAndCollect ans2Strat2Step1 $ withoutFailure (exists1 (LabelE "Try" newMagicNat))
    giveNodeAndCollect ans2Strat2Step2 $ withoutFailure (exists1 (LabelE "Try" 8))
    giveNodeAndCollect ans2Strat2Step3 (exists1 (FinalAnswer 8))