-----------------------------------------------------------------------------
-- 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.MakingASquare (makingASquare) where

import Control.Monad.State
import Control.Applicative
import Data.Maybe
import Data.Semigroup
import Domain.Math.Expr
import Recognize.Data.Math
import Ideas.Common.Id
import Recognize.Data.Approach (Approach (Algebraic,Arithmetic))
import Recognize.Data.Attribute
import Recognize.Data.MathParserOutput
import Recognize.Data.Diagnosis
import Recognize.Data.MathStoryProblem
import Recognize.Data.StringLexer
import Recognize.Data.StringLexerOptions
import Recognize.Parsing.Derived
import Recognize.Parsing.Interpretation
import Recognize.Parsing.Parse
import Recognize.Data.Step
import Util.Expr
import Recognize.Recognizer
import Bayes.Evidence
import Task.Network.MakingASquare

makingASquare :: MathStoryProblem
makingASquare = mathStoryProblem
   { problemId   = newId "makingasquare"
   , analyzers   = [(newId "01", ana)]
   , inputFile   = Just "input/makingasquare.csv"
   , networkFile = Just "networks/MakingASquare.xdsl"
   , singleNetwork = network
   }
 where
   ana = analyzer
      { lexer      = stringLexer stringLexerOptions {replaceXByMultiplication = True}
      , recognizer = defaultRecognizer pDiagnosis . mathParserOutput
      , collector  = evidenceOfAbsence ans1 False . myassess
      }
   myassess d =
      mconcat (map assessStep (steps d)) <>
      ans1Strat .== (if (any (`elem` (map getId $ steps d)) (map newId ["area triangle","side small square","area small square"])) then "Algebraic1" else "Algebraic2")


assessStep :: Step -> Evidence
assessStep s
   | getId s == newId "area triangle" =
        ans1Strat1Step1 .== Just stepCorrect
   | getId s == newId "side small square" =
        ans1Strat1Step2 .== Just stepCorrect
   | getId s == newId "area small square" =
        ans1Strat1Step3 .== Just stepCorrect
   | getId s == newId "area big square Sum"
             , isJust (getExpr . fst . getValue $ s)
             , evalState (isSubExprOf defaultModulo (fromJust . getExpr . fst . getValue $ s) ((Var "b" - Var "a") ** Nat 2)) (mempty,mempty) =
        ans1Strat1Step4 .== Just stepCorrect <> ans1 .== stepCorrect -- getExpr
   | getId s == newId "area big square Sum", Normalized `elem` (snd . getValue $ s) =
        ans1Strat1Step6 .== Just stepCorrect <> ans1 .== stepCorrect
   | getId s == newId "area big square Sum" =
        ans1Strat1Step5 .== Just stepCorrect <> ans1 .== stepCorrect
   | getId s == newId "hypotenuse" =
        ans1Strat2Step1 .== Just stepCorrect
   | getId s == newId "area big square Expr", Normalized `elem` (snd . getValue $ s) =
        ans1Strat2Step3 .== Just stepCorrect <> ans1 .== stepCorrect
   | getId s == newId "area big square Expr" =
        ans1Strat2Step2 .== Just stepCorrect <> ans1 .== stepCorrect
   | otherwise =
        mempty
 where
   stepCorrect = not (hasMistakes s)

areaTriangle :: Interpretation
areaTriangle = pure ((Var "a" * Var "b") / 2, [])

areaTriangle' :: Interpretation
areaTriangle' = areaTriangle
            <|> pure (Var "a" * Var "b", [Other "M1: triangle misconception"])

sideSmallSquare :: Interpretation
sideSmallSquare = pure (Var "b" - Var "a", [])
              <|> pure (Var "a" - Var "b", [InvalidCommutativity minusSymbol])

areaSmallSquare :: Interpretation
areaSmallSquare = squared sideSmallSquare
              <|> interpret (Var "a" * Var "b") <! CommonMistake

areaBigSquare :: Interpretation
areaBigSquare = [ (4*t+a, ts ++ as)
                | (t,ts) <- areaTriangle'
                , (a,as) <- areaSmallSquare]
            <|> interpret (Var "b") >*< interpret (Var "b") >-< interpret 4 >*< areaTriangle' <! Misconception Rectangle Rectangle

hypotenuse :: Bool -> Interpretation
hypotenuse recognizeForgottenRoot = case recognizeForgottenRoot of
   True -> hyp <|> interpret (Var "a" ** 2 + Var "b" ** 2) <! ForgetSym rootSymbol
   False -> hyp

   where
   hyp = interpret (sqrt (Var "a" ** 2 + Var "b" ** 2))
         <|> interpret (Var "a" + Var "b") <! Other "M2: hypotenuse misconception"


areaBigSquareA :: Interpretation
areaBigSquareA = squared hyp
             <|> hyp >>*<< hyp -- explicitly included because hypothesis is actually not a multivariatepolynomial (according to our spec; that does not allow division by multivariate polynomials) (because it is a root)
             <|> hyp >+< hyp <! OperatorMixedUp plusSymbol timesSymbol

   where
   hyp = hypotenuse False

--These steps have to be parsed so that the hyp step cannot be detected twice. First see if both have been completed: if not, see
--if one of them has been completed.
pAlgebraic :: InterpretationParser (Approach,[Step])
pAlgebraic = fmap ((,) Algebraic) $
   do {x <- hyp True;  y <- bigsq; _ <- many' skip; return [x,y]} |>
   do {y <- bigsq;     _ <- many' skip; return [y]} |>
   do {x <- hyp False; _ <- many' skip; return [x]}
   --
   where
     hyp recognizeForgottenRoot = pSomewhere (pNamedStep (newId "hypotenuse") (interpret $ wildcard "hyp") (hypotenuse recognizeForgottenRoot))
     bigsq = pSomewhere (pNamedStep (newId "area big square Expr") (interpret $ wildcard "A") areaBigSquareA)

pArithmetic :: InterpretationParser (Approach,[Step])
pArithmetic = (,) Arithmetic <$> pAnyOf
  [ pNamedStep (newId "area triangle") (interpret $ wildcard "at") areaTriangle
  , pNamedStep (newId "side small square") (interpret $ wildcard "sss") sideSmallSquare
  , pNamedStep (newId "area small square") (interpret $ wildcard "ass") areaSmallSquare
  , pNamedStep (newId "area big square Sum") (interpret $ wildcard "A") areaBigSquare
  ]

pDiagnosis :: InterpretationParser Diagnosis
pDiagnosis = addWildcardConstraint "at" isDefinition
          >> addWildcardConstraint "ass" isDefinition
          >> addWildcardConstraint "sss" isDefinition
          >> addWildcardConstraint "hyp" isDefinition
          >> (pAlgebraic <|> pArithmetic)
          >>= \(c,stps) -> return (newDiagnosis c stps)