-----------------------------------------------------------------------------
-- 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.AreaAndExpression (areaAndExpression) where

import Control.Monad
import Data.Maybe
import Data.Semigroup
import Domain.LinearAlgebra.Matrix
import Domain.Math.Data.MultivariatePolynomial
import Domain.Math.Expr
import Domain.Math.Numeric.Views
import Ideas.Common.Library hiding (Recognizable, steps, parser, recognizer)
import Recognize.Data.Approach (Approach (Algebraic))
import Bayes.Evidence
import Recognize.Data.Attribute
import Recognize.Data.Math
import Recognize.Data.MathStoryProblem
import Recognize.Data.MathParserOutput
import Recognize.Data.Solution
import Recognize.Data.Step
import Recognize.Data.Diagnosis
import Recognize.Data.StringLexer
import Recognize.Parsing.Derived
import Recognize.Parsing.Interpretation
import Recognize.Recognizer
import Data.List
import Util.String
import qualified Data.Map as M
import Task.Network.AreaAndExpression

areaAndExpression :: MathStoryProblem
areaAndExpression = mathStoryProblem
   { problemId     = newId "areaandexpression"
   , processInputs = return . mergeInputs
   , analyzers     = [(mergedId, ana)]
   , inputFile     = Just "input/areaandexpression.csv"
   , networkFile   = Just "networks/AreaAndExpression.xdsl"
   , singleNetwork = network
   }
 where
   ana = analyzer
      { parser     = mathParser mempty . stringLexerOutput
      , recognizer = defaultRecognizer pDiagnosis . mathParserOutput
      , collector  = evidenceOfAbsence ans1 False . mconcat . map assessSteps . steps
      }

mergedId :: Id
mergedId = newId "areaandexpression.concatenated"

mergeInputs :: [Input] -> Input
mergeInputs is = Input mergedId $ map strBool $ concat
   [ searchFor (newId "08a")
   , searchFor (newId "08b")
   , [Right "0"]
   , searchFor (newId "08c")
   , searchFor (newId "08d")
   , searchFor (newId "08e")
   , searchFor (newId "08f")
   , searchFor (newId "08g")
   , [Right "0"]
   ]
 where
   strBool (Right s) | strToLower s == "true" = Right "1"
   strBool (Right s) | strToLower s == "false" = Right "0"
   strBool s = s

   searchFor k =
      maybe [Right ""] getInput (find ((== k) . getInputId) is)

assessSteps :: Step -> Evidence
assessSteps s | getId s == newId "s1" = ans1 .== stepCorrect
              | getId s == newId "s2" = ans1 .== stepCorrect
              | otherwise = ans1 .== False
 where stepCorrect = (any correctAttribute . snd . getValue) s
       correctAttribute (Other s) | s == "S1" = True
                                  | s == "S2" = True
                                  | otherwise = False
       correctAttribute _                     = False

correct1 :: Matrix Expr
correct1 = makeMatrix
 [ [0, 0, 0]
 , [1 , 1 , 1]
 , [0, 1 , 0]
 ]

correct2 :: Matrix Expr
correct2 = makeMatrix
 [ [0, 1, 0]
 , [0, 1 , 1]
 , [0, 1 , 0]
 ]

termMatrix :: Matrix Expr
termMatrix = makeMatrix
  [ [ x :*: y
    | y <- [Var "y", Var "x", 1]
    ]
  | x <- [Var "y", Var "x", Var "x"]
  ]

solution :: Matrix Expr
solution = mapMul correct1 termMatrix

mapMul :: Num a => Matrix a -> Matrix a -> Matrix a
mapMul a b = makeMatrix $ zipWith (zipWith (*)) (rows a) (rows b)

matrixToExpr :: Matrix Expr -> Expr
matrixToExpr = simplify (multivariatePolynomialViewWith rationalView) . to sumView . concat . rows

pDiagnosis :: InterpretationParser Diagnosis
pDiagnosis = (newDiagnosis Algebraic . singleton) <$>
          toStep (newId "S1")
                 (do x <- pReplicate 3 (pReplicate 3 pAnyExpr)
                     guard (all (\y -> y == 0 || y == 1) (concat x))
                     f (makeMatrix x))
 where
  f :: Matrix Expr -> InterpretationParser [Attribute]
  f x | x == correct1 = return [ Other "S1" ]
      | x == correct2 = return [ Other "S2" ]
      | otherwise = return $ fromMaybe [] $ do
          xp <- (toMultivariatePolynomial . matrixToExpr) (mapMul termMatrix x)
          yp <- (toMultivariatePolynomial . matrixToExpr) solution
          yss <- (mapM (\(fs,c) -> ((,) fs <$> match naturalView c) ) . M.toAscList . multivariatePolynomialToMap) yp
          xss <- (mapM (\(fs,c) -> ((,) fs <$> match naturalView c) ) . M.toAscList . multivariatePolynomialToMap) xp
          return (g xss yss)
  g :: [(Factors,Integer)] -- ^ The sorted (by factors) representation of factors and coefficients of the input term
    -> [(Factors,Integer)] -- ^ The sorted representation of factors and coefficients of the solution.
    -> [Attribute]
  g ((xf,xc) : xs) [] = Other (show (Nat xc :*: fromFactors xf) ++ " is incorrect") : g xs []
  g [] ((yf,yc) : ys) = Other (show (Nat yc :*: fromFactors yf) ++ " is missing") : g [] ys
  g xss@((xf,xc):xs) yss@((yf,yc):ys)
     | yf == xf , yc == xc = g xs ys  -- equivalent factors and terms
     | yf == xf , yc > xc = Other ("Missing "++ show (yc - xc) ++ " of " ++ show yf) : g xs ys
     | yf == xf , yc < xc = Other (show (xc - yc) ++ " too much of "++ show yf) : g xs ys
     | yf > xf = Other (show (Nat xc :*: fromFactors xf) ++ " is incorrect") : g xs yss
     | yf < xf = Other (show (Nat yc :*: fromFactors yf) ++ " is missing") : g xss ys
  g _ _ = []