-----------------------------------------------------------------------------
-- 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.RectangleArea (rectangleArea) where

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

rectangleArea :: MathStoryProblem
rectangleArea = mathStoryProblem
   { problemId   = newId "rectanglearea"
   , analyzers   = [ (newId "06a", ana6a)
                   , (newId "06b", ana6b)
                   , (newId "06c", ana6c)
                   ]
   , inputFile   = Just "input/rectanglearea.csv"
   , networkFile = Just "networks/RectangleArea.xdsl"
   , singleNetwork = network
   }
 where
   ana = analyzer { parser = mathParser mathParserOptions {convertToLowercase = True} . stringLexerOutput }
   ana6a = ana
      { recognizer = defaultRecognizer (pDiagnose pTaskQ1) . mathParserOutput
      , collector  = evidenceOfAbsence ans1 False . mconcat . map assessStep1 . steps
      }
   ana6b = ana
      { recognizer = defaultRecognizer (pDiagnose pTaskQ2) . mathParserOutput
      , collector  = evidenceOfAbsence ans2 False . mconcat . map assessStep2 . steps
      }
   ana6c = ana
      { recognizer = defaultRecognizer (pDiagnose pTaskQ3) . mathParserOutput
      , collector  = evidenceOfAbsence ans3 False . mconcat . map assessStep3 . steps
      }

--finalSteps :: [Id]
--finalSteps = map newId ["Big rectangle"]

assessStep1 :: Step -> Evidence
assessStep1 s | getId s == newId "Big rectangle" = ans1Strat1Step1 .== Just stepCorrect <> ans1 .== stepCorrect
              | otherwise = mempty
 where
   stepCorrect = not (hasMistakes s)

assessStep2 :: Step -> Evidence
assessStep2 s | getId s == newId "TopLeft"     = ans2Strat1Step11 .== Just stepCorrect
              | getId s == newId "TopRight"    = ans2Strat1Step12 .== Just stepCorrect
              | getId s == newId "BottomLeft"  = ans2Strat1Step13 .== Just stepCorrect
              | getId s == newId "BottomRight" = ans2Strat1Step14 .== Just stepCorrect
              | getId s == newId "Big rectangle sum" = ans2Strat1Step2 .== Just stepCorrect <> ans2 .== stepCorrect
              | otherwise = mempty
 where
   stepCorrect = not (hasMistakes s)

assessStep3 :: Step -> Evidence
assessStep3 s
   | getId s == newId "Big rectangle equation" = ans3Strat1Step1 .== Just stepCorrect <> ans3 .== stepCorrect
   | otherwise = mempty
 where
   stepCorrect = not (hasMistakes s)

-- | @rectangleAreaByParts xs ys@ represents correct and erroneous representations of a rectangle.
rectangleAreaByParts :: [Interpretation]  -- ^ expressions of length on x axis
                     -> [Interpretation]  -- ^ expressions of length on y axis
                     -> Interpretation
rectangleAreaByParts xs ys = sum'
  [    a >*< b
   <|> a >+< a >+< b >+< b <! Misconception Perimeter Area
  | a <- xs
  , b <- ys
  ]
  <|> interpret 2 >*< sum' xs >+< interpret 2 >*< sum' ys <! Misconception Perimeter Area
  <|> sum' xs >*< sum' xs <! Misconception Square Rectangle
  <|> sum' ys >*< sum' ys <! Misconception Square Rectangle

areaTL,areaTR,areaBL,areaBR :: Interpretation
areaTL = squared (interpret (Var "a"))
areaTR = interpret (5 * Var "a")
     <|> interpret (2*(5 + Var "a")) <! Misconception Perimeter Area
areaBL = interpret (Var "a" * Var "b")
     <|> interpret (2* (Var "a" + Var "b")) <! Misconception Perimeter Area
areaBR = interpret (5 * Var "b")
     <|> interpret (2 * (5 + Var "b")) <! Misconception Perimeter Area

--The rectangle as calculated in Q1
bigRectangle :: Interpretation
bigRectangle = interpret ((Var "a" + 5) * (Var "a" + Var "b"))

--The rectangle as calculated in Q2
bigRectangleSum :: Interpretation
bigRectangleSum = sum' [areaTL, areaTR, areaBL, areaBR]
           <|> sum'' [interpret 5, interpret (Var "a")] >>*<< sum'' [interpret (Var "a"), interpret (Var "b")]
           <|> rectangleAreaByParts [interpret 5, interpret (Var "a")] [interpret (Var "a"), interpret (Var "b")]
           <|> interpret (Var "a" * Var "a" + 5 * Var "b") <! Other "M3" <! IncorrectFactorization

pTaskQ1 :: InterpretationParser [Step]
pTaskQ1 = pAnywhere $ (:[]) <$> pNamedStep (newId "Big rectangle") (interpret $ wildcard "bigRectangle") bigRectangle

pTaskQ2 :: InterpretationParser [Step]
pTaskQ2 = catMaybes <$> many' (choice'
          [ Just <$> pNamedStep (newId "TopLeft") (interpret $ wildcard "tl") areaTL
          , Just <$> pNamedStep (newId "TopRight") (interpret $ wildcard "tr") areaTR
          , Just <$> pNamedStep (newId "BottomLeft") (interpret $ wildcard "bl") areaBL
          , Just <$> pNamedStep (newId "BottomRight") (interpret $ wildcard "br") areaBR
          , Just <$> pNamedStep (newId "Big rectangle sum") (interpret $ wildcard "bigRectangleSum") bigRectangleSum
          , Nothing <$ skip
          ])

pTaskQ3 :: InterpretationParser [Step]
pTaskQ3 = pAnyOf [pStepEq (newId "Big rectangle equation") bigRectangle bigRectangleSum]

pDiagnose :: InterpretationParser [Step] -> InterpretationParser Diagnosis
pDiagnose p = do addWildcardConstraint "tl" isDefinition
                 addWildcardConstraint "tr" isDefinition
                 addWildcardConstraint "br" isDefinition
                 addWildcardConstraint "bl" isDefinition
                 x <- p
                 guard (not . Prelude.null $ x)
                 return $ newDiagnosis Algebraic x