-----------------------------------------------------------------------------
-- 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.CarRental (carRental) where

import Control.Applicative
import Control.Monad
import Control.Monad.State hiding (state)
import qualified Data.Map as M
import Data.Maybe
import Data.Semigroup hiding (option)
import Domain.Math.Data.MultivariatePolynomial
import Domain.Math.Expr
import Domain.Math.Numeric.Views
import Ideas.Common.Library hiding (option, (|>), steps, parser, recognizer)
import Ideas.Text.HTML
import Ideas.Text.XML hiding (Attribute)
import qualified Ideas.Text.XML as I (toXML)
import Recognize.Data.Approach (Approach (Algebraic, Arithmetic, Graphical))
import Recognize.Data.MathStoryProblem
import Recognize.Data.Attribute
import Recognize.Data.MathParserOptions
import Recognize.Data.MathParserOutput
import Recognize.Data.Diagnosis
import Recognize.Data.StringLexer
import Recognize.Data.StringLexerOptions
import Recognize.Expr.Normalform
import Recognize.Data.Math
import Recognize.Parsing.Derived
import Recognize.Parsing.Parse
import Recognize.Parsing.Interpretation
import Recognize.Recognizer
import Util.Expr
import Bayes.Evidence
import Recognize.Data.Step
import Task.Network.CarRental

carRental :: MathStoryProblem
carRental = mathStoryProblem
   { problemId   = newId "carrental"
   , analyzers   = [(newId "03", ana)]
   , inputFile   = Just "input/carrental.csv"
   , networkFile = Just "networks/CarRental.xdsl"
   , singleNetwork = network
   }
 where
   ana = analyzer
      { lexer      = stringLexer stringLexerOptions {variableWhitelist = ["distance","dist","cost","afstand","kosten","prijs","éloignement","coût","km"]}
      , parser     = mathParser mathParserOptions {multByConcatenation = False} . stringLexerOutput
      , recognizer = defaultRecognizer pDiagnosis . mathParserOutput
      , collector  = evidenceOfAbsence ans1 False . myassess
      }

   myassess d = ans1Strat .== (if category d == Algebraic then "Algebraic" else "Numerical")
             <> ans1 .== any (\x -> let atts = snd (getValue x)
                                                            in elem Normalized atts
                                                            && getId x `elem` finalSteps
                                                            && not (any (liftM2 (||) isMistake isApproximation) atts)) (steps d)
             <> mconcat (map assessStep (steps d))
                              {-++ [Evidence { getEvName = "SolutionStepwise", evidence =
                                    if (any (`elem` (steps d)) (map newId ["area triangle","side small square","area small square"]))
                                    then 0
                                    else 1}]
                                    any (contains (=FinalStep, IsNormalized && no errors) steps d
                                    -}
finalSteps :: [Id]
finalSteps = map newId ["s6a","s9b","conclude"]

assessStep :: Step -> Evidence
assessStep s
   | getId s == newId "s3a" = ans1Strat1Step2  .== Just stepCorrect
   | getId s == newId "s4a" = ans1Strat1Step31 .== Just stepCorrect
   | getId s == newId "s5a" = ans1Strat1Step41 .== Just stepCorrect
   | getId s == newId "s6a" = ans1Strat1Step51 .== Just stepCorrect
   | getId s == newId "s7b" = ans1Strat1Step32 .== Just stepCorrect
   | getId s == newId "s8b" = ans1Strat1Step42 .== Just stepCorrect
   | getId s == newId "s9b" = ans1Strat1Step52 .== Just stepCorrect
   | getId s == newId "concludeEquation" = ans1Strat1Step6 .== Just stepCorrect
   | getId s == newId "concludeArithmetic" = ans1Strat2Step3 .== Just stepCorrect
   | getId s == newId "compute" || getId s == newId "relate"
     , Just n <- listToMaybe $ mapMaybe (\x -> case x of { CapturedWildcard _ i -> Just i; _ -> Nothing}) (snd (getValue s))
     , Just i <- match rationalView (simplify rationalView n)
     = let node | i == 92 = ans1Strat2Step2
                | otherwise = ans1Strat2Step1
       in node .== Just stepCorrect
   | otherwise = mempty
 where
   stepCorrect = not (hasMistakes s)


-- | This is a datatype that is private to this module; used only to make the
-- parsers read a bit easier and minimize the changes needed to make the new
-- models work.
data AlgebraicApproach = ApproachEquation | ApproachInequality deriving (Eq)

pTaskS3a :: InterpretationParser Step
pTaskS3a =
 pNamedStep (newId "s3a") (interpret $ wildcard "c") $
      interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (wildcard "d")
  <|> interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (Number 43) <! Other "M1"

pTaskS4a :: AlgebraicApproach -> InterpretationParser Step
pTaskS4a approach = case approach of
   ApproachEquation -> pStepEq (newId "s4a") a b
   ApproachInequality -> pStepStrongIneq' (newId "s7b") b a
 where
  a = interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (wildcard "d")
  b = interpret (Number 43)

pTaskS5a :: AlgebraicApproach -> InterpretationParser Step
pTaskS5a approach = case approach of
   ApproachEquation -> pStepEq (newId "s5a") a b
   ApproachInequality -> pStepStrongIneq' (newId "s8b") b a
 where
   a = (interpret (Number 0.25) >*< interpret (wildcard "d")) <|> interpret (Number 23)
   b = interpret (Number 43) >-< interpret (Number 20)

pTaskS6a :: AlgebraicApproach -> InterpretationParser Step
pTaskS6a approach = case approach of
   ApproachEquation -> pNamedStep (newId "s6a") a b
   ApproachInequality -> pStepStrongIneq' (newId "s9b") b a
 where
  a = interpret (wildcard "d")
  b =    interpret 4 >>*<< (interpret (Number 43) >-< interpret (Number 20))
    <|> (interpret (Number 43) >-< interpret (Number 20)   >*< interpret (Number 0.25)) <! Other "M2"
    <|> (interpret (Number 43) >*< interpret (Number 0.25) >-< interpret (Number 20))   <! Other "M3"
    <|> (interpret (Number 43) >-< interpret (Number 0.25) >-< interpret (Number 20))   <! Other "M4"

pEstimate :: InterpretationParser [Step]
pEstimate = do clearWildcard "i"
               clearWildcard "j"
               zs <- catMaybes <$> sequence
                [ option (pStepEq (newId "estimate") (interpret $ wildcard "d") (interpret (wildcard "i")))
                , Just <$> pSomewhere
                   (  pStepEq (newId "compute") (interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (wildcard "i")) (interpret (wildcard "j"))
                   |> pStep (newId "compute") (interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (wildcard "i"))
                   |> do (_, step) <- pStepIneq (newId "relate") (interpret (Number 20 + Number 0.25* wildcard "i") <|> interpret (wildcard "j")) (interpret (Number 43))
                         return step
                   )
                ]
               i <- getWildcard "i"
               let zs' = case i of
                          Just i' -> map (addAttribute (CapturedWildcard "i" i')) zs
                          _ -> zs
               j <- getWildcard "j"
               case j of
                 Just j' -> return (map (addAttribute (CapturedWildcard "j" j')) zs')
                 _ -> return zs'

pConclude :: Maybe AlgebraicApproach -> InterpretationParser [Step]
pConclude approach = pAnywhere (singleton <$> pNamedStep (newId label) (interpret $ wildcard "d")
             (   interpret (Number 92)
             <|> (interpret (wildcard "n") <|> interpret (wildcard "n") >*< interpret (Var "km")) <! Approximation
             )
            )
   where
   label = case approach of
      Just _ -> "concludeEquation"
      Nothing -> "concludeArithmetic"
      -- -- | approach == Just ApproachInequality = "concludeInequality"
      -- -- | approach == Nothing = "concludeArithmetic"

pArithmetic :: InterpretationParser [Step]
pArithmetic = ((\x -> maybe x (\y -> x ++ y)) . concat <$> many1' (pSomewhere pEstimate)) <*> option (pConclude Nothing)

pAlgebraic :: AlgebraicApproach -> InterpretationParser [Step]
pAlgebraic approach = (\x -> maybe x (\y -> x ++ y)) <$> nonEmpty (catMaybes <$> many' (choice'
        [ Just <$> pTaskS3a
        , Just <$> pTaskS4a approach
        , Just <$> pTaskS5a approach
        , Just <$> pTaskS6a approach
        , Nothing <$ skip
        ])) <*> (option $ pConclude (Just approach))

pTask :: InterpretationParser (Approach,[Step])
pTask = (,) Algebraic <$> pAlgebraic ApproachEquation
    <|> (,) Algebraic <$> pAlgebraic ApproachInequality
    <|> (,) Arithmetic <$> pArithmetic

pDiagnosis :: InterpretationParser Diagnosis
pDiagnosis = do addWildcardConstraint "d" isVariable
                addWildcardConstraint "c" isVariable
                addWildcardConstraint "i" isLiteral
                addWildcardConstraint "j" isLiteral
                addWildcardConstraint "n" (\n -> case match rationalView (simplify rationalView n) of
                                                  Just d -> isLiteral n && abs (d - 92) < 20
                                                  _ -> False)
                (c,st) <- withModulo (restoreWildcards . simplify (multivariatePolynomialViewWith (doubleRoundedView (roundDouble 2))) . wildcardsToVars) pTask
                state <- get
                return (newDiagnosis c st)
                --Previous versions logged "getMatchEnvironment state", might be useful for debugging.