{-# LANGUAGE TupleSections, FlexibleInstances #-} ----------------------------------------------------------------------------- -- 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.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 --elem Normalized atts && -- the final answer is --still correct even if it is not normalized 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") -- old variable name <|> interpret (Var "bc") *< x <|> ab >+< x >/<< interpret 2 <|> ab >*< x (ab >+< x) >*< interpret 2 ((ab >+< x <|> ab >^< interpret 2 >+< x >^< interpret 2) >^< (interpret 1 >/< interpret 2)) >^< interpret 2 ((ab >*< x) >/< interpret 2) >^< interpret 3 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 (bf >+< cd >+< x) >*< interpret 2 bf >+< cd >+< x (interpret 5 >*< x 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) ] -- divide both sides by 10: 0.5x*10=2x+6 0.5x=0.2x+0.6 0.3x=0.6 x=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)