Recognizer.hs

{-# 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"]) []