-----------------------------------------------------------------------------
-- Copyright 2010, 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)
--
-----------------------------------------------------------------------------
module Domain.Math.Polynomial.Exercises where

import Domain.Math.Approximation
import Common.Context
import Common.Exercise
import Common.Rewriting
import Common.Strategy
import Common.Classes
import Common.Uniplate
import Common.View
import Data.Maybe
import Domain.Math.Data.OrList
import Domain.Math.Data.Relation
import Domain.Math.Equation.Views
import Domain.Math.Examples.DWO1
import Domain.Math.Examples.DWO2
import Domain.Math.Expr
import Domain.Math.Polynomial.BuggyRules
import Domain.Math.Polynomial.CleanUp
import Domain.Math.Polynomial.Rules
import Domain.Math.Polynomial.Strategies
import Domain.Math.Polynomial.Views
import Domain.Math.Polynomial.Equivalence
import Domain.Math.Numeric.Views
import Domain.Math.Equation.CoverUpRules
import Control.Monad

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

linearExercise :: Exercise (Equation Expr)
linearExercise = makeExercise 
   { exerciseId   = describe "solve a linear equation" $ 
                       newId "algebra.equations.linear"
   , status       = Provisional
   , parser       = parseExprWith (pEquation pExpr)
   , similarity   = eqRelation (acExpr . cleanUpExpr)
   , equivalence  = viewEquivalent linearEquationView
   , isSuitable   = (`belongsTo` linearEquationView)
   , isReady      = solvedRelationWith $ \a -> 
                       a `belongsTo` mixedFractionNormalForm || 
                       a `belongsTo` rationalNormalForm
   , extraRules   = map use buggyRulesEquation ++
                    map use buggyRulesExpr 
   , ruleOrdering = ruleOrderingWithId
                       [ getId coverUpTimes, getId flipEquation
                       , getId removeDivision
                       ]
   , strategy     = linearStrategy
   , navigation   = termNavigator
   , examples     = concat (linearEquations ++ [specialCases])
   }
 where
   specialCases = 
      let x = Var "x" 
      in [5 :==: x, 5 :==: x + 1, x - 1/5 :==: 2]
      
linearMixedExercise :: Exercise (Equation Expr)
linearMixedExercise = linearExercise 
   { exerciseId   = describe "solve a linear equation with mixed fractions" $ 
                       newId "algebra.equations.linear.mixed"
   , isReady      = solvedRelationWith (`belongsTo` mixedFractionNormalForm)
   , strategy     = linearMixedStrategy
   } 

quadraticExercise :: Exercise (OrList (Relation Expr))
quadraticExercise = makeExercise 
   { exerciseId   = describe "solve a quadratic equation" $ 
                       newId "algebra.equations.quadratic"
   , status       = Provisional
   , parser       = \input -> case parseExprWith (pOrList (pEquation pExpr)) input of
                                 Left err -> Left err
                                 Right xs -> Right (build (switchView equationView) xs)
   , similarity   = eqOrList cleanUpExpr
   , equivalence  = equivalentRelation (viewEquivalent quadraticEquationsView)
   , isSuitable   = (`belongsTo` (switchView equationView >>> quadraticEquationsView))
   , isReady      = solvedRelations
   , extraRules   = map use abcBuggyRules ++ buggyQuadratic ++
                    map use buggyRulesEquation ++ map use buggyRulesExpr 
   , ruleOrdering = ruleOrderingWithId $ 
                       quadraticRuleOrder ++ [getId buggySquareMultiplication]
   , strategy     = quadraticStrategy
   , navigation   = termNavigator
   , examples     = map (orList . return . build equationView) (concat quadraticEquations)
   }
   
higherDegreeExercise :: Exercise (OrList (Relation Expr))
higherDegreeExercise = makeExercise 
   { exerciseId    = describe "solve an equation (higher degree)" $
                        newId "algebra.equations.polynomial"
   , status        = Provisional
   , parser        = parser quadraticExercise
   , similarity    = eqOrList cleanUpExpr
   , eqWithContext = Just $ eqAfterSubstitution $ 
                        equivalentRelation (viewEquivalent higherDegreeEquationsView)
   , isSuitable    = (`belongsTo` (switchView equationView >>> higherDegreeEquationsView))
   , isReady       = solvedRelations
   , extraRules    = map use abcBuggyRules ++ buggyQuadratic ++
                     map use buggyRulesEquation ++ map use buggyRulesExpr 
   , ruleOrdering = ruleOrderingWithId quadraticRuleOrder
   , strategy      = higherDegreeStrategy
   , navigation   = termNavigator
   , examples      = map (orList . return . build equationView) 
                        (concat $ higherEq1 ++ higherEq2 ++ [higherDegreeEquations])
   }
   
quadraticNoABCExercise :: Exercise (OrList (Relation Expr))
quadraticNoABCExercise = quadraticExercise
   { exerciseId   = describe "solve a quadratic equation without abc-formula" $ 
                       newId "algebra.equations.quadratic.no-abc"
   , status       = Alpha
   , strategy     = configure cfg quadraticStrategy
   }
 where
   cfg = [ (byName prepareSplitSquare, Reinsert)
         , (byName bringAToOne, Reinsert)
         , (byName (newId "abc form"), Remove)
         , (byName simplerPolynomial, Remove)
         ]
         
quadraticWithApproximation :: Exercise (OrList (Relation Expr))
quadraticWithApproximation = quadraticExercise
   { exerciseId   = describe "solve a quadratic equation with approximation" $ 
                       newId "algebra.equations.quadratic.approximate"
   , status       = Alpha
   , parser       = parseExprWith (pOrList (pRelation pExpr))
   , strategy     = configure cfg quadraticStrategy
   , equivalence  = equivalentApprox
   }
 where
   cfg = [ (byName (newId "approximate result"), Reinsert)
         , (byName (newId "square root simplification"), Remove)
         ]

findFactorsExercise :: Exercise Expr
findFactorsExercise = makeExercise
   { exerciseId   = describe "factorize the expression" $ 
                       newId "algebra.manipulation.polynomial.factor"
   , status       = Provisional
   , parser       = parseExprWith pExpr
   , similarity   = \a b -> cleanUpExpr a == cleanUpExpr b
   , equivalence  = viewEquivalent (polyViewWith rationalView)
   , isReady      = (`belongsTo` linearFactorsView)
   , strategy     = findFactorsStrategy
   , navigation   = termNavigator
   , extraRules   = map liftToContext buggyRulesExpr
   , examples     = concat findFactors
   }

linearFactorsView :: View Expr (Bool, [(String, Expr, Expr)])
linearFactorsView = 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 ( normOrList cleanUpExpr 
                         . fmap toApprox 
                         . simplify quadraticEquationsView
                         ) . switch . fmap toEq
        in fromMaybe False $ liftM2 (==) (norm a) (norm b)
   | otherwise =
        equivalentRelation (viewEquivalent quadraticEquationsView) a b 
 where
   hasApprox = maybe False (any isApproximately) . disjunctions
   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 (Number . 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 <- switch (fmap (match equationView) ra)
   b <- switch (fmap (match equationView) rb)
   return (f a b)

eqOrList :: (Relational f, Ord (f Expr)) => 
               (Expr -> Expr) -> OrList (f Expr) -> OrList (f Expr) -> Bool
eqOrList f x y = normOrList f x == normOrList f y

eqRelation :: (Relational f, Eq (f Expr)) => (Expr -> Expr) -> f Expr -> f Expr -> Bool
eqRelation f x y = fmap f x == fmap f y

-- Normalize the order of disjunctions. Simplify the expression with the function
-- passed as argument, but do not change (flip) the sides of the relation.
normOrList :: (Relational f, Ord (f Expr)) => 
                 (Expr -> Expr) -> OrList (f Expr) -> OrList (f Expr)
normOrList f = normalize . fmap (fmap (normExpr f))

normExpr :: (Expr -> Expr) -> Expr -> Expr
normExpr f = rec . f
 where
   plusOperator  = makeCommutative $ monoid 
                      (makeBinary (getId plusSymbol) (+) isPlus)
                      (simpleConstant "zero" 0)
   timesOperator = makeCommutative $ monoid 
                      (makeBinary (getId timesSymbol) (*) isTimes)
                      (simpleConstant "one" 1)
   make          = simplifyWith (map rec) . magmaListView
   
   rec expr = 
      case expr of
         _ :+: _ -> make plusOperator  expr
         _ :*: _ -> make timesOperator expr
         _       -> descend rec expr