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
recognizerStrategy :: IsTerm a => LabeledStrategy (Context a)
recognizerStrategy = label "recognizer strategy" $
repeat1 $
use varToLeft
<|> coverUpPlus
<|> use coverUpTimesPositive
<|> use (liftRule conRightMinus)
<|> use removeTimes
<|> fractionStrategy
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
normalizeStrategy :: LabeledStrategy (Context Expr)
normalizeStrategy = label "normalize" $
repeatS $ somewhere $ alternatives $ map use
[ simplerFraction, distributeTimes, doubleNegate ]
fractionStrategy :: IsTerm a => Strategy (Context a)
fractionStrategy = many1 $
somewhere
( use (calcPlusWith "integer" integerNF)
<|> use (calcMinusWith "integer" integerNF)
<|> use (calcTimesWith "integer" integerNF)
) |>
somewhere
(use fractionTimesCancelDenNom <|> use fractionTimesCancelNomDen) |>
somewhere
( use doubleNegate <|> use negateZero <|> use divisionDenominator
<|> use fractionPlus <|> use fractionTimes <|> use divisionNumerator
) |>
somewhere (use fractionPlusScale) |>
somewhere (use simplerFraction)
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)