{-# LANGUAGE TupleSections, FlexibleInstances #-}
module Task.AreaOfATriangle (areaOfATriangle) where
import Control.Applicative
import Control.Monad
import Data.List
import Data.Semigroup
import Domain.Math.Expr
import Ideas.Common.Library hiding ((|>), steps, parser, recognizer)
import Recognize.Data.MathParserOptions
import Recognize.Parsing.Derived
import Recognize.Data.Math
import Util.Expr
import Data.Bool
import Recognize.Data.Approach (Approach (Algebraic, Arithmetic))
import Recognize.Data.Attribute
import Recognize.Data.MathStoryProblem
import Recognize.Data.MathParserOutput
import Recognize.Data.Diagnosis
import Recognize.Data.StringLexer
import Recognize.Data.StringLexerOptions
import Recognize.Expr.Normalform
import Recognize.Parsing.Interpretation
import Recognize.Parsing.Parse
import Recognize.Recognizer
import Bayes.Evidence
import Recognize.Data.Step
import Bayes.Network
import Task.Network.AreaOfATriangle
areaOfATriangle :: MathStoryProblem
areaOfATriangle = mathStoryProblem
{ problemId = newId "areaofatriangle"
, analyzers = [ (newId "09a", ana9a)
, (newId "09b", ana9b)
, (newId "09c", ana9c)
]
, inputFile = Just "input/areaofatriangle.csv"
, networkFile = Just "networks/AreaOfATriangle.xdsl"
, singleNetwork = network
}
where
ana = analyzer
{ lexer = stringLexer stringLexerOptions {variableWhitelist = concatMap permutations ["abc","ab","bc","ac","bdef","cd","bf","de","fe"]}
, parser = mathParser mathParserOptions {multByConcatenation = False,convertToLowercase = True} . stringLexerOutput
}
ana9a = ana
{ recognizer = defaultRecognizer (pDiagnose pTaskQ1) . mathParserOutput
, collector = evidenceOfAbsence ans1 False .
(\d -> makeAnswer ans1 ["Q1.S1"] d
<> mconcat (map assessStep1 (steps d)))
}
ana9b = ana
{ recognizer = defaultRecognizer (pDiagnose pTaskQ2) . mathParserOutput
, collector = evidenceOfAbsence ans2 False .
(\d -> makeAnswer ans2 ["Q2.S1"] d
<> mconcat (map assessStep2 (steps d)))
}
ana9c = ana
{ recognizer = defaultRecognizer (pDiagnose pTaskQ3) . mathParserOutput
, collector = evidenceOfAbsence ans3 False .
(\d -> makeAnswer ans3 ["Q3.A3","Q3.S3"] d
<> ans3Strat .== bool "Algebraic" "Numeric" (any ((`elem` [newId "Q3.A1", newId "Q3.A2", newId "Q3.A3"]) . getId) (steps d))
<> mconcat (map assessStep3 (steps d)))
}
makeAnswer :: IsId a => Node Bool -> [a] -> Diagnosis -> Evidence
makeAnswer s fs d = s .== ind
where
ind = any (\stp -> let atts = snd (getValue stp)
in
getId stp `elem` map newId fs
&& not (any (liftM2 (||) isMistake isApproximation) atts)) (steps d)
assessStep1 :: Step -> Evidence
assessStep1 s
| getId s == newId "Q1.S1" = step .== Just stepCorrect
| otherwise = mempty
where
stepCorrect = not (hasMistakes s)
step | Normalized `elem` snd (getValue s) = ans1Strat1Step2
| otherwise = ans1Strat1Step1
assessStep2 :: Step -> Evidence
assessStep2 s
| getId s == newId "Q2.S1" = mconcat (map (.== Just stepCorrect) step)
| otherwise = mempty
where
stepCorrect = not (hasMistakes s)
step | Normalized `elem` snd (getValue s) = [ans2Strat1Step1, ans2Strat1Step2]
| otherwise = [ans2Strat1Step1]
assessStep3 :: Step -> Evidence
assessStep3 s
| getId s == newId "Q3.S1" =
ans3Strat1Step1 .== Just stepCorrect
| getId s == newId "Q3.S2" =
ans3Strat1Step2 .== Just stepCorrect
| getId s == newId "Q3.S3" =
ans3Strat1Step3 .== Just stepCorrect
| getId s == newId "Q3.A1" =
ans3Strat2Step1 .== Just stepCorrect
| getId s == newId "Q3.A2" =
ans3Strat2Step2 .== Just stepCorrect
| getId s == newId "Q3.A3" =
ans3Strat2Step3 .== Just stepCorrect
| otherwise =
mempty
where
stepCorrect = not (hasMistakes s)
ab :: Interpretation
ab = interpret 10 <|> interpret (Var "ab")
x :: Interpretation
x = interpret (Var "a")
<|> interpret (Var "x")
<|> interpret (Var "bc") <! Sloppiness
abc :: Interpretation
abc = (ab >*< x
<|> ab >+< x <! OperatorMixedUp plusSymbol timesSymbol <! Other "M6"
) >>/<< interpret 2
<|> ab >*< x <! Misconception Rectangle Triangle <! Other "M2"
<|> (ab >+< x) >*< interpret 2 <! Misconception Perimeter Area <! Other "M3"
<|> ((ab >+< x
<|> ab >^< interpret 2 >+< x >^< interpret 2) >^< (interpret 1 >/< interpret 2)) >^< interpret 2 <! Misconception Perimeter Area <! Other "M4"
<|> ((ab >*< x) >/< interpret 2) >^< interpret 3 <! Misconception Volume Area <! Other "M5"
pTaskQ1 :: InterpretationParser (Approach,[Step])
pTaskQ1 = (Algebraic,) <$> many' (pSomewhere $
pNamedStep (newId "Q1.S1") (interpret $ wildcard "abc") abc
|> withModulo nf (pNamedStep (newId "Q1.S1") (interpret $ wildcard "abc") (first sqrt <$> (interpret 10 >^< interpret 2 >+< x >^< interpret 2)))
)
|> (Arithmetic,) <$> pQ3Arithmetic
bf :: Interpretation
bf = interpret 2 <|> interpret (Var "bf")
cd :: Interpretation
cd = interpret 3 <|> interpret (Var "cd")
bdef :: Interpretation
bdef = bf >>*<< (x >>+<< cd)
<|> bf >*< x >*< cd <! OperatorMixedUp plusSymbol timesSymbol <! Other "M3"
<|> (bf >+< cd >+< x) >*< interpret 2 <! Misconception Perimeter Area <! Other "M4"
<|> bf >+< cd >+< x <! Misconception HalfPerimeter Area <! Other "M5"
<|> (interpret 5 >*< x <! IncorrectDistribution <! Other "M7")
pTaskQ2 :: InterpretationParser [Step]
pTaskQ2 = pAnyOf [pNamedStep (newId "Q2.S1") (interpret $ wildcard "bdef") bdef]
pTaskQ3 :: InterpretationParser (Approach, [Step])
pTaskQ3 = (,) Algebraic <$> pQ3Algebraic
|> (,) Arithmetic <$> pQ3Arithmetic
pQ3Arithmetic :: InterpretationParser [Step]
pQ3Arithmetic = pAnyOf
[ pStepEq (newId "Q3.A1") (interpret 5 >>*<< interpret (wildcard "x")) ((interpret 2 >*< interpret (wildcard "x")) >+< interpret 6)
, pStepStrongIneq' (newId "Q3.A1") (interpret 5 >>*<< interpret (wildcard "x")) ((interpret 2 >*< interpret (wildcard "x")) >+< interpret 6)
, pStepEq (newId "Q3.A2") (interpret 5 >>*<< interpret 2) ((interpret 2 >*< interpret 2) >+< interpret 6)
, pStepStrongIneq' (newId "Q3.A2") (interpret 5 >>*<< interpret 2) ((interpret 2 >*< interpret 2) >+< interpret 6)
, pNamedStep (newId "Q3.A3") (interpret $ wildcard "ans") (interpret 2)
]
pQ3Algebraic :: InterpretationParser [Step]
pQ3Algebraic = inLiberalEquationMode $ withModulo nfComAssoc $ pAnyOf
[ pStepEq (newId "Q3.S1") (interpret 5 >>*<< x) (interpret 2 >>*<< x >>+<< (interpret 2 >>*<< interpret 3 <|> interpret 6))
, pStepEq (newId "Q3.S2") (interpret 3 >>*<< x) (interpret 6)
, pStepEq (newId "Q3.S3") x (interpret 2)
]
|> (:[]) <$> pStepEq (newId "Q3.S1") abc bdef
class DiagnoseParser a where
getApproach :: a -> Approach
getSteps :: a -> [Step]
instance DiagnoseParser [Step] where
getApproach _ = Algebraic
getSteps = id
instance DiagnoseParser (Approach,[Step]) where
getApproach (a, _) = a
getSteps (_, a) = a
pDiagnose :: DiagnoseParser a => InterpretationParser a -> InterpretationParser Diagnosis
pDiagnose p = do addWildcardConstraint "x" isLiteral
addWildcardConstraint "def" isVariable
z <- p
guard (not . Prelude.null . getSteps $ z)
return $ newDiagnosis (getApproach z) (getSteps z)