{-# LANGUAGE FlexibleContexts #-}
module Recognize.Strategy.Recognizer (pExercise) where
import Control.Monad
import Data.Maybe
import Domain.Math.Data.Relation
import Domain.Math.Expr
import Ideas.Common.Library hiding (choice)
import Ideas.Service.State
import Recognize.Data.Attribute
import Recognize.Data.Diagnosis hiding (steps)
import Recognize.Data.Math
import Recognize.Data.Step
import Recognize.Expr.Functions (getVar)
import Recognize.Parsing.Derived
import Recognize.Parsing.Parse
import Recognize.Strategy.Derivation
import qualified Ideas.Service.BasicServices as BS
pExercise :: (Parse m Math, ParseLog m)
=> Exercise (Relation Expr)
-> Maybe (Relation Expr, Math)
-> m (Relation Expr, [Step])
pExercise e mrel = do
math <- peek
rel1 <- maybeToParse $ getRelation math
(i,m) <- case mrel of
Nothing -> pTerm e (stateTerm $ s rel1)
Just (rel2, m) -> return (rel2, m)
pLog ("pExercise: " ++ show (stateTerm (s i)))
second (initStep m:) <$> pState e (s i) i
where
s = emptyState e
pTerm :: (ParseLog m, Parse m Math) => Exercise (Relation Expr) -> Relation Expr -> m (Relation Expr, Math)
pTerm ex r = do
m <- peek
(f :==: _) <- getEq m
r' <- if not (isFunctionCall f)
then pLog ("pTerm: " ++ show m) >> maybeToParse (getRelation m)
else do
(_,m2) <- peek2
pLog (show m ++ " <==> " ++ show m2)
e2 <- getExpr m
pLog (show (getVar f) ++ " " ++ show (getVar e2) ++ " " ++ show (getVar f == getVar e2))
guard (getVar f == getVar e2)
pLog ("after guard: " ++ show m2)
maybeToParse (getRelation m2)
pLog ("New term: " ++ show r')
let areEq = similarity ex (inContext ex r) (inContext ex r')
pLog (show r ++ " | " ++ show r' ++ " | " ++ show areEq)
guard areEq
_ <- skip
return (r',m)
pState :: (ParseLog m, Parse m Math) => Exercise (Relation Expr) -> State (Relation Expr) -> Relation Expr -> m (Relation Expr, [Step])
pState e s i = do
pLog ("pState: " ++ show s)
choice'
[ do
let nextSteps = lookAheadStepsBy 3 s
choice $ flip map nextSteps $ \(si,s') -> do
pLog (show si)
(t,m) <- pTerm e (stateTerm s')
(t2,steps) <- pState e s' t
return (t2, mkStep si s m:steps)
, do
pLog ("Is it finished? " ++ show (finished s))
pLog (show s)
guard (finished s)
pLog "Finished"
return (i,[])
, do
math <- peek
next <- maybeToParse (getRelation math)
let step = Step (newId "") (math,[UnequalRelations i next]) []
pLog ("skipped: " ++ show math)
_ <- skip
let s' = emptyState e next
second (step:) <$> pState e s' next
]
lookAheadStepsBy :: Int -> State (Relation Expr) -> [([BS.StepInfo (Relation Expr)], State (Relation Expr))]
lookAheadStepsBy 0 _ = []
lookAheadStepsBy n s =
let af = either (const []) id (BS.allfirsts s)
nextSteps = concatMap (\(si,s') -> map (first (si:)) $ lookAheadStepsBy (n - 1) s') af
in map (first (:[])) af ++ nextSteps
mkStep :: [BS.StepInfo (Relation Expr)] -> State (Relation Expr) -> Math -> Step
mkStep si state m = Step (newId "Linear") (m,catMaybes attrs) []
where
attrs = map (\(x, y, z) -> fromRule x y z) triples
triples = intermediateValues si state
intermediateValues :: [BS.StepInfo (Relation Expr)] -> State (Relation Expr) -> [(Rule (Context (Relation Expr)), Context (Relation Expr),Context (Relation Expr))]
intermediateValues [] _ = []
intermediateValues ((r,loc,env):si) s =
case BS.apply r loc env s of
Left _ -> []
Right s' -> (r, stateContext s, stateContext s') : intermediateValues si s'
initStep :: Math -> Step
initStep m = Step (newId "Linear") (m, [Label "Initial equation"]) []