module Task.CarRental (carRental) where
import Control.Applicative
import Control.Monad
import Control.Monad.State hiding (state)
import qualified Data.Map as M
import Data.Maybe
import Data.Semigroup hiding (option)
import Domain.Math.Data.MultivariatePolynomial
import Domain.Math.Expr
import Domain.Math.Numeric.Views
import Ideas.Common.Library hiding (option, (|>), steps, parser, recognizer)
import Ideas.Text.HTML
import Ideas.Text.XML hiding (Attribute)
import qualified Ideas.Text.XML as I (toXML)
import Recognize.Data.Approach (Approach (Algebraic, Arithmetic, Graphical))
import Recognize.Data.MathStoryProblem
import Recognize.Data.Attribute
import Recognize.Data.MathParserOptions
import Recognize.Data.MathParserOutput
import Recognize.Data.Diagnosis
import Recognize.Data.StringLexer
import Recognize.Data.StringLexerOptions
import Recognize.Expr.Normalform
import Recognize.Data.Math
import Recognize.Parsing.Derived
import Recognize.Parsing.Parse
import Recognize.Parsing.Interpretation
import Recognize.Recognizer
import Util.Expr
import Bayes.Evidence
import Recognize.Data.Step
import Task.Network.CarRental
carRental :: MathStoryProblem
carRental = mathStoryProblem
{ problemId = newId "carrental"
, analyzers = [(newId "03", ana)]
, inputFile = Just "input/carrental.csv"
, networkFile = Just "networks/CarRental.xdsl"
, singleNetwork = network
}
where
ana = analyzer
{ lexer = stringLexer stringLexerOptions {variableWhitelist = ["distance","dist","cost","afstand","kosten","prijs","éloignement","coût","km"]}
, parser = mathParser mathParserOptions {multByConcatenation = False} . stringLexerOutput
, recognizer = defaultRecognizer pDiagnosis . mathParserOutput
, collector = evidenceOfAbsence ans1 False . myassess
}
myassess d = ans1Strat .== (if category d == Algebraic then "Algebraic" else "Numerical")
<> ans1 .== any (\x -> let atts = snd (getValue x)
in elem Normalized atts
&& getId x `elem` finalSteps
&& not (any (liftM2 (||) isMistake isApproximation) atts)) (steps d)
<> mconcat (map assessStep (steps d))
finalSteps :: [Id]
finalSteps = map newId ["s6a","s9b","conclude"]
assessStep :: Step -> Evidence
assessStep s
| getId s == newId "s3a" = ans1Strat1Step2 .== Just stepCorrect
| getId s == newId "s4a" = ans1Strat1Step31 .== Just stepCorrect
| getId s == newId "s5a" = ans1Strat1Step41 .== Just stepCorrect
| getId s == newId "s6a" = ans1Strat1Step51 .== Just stepCorrect
| getId s == newId "s7b" = ans1Strat1Step32 .== Just stepCorrect
| getId s == newId "s8b" = ans1Strat1Step42 .== Just stepCorrect
| getId s == newId "s9b" = ans1Strat1Step52 .== Just stepCorrect
| getId s == newId "concludeEquation" = ans1Strat1Step6 .== Just stepCorrect
| getId s == newId "concludeArithmetic" = ans1Strat2Step3 .== Just stepCorrect
| getId s == newId "compute" || getId s == newId "relate"
, Just n <- listToMaybe $ mapMaybe (\x -> case x of { CapturedWildcard _ i -> Just i; _ -> Nothing}) (snd (getValue s))
, Just i <- match rationalView (simplify rationalView n)
= let node | i == 92 = ans1Strat2Step2
| otherwise = ans1Strat2Step1
in node .== Just stepCorrect
| otherwise = mempty
where
stepCorrect = not (hasMistakes s)
data AlgebraicApproach = ApproachEquation | ApproachInequality deriving (Eq)
pTaskS3a :: InterpretationParser Step
pTaskS3a =
pNamedStep (newId "s3a") (interpret $ wildcard "c") $
interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (wildcard "d")
<|> interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (Number 43) <! Other "M1"
pTaskS4a :: AlgebraicApproach -> InterpretationParser Step
pTaskS4a approach = case approach of
ApproachEquation -> pStepEq (newId "s4a") a b
ApproachInequality -> pStepStrongIneq' (newId "s7b") b a
where
a = interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (wildcard "d")
b = interpret (Number 43)
pTaskS5a :: AlgebraicApproach -> InterpretationParser Step
pTaskS5a approach = case approach of
ApproachEquation -> pStepEq (newId "s5a") a b
ApproachInequality -> pStepStrongIneq' (newId "s8b") b a
where
a = (interpret (Number 0.25) >*< interpret (wildcard "d")) <|> interpret (Number 23)
b = interpret (Number 43) >-< interpret (Number 20)
pTaskS6a :: AlgebraicApproach -> InterpretationParser Step
pTaskS6a approach = case approach of
ApproachEquation -> pNamedStep (newId "s6a") a b
ApproachInequality -> pStepStrongIneq' (newId "s9b") b a
where
a = interpret (wildcard "d")
b = interpret 4 >>*<< (interpret (Number 43) >-< interpret (Number 20))
<|> (interpret (Number 43) >-< interpret (Number 20) >*< interpret (Number 0.25)) <! Other "M2"
<|> (interpret (Number 43) >*< interpret (Number 0.25) >-< interpret (Number 20)) <! Other "M3"
<|> (interpret (Number 43) >-< interpret (Number 0.25) >-< interpret (Number 20)) <! Other "M4"
pEstimate :: InterpretationParser [Step]
pEstimate = do clearWildcard "i"
clearWildcard "j"
zs <- catMaybes <$> sequence
[ option (pStepEq (newId "estimate") (interpret $ wildcard "d") (interpret (wildcard "i")))
, Just <$> pSomewhere
( pStepEq (newId "compute") (interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (wildcard "i")) (interpret (wildcard "j"))
|> pStep (newId "compute") (interpret (Number 20) >+< interpret (Number 0.25) >*< interpret (wildcard "i"))
|> do (_, step) <- pStepIneq (newId "relate") (interpret (Number 20 + Number 0.25* wildcard "i") <|> interpret (wildcard "j")) (interpret (Number 43))
return step
)
]
i <- getWildcard "i"
let zs' = case i of
Just i' -> map (addAttribute (CapturedWildcard "i" i')) zs
_ -> zs
j <- getWildcard "j"
case j of
Just j' -> return (map (addAttribute (CapturedWildcard "j" j')) zs')
_ -> return zs'
pConclude :: Maybe AlgebraicApproach -> InterpretationParser [Step]
pConclude approach = pAnywhere (singleton <$> pNamedStep (newId label) (interpret $ wildcard "d")
( interpret (Number 92)
<|> (interpret (wildcard "n") <|> interpret (wildcard "n") >*< interpret (Var "km")) <! Approximation
)
)
where
label = case approach of
Just _ -> "concludeEquation"
Nothing -> "concludeArithmetic"
pArithmetic :: InterpretationParser [Step]
pArithmetic = ((\x -> maybe x (\y -> x ++ y)) . concat <$> many1' (pSomewhere pEstimate)) <*> option (pConclude Nothing)
pAlgebraic :: AlgebraicApproach -> InterpretationParser [Step]
pAlgebraic approach = (\x -> maybe x (\y -> x ++ y)) <$> nonEmpty (catMaybes <$> many' (choice'
[ Just <$> pTaskS3a
, Just <$> pTaskS4a approach
, Just <$> pTaskS5a approach
, Just <$> pTaskS6a approach
, Nothing <$ skip
])) <*> (option $ pConclude (Just approach))
pTask :: InterpretationParser (Approach,[Step])
pTask = (,) Algebraic <$> pAlgebraic ApproachEquation
<|> (,) Algebraic <$> pAlgebraic ApproachInequality
<|> (,) Arithmetic <$> pArithmetic
pDiagnosis :: InterpretationParser Diagnosis
pDiagnosis = do addWildcardConstraint "d" isVariable
addWildcardConstraint "c" isVariable
addWildcardConstraint "i" isLiteral
addWildcardConstraint "j" isLiteral
addWildcardConstraint "n" (\n -> case match rationalView (simplify rationalView n) of
Just d -> isLiteral n && abs (d - 92) < 20
_ -> False)
(c,st) <- withModulo (restoreWildcards . simplify (multivariatePolynomialViewWith (doubleRoundedView (roundDouble 2))) . wildcardsToVars) pTask
state <- get
return (newDiagnosis c st)