{-# LANGUAGE FlexibleInstances #-}
module Recognize.Strategy.Derivation
( fromDerivation, fromRule, ToAttribute
) where
import Control.Monad
import Data.List
import qualified Data.List.NonEmpty as N
import Domain.Math.Data.Relation
import Domain.Math.Expr hiding (sumView)
import Ideas.Common.Context
import Ideas.Common.Derivation
import Ideas.Common.Id
import Ideas.Common.Rule
import Ideas.Common.Traversal.Navigator
import Ideas.Common.View
import Recognize.Data.Attribute
import Recognize.Data.RuleId
import Recognize.Expr.Normalform
import Recognize.Strategy.Views
fromDerivation :: (ToAttribute e, Show e) => Derivation (Rule (Context e)) (Context e) -> Maybe [Attribute]
fromDerivation = mapM ( \(a,r,b) -> fromRule r a b) . triples
fromRule :: ToAttribute e => Rule (Context e) -> Context e -> Context e -> Maybe Attribute
fromRule r a b = matchRuleId (show $ getId r) >>= \rid -> toAttribute rid a b
class ToAttribute e where
toAttribute :: RuleId -> Context e -> Context e -> Maybe Attribute
instance ToAttribute Expr where
toAttribute rid ce1 ce2 = do
let loc = location ce2
e1 <- navigateTo loc ce1 >>= currentInContext
e2 <- currentInContext ce2
case rid of
Collect_Num -> diffMerge e1 e2 >>= \(a,b) -> return $ ARule Collect_Num a b
Collect_Var -> diffMerge e1 e2 >>= \(a,b) -> return $ ARule Collect_Var a b
_ -> return $ ARule rid (e1 N.:| []) e2
instance ToAttribute (Relation Expr) where
toAttribute rid cre1 cre2 = do
let loc = location cre2
re1 <- navigateTo loc cre1 >>= currentInContext
re2 <- currentInContext cre2
return $ ARuleR rid re1 re2
diffMerge :: Expr -> Expr -> Maybe (N.NonEmpty Expr,Expr)
diffMerge e1 e2 = do
let es1 = nfComAssoc <$> from sumView e1
es2 = nfComAssoc <$> from sumView e2
common = es1 `intersect` es2
diff1 = es1 \\ common
diff2 = es2 \\ common
guard (length diff2 <= 1 && length diff1 >= 1)
case (diff1,diff2) of
([],_) -> Nothing
([x],[]) -> return (x N.:| common, e2)
(x:xs,[]) -> return (x N.:| xs, 0)
(x:xs,y:_) -> return (x N.:| xs, y)