-----------------------------------------------------------------------------
-- Copyright 2015, Open Universiteit Nederland. This file is distributed
-- under the terms of the GNU General Public License. For more information,
-- see the file "LICENSE.txt", which is included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------
--  $Id: Exercises.hs 7527 2015-04-08 07:58:06Z bastiaan $

module Domain.Math.Polynomial.Exercises
   ( linearExercise, linearMixedExercise
   , quadraticExercise, quadraticNoABCExercise
   , quadraticWithApproximationExercise
   , higherDegreeExercise
   , findFactorsExercise, expandExercise
   ) where

import Control.Monad
import Data.Function
import Data.Maybe
import Domain.Math.Approximation
import Domain.Math.CleanUp
import Domain.Math.Data.OrList
import Domain.Math.Data.Relation
import Domain.Math.Equation.CoverUpRules
import Domain.Math.Equation.Views
import Domain.Math.Expr
import Domain.Math.Numeric.Views
import Domain.Math.Polynomial.BuggyRules
import Domain.Math.Polynomial.Equivalence
import Domain.Math.Polynomial.Examples
import Domain.Math.Polynomial.Rules
import Domain.Math.Polynomial.Strategies
import Domain.Math.Polynomial.Views
import Ideas.Common.Library
import qualified Data.Foldable as F
import qualified Data.Traversable as T

------------------------------------------------------------
-- Exercises

linearExercise :: Exercise (Equation Expr)
linearExercise = makeExercise
   { exerciseId   = describe "solve a linear equation" $
                       newId "algebra.equations.linear"
   , status       = Stable
   , parser       = parseEqExpr
   , similarity   = withoutContext (viewEquivalent (traverseView cleanUpACView))
   , equivalence  = withoutContext (viewEquivalent linearEquationView)
   , suitable     = predicateView linearEquationView
   , ready        = predicateView (equationSolvedWith mixedFractionNF)
                    <||> predicateView (equationSolvedWith rationalNF)
                    <||> predicateView (equationSolvedWith doubleNF)
   , extraRules   = map use buggyRulesEquation ++
                    map use buggyRulesExpr
   , ruleOrdering = ruleOrderingWith
                       [ getId coverUpTimes, getId flipEquation
                       , getId removeDivision
                       ]
   , strategy     = linearStrategy
   , navigation   = termNavigator
   , examples     = linearExamples
   }

linearMixedExercise :: Exercise (Equation Expr)
linearMixedExercise = linearExercise
   { exerciseId   = describe "solve a linear equation with mixed fractions" $
                       newId "algebra.equations.linear.mixed"
   , status       = Provisional
   , ready        = predicateView (equationSolvedWith mixedFractionNF)
   , strategy     = linearMixedStrategy
   }

quadraticExercise :: Exercise (OrList (Relation Expr))
quadraticExercise = makeExercise
   { exerciseId   = describe "solve a quadratic equation" $
                       newId "algebra.equations.quadratic"
   , status       = Stable
   , parser       = parseOrsEqExpr
                       >>> right (build (traverseView equationView))
   , similarity   = withoutContext (viewEquivalent (traverseView (traverseView cleanUpView)))
   , equivalence  = withoutContext (equivalentRelation (viewEquivalent quadraticEquationsView))
   , suitable     = predicateView (traverseView equationView >>> quadraticEquationsView)
   , ready        = predicateView relationsSolvedForm
   , extraRules   = map use abcBuggyRules ++ buggyQuadratic ++
                    map use buggyRulesEquation ++ map use buggyRulesExpr
   , ruleOrdering = ruleOrderingWith $
                       quadraticRuleOrder ++ [getId buggySquareMultiplication]
   , strategy     = quadraticStrategy
   , navigation   = termNavigator
   , examples     = mapExamples (singleton . build equationView) quadraticExamples
   }

higherDegreeExercise :: Exercise (OrList (Relation Expr))
higherDegreeExercise = makeExercise
   { exerciseId    = describe "solve an equation (higher degree)" $
                        newId "algebra.equations.polynomial"
   , status        = Stable
   , parser        = parser quadraticExercise
   , similarity    = withoutContext (viewEquivalent (traverseView (traverseView cleanUpView)))
   , equivalence   = eqAfterSubstitution $
                        equivalentRelation (viewEquivalent higherDegreeEquationsView)
   , suitable      = predicateView (traverseView equationView >>> higherDegreeEquationsView)
   , ready         = predicateView relationsSolvedForm
   , extraRules    = map use abcBuggyRules ++ buggyQuadratic ++
                     map use buggyRulesEquation ++ map use buggyRulesExpr
   , ruleOrdering  = ruleOrderingWith quadraticRuleOrder
   , strategy      = higherDegreeStrategy
   , navigation    = termNavigator
   , examples      = mapExamples (singleton . build equationView) higherDegreeExamples
   }

quadraticNoABCExercise :: Exercise (OrList (Relation Expr))
quadraticNoABCExercise = quadraticExercise
   { exerciseId   = describe "solve a quadratic equation without abc-formula" $
                       newId "algebra.equations.quadratic.no-abc"
   , status       = Provisional
   , strategy     = configure cfg quadraticStrategy
   }
 where
   cfg = (Reinsert `byName` prepareSplitSquare) <>
         (Reinsert `byName` bringAToOne) <>
         (Remove   `byName` newId "abc form") <>
         (Remove   `byName` simplerPolynomial)

quadraticWithApproximationExercise :: Exercise (OrList (Relation Expr))
quadraticWithApproximationExercise = quadraticExercise
   { exerciseId   = describe "solve a quadratic equation with approximation" $
                       newId "algebra.equations.quadratic.approximate"
   , status        = Provisional
   , parser       = parseOrsRelExpr
   , strategy     = configure cfg quadraticStrategy
   , equivalence  = withoutContext equivalentApprox
   }
 where
   cfg = (Reinsert `byName` newId "approximate result") <>
         (Remove `byName` newId "square root simplification")

findFactorsExercise :: Exercise Expr
findFactorsExercise = makeExercise
   { exerciseId   = describe "factorize the expression" $
                       newId "algebra.manipulation.polynomial.factor"
   , status       = Provisional
   , parser       = parseExpr
   , similarity   = withoutContext ((==) `on` cleanUpExpr)
   , equivalence  = withoutContext (viewEquivalent (polyViewWith rationalView))
   , ready        = predicateView linearFactorsView
   , ruleOrdering = ruleOrderingWith quadraticRuleOrder
   , strategy     = findFactorsStrategy
   , navigation   = termNavigator
   , extraRules   = map liftToContext buggyRulesExpr
   , examples     = factorizeExamples
   }

expandExercise :: Exercise Expr
expandExercise = makeExercise
   { exerciseId   = describe "expand an expression to polynomial normal form" $
                       newId "algebra.manipulation.polynomial.expand"
   , status       = Provisional
   , parser       = parseExpr
   , similarity   = withoutContext ((==) `on` cleanUpExpr)
   , equivalence  = withoutContext (viewEquivalent (polyViewWith rationalView))
   , ready        = predicateView (polyNormalForm rationalView)
   , ruleOrdering = ruleOrderingWith (getId fractionProduct:quadraticRuleOrder)
   , strategy     = expandStrategy
   , navigation   = termNavigator
   , extraRules   = map liftToContext buggyRulesExpr
   , examples     = expandExamples
   }

linearFactorsView :: View Expr (Bool, [(String, Expr, Expr)])
linearFactorsView = toView productView >>> second (listView myLinearView)
 where
   myLinearView :: View Expr (String, Expr, Expr)
   myLinearView = makeView f (build linearView)

   f expr = do
      triple@(_, e1, e2) <- match linearView expr
      a <- match integerView e1
      b <- match integerView e2
      guard (a > 0 && gcd a b == 1) -- gcd 0 0 is undefined
      return triple
    `mplus` do
      guard (expr `belongsTo` rationalView)
      return ("x", 0, expr)

--------------------------------------------
-- Equality

equivalentApprox :: OrList (Relation Expr) -> OrList (Relation Expr) -> Bool
equivalentApprox a b
   | hasApprox a || hasApprox b =
        let norm = liftM ( simplify orSetView
                         . fmap (fmap (acExpr . cleanUpExpr) . toApprox)
                         . simplify quadraticEquationsView
                         ) . T.mapM toEq
        in fromMaybe False $ liftM2 (==) (norm a) (norm b)
   | otherwise =
        equivalentRelation (viewEquivalent quadraticEquationsView) a b
 where
   hasApprox = F.any isApproximately
   isApproximately = (==Approximately) . relationType
   toEq rel | relationType rel `elem` [EqualTo, Approximately] =
      Just (leftHandSide rel :==: rightHandSide rel)
            | otherwise = Nothing

toApprox :: Equation Expr -> Relation Expr
toApprox (a :==: b) = f a .~=. f b
 where
   f x = maybe x (fromDouble . precision 4) (match doubleView x)

equivalentRelation :: (OrList (Equation a) -> OrList (Equation a) -> Bool) -> OrList (Relation a) -> OrList (Relation a) -> Bool
equivalentRelation f ra rb = fromMaybe False $ do
   a <- T.mapM (match equationView) ra
   b <- T.mapM (match equationView) rb
   return (f a b)