-----------------------------------------------------------------------------
-- 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)
--
-- This module defines a set of strategies used within the AdviseMe code.
-- Each strategy is specifically tuned for the exercises wherein they are used.
-- Any changes should be followed by testing the exercises.
-- To generate attributes for newly added rules you have to modify "RuleId"
-- 
-----------------------------------------------------------------------------

module Recognize.Strategy.Strategies where

import Control.Monad
import Domain.Math.Data.Relation
import Domain.Math.Equation.CoverUpRules  hiding (coverUpPlus)
import Domain.Math.Expr
import Domain.Math.Numeric.Rules
import Domain.Math.Numeric.Views (rationalView, integerNF)
import Domain.Math.Polynomial.Balance
import Domain.Math.Polynomial.RationalRules (cancelTermsDiv)
import Domain.Math.Polynomial.Rules
import Domain.Math.Power.Rules
import Ideas.Common.Library
import Ideas.Common.Strategy.Legacy
import Prelude                              hiding ((<*>))
import Recognize.Strategy.Rules
import Recognize.Strategy.Views

-- | Strategy used by the strategy recognizer to recognize rewrites of linear equations
recognizerStrategy :: IsTerm a => LabeledStrategy (Context a)
recognizerStrategy = label "recognizer strategy" $
  repeat1 $
    use varToLeft
    <|> coverUpPlus
    <|> use coverUpTimesPositive
    <|> use (liftRule conRightMinus)
    <|> use removeTimes
    <|> fractionStrategy

-- | Strategy used for simplifying expressions
simplifyStrategy :: LabeledStrategy (Context Expr)
simplifyStrategy = label "simplify" $ repeatS (
  rules (cancelTermsDiv : map use [ calcTimesWith "rational" rationalRelaxedForm
                                  , calcPower
                                  , simplerFraction
                                  ])
  |> rules (map use [mergeNums, mergeVars])
  |> rules (map use [distributeTimes, distributeDivision]))
  where
    rules rs = somewhere $ alternatives rs

-- | Strategy used for normalizing expressions (equality modulo fraction simplification, distribution and double negation)
normalizeStrategy :: LabeledStrategy (Context Expr)
normalizeStrategy = label "normalize" $
  repeatS $ somewhere $ alternatives $ map use
      [ simplerFraction, distributeTimes, doubleNegate ]

-- | Strategy used for simplifying of expressions containing fractionals
fractionStrategy :: IsTerm a => Strategy (Context a)
fractionStrategy = many1 $
      somewhere
         (  use (calcPlusWith     "integer" integerNF)
        <|> use (calcMinusWith    "integer" integerNF)
        <|> use (calcTimesWith    "integer" integerNF) -- not needed?
        -- <|> use (calcDivisionWith "integer" integerNF)  -- not needed?
         ) |>
      somewhere
         (use fractionTimesCancelDenNom <|> use fractionTimesCancelNomDen) |>
      somewhere
         (  use doubleNegate <|> use negateZero <|> use divisionDenominator
        <|> use fractionPlus <|> use fractionTimes <|> use divisionNumerator
         ) |>
      somewhere (use fractionPlusScale) |>
      somewhere (use simplerFraction)

-------------------------
-- copied from IneqExercises

-- helper strategy (todo: fix needed, because the original rules do not
-- work on relations)
coverUpPlus :: IsTerm a => Strategy (Context a)
coverUpPlus = alternatives (map (use . ($ oneVar)) coverUps)
 where
   coverUps :: [ConfigCoverUp -> Rule (Relation Expr)]
   coverUps =
      [ coverUpBinaryRule "plus" (commOp . isPlus) (-)
      , coverUpBinaryRule "minus-left" isMinus (+)
      , coverUpBinaryRule "minus-right" (flipOp . isMinus) (flip (-))
      ]

coverUpTimesPositive :: Rule (Relation Expr)
coverUpTimesPositive = coverUpBinaryRule "times-positive" (commOp . m) (/) configCoverUp
 where
   m expr = do
      (a, b) <- matchM timesView expr
      r <- matchM rationalView a
      guard (r>0)
      return (a, b)