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
| 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
<|> hyp >+< hyp <! OperatorMixedUp plusSymbol timesSymbol
where
hyp = hypotenuse False
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)