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
}
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 :: [Interpretation]
-> [Interpretation]
-> 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
bigRectangle :: Interpretation
bigRectangle = interpret ((Var "a" + 5) * (Var "a" + Var "b"))
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