{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- 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 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 -- | Parses expressions that represent steps in the given exercise. -- Parsing stops until a relation is found that is considered 'final' (no more steps in the exercise are possible on this expressions) pExercise :: (Parse m Math, ParseLog m) => Exercise (Relation Expr) -- ^ Input expressions must be steps conforming to this exercise -> Maybe (Relation Expr, Math) -- ^ Optional starting relation -> 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 -- | Parse a relation that is equivalent to the given relation. -- Equivalence is determined by the given exercise. pTerm :: (ParseLog m, Parse m Math) => Exercise (Relation Expr) -> Relation Expr -> m (Relation Expr, Math) pTerm ex r = do m <- peek (f :==: _) <- getEq m -- f(x) = 7 + 3x = 50 -- is parsed as f(x) = 7 + 3x and 7 + 3x = 50. We don't need the first expression, so we attempt to remove it 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) -- | Continuously parse relations that match one of the relations obtained by making steps on the argument relation. -- -- Stops when no more relations match. Allows upto 2 implicit steps to be made (this may be expensive). 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 -- Generate all new relations by making at most 3 steps at once. let nextSteps = lookAheadStepsBy 3 s choice $ flip map nextSteps $ \(si,s') -> do pLog (show si) -- Parse the relation (t,m) <- pTerm e (stateTerm s') -- Continue with that term as the current state term (t2,steps) <- pState e s' t return (t2, mkStep si s m:steps) , do -- If finished then stop pLog ("Is it finished? " ++ show (finished s)) pLog (show s) guard (finished s) pLog "Finished" return (i,[]) , do -- Possible that the student made a mistake, in which case we would like to skip this relation. 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"]) []