----------------------------------------------------------------------------- -- Copyright 2013, 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 : alex.gerdes@ou.nl -- Stability : provisional -- Portability : portable (depends on ghc) -- ----------------------------------------------------------------------------- module Domain.Math.Power.Equation.Rules -- ( -- * Power equation rules -- commonPower, nthRoot, sameBase, equalsOne, greatestPower -- , approxPower, reciprocalFor, coverUpRootWith, coverUpRoot -- ) where import Control.Monad import Data.Maybe import Ideas.Common.Library hiding (simplify) --import Data.List (partition) import Domain.Math.Approximation (precision) import Domain.Math.Data.Relation import Domain.Math.Equation.CoverUpRules import Domain.Math.Expr import Domain.Math.Numeric.Views import qualified Domain.Math.Data.PrimeFactors as PF --import Domain.Math.CleanUp (collectLikeTerms) import Domain.Math.Polynomial.Rules (distributeTimes, distributeDivisionT) import Domain.Math.Power.Utils import Domain.Math.Power.Views import Domain.Math.Simplification (simplify) -- | Identifier prefix -------------------------------------------------------- powereq :: String powereq = "algebra.manipulation.exponents.equation" -- | Power relation rules ----------------------------------------------------- -- | a^x = b^y => a^(x/c) = b^(y/c) where c = gcd x y commonPower :: Rule (Equation Expr) commonPower = makeRule (powereq, "common-power") \$ \expr -> do let v = eqView (powerView >>> second integerView) ((a, x), (b, y)) <- match v expr let c = gcd x y guard \$ c > 1 return \$ build v ((a, x `div` c), (b, y `div` c)) -- | a^x = n => a^x = b^e greatestPower :: Rule (Equation Expr) greatestPower = makeRule (powereq, "greatest-power") \$ \(lhs :==: rhs) -> do n <- match integerView rhs (_, x) <- match (powerView >>> second integerView) lhs (b, e) <- PF.greatestPower n guard \$ gcd x e > 1 return \$ lhs :==: fromInteger b .^. fromInteger e -- a^x = c*b^y => a = c*b^(y/x) nthRoot :: Rule (Equation Expr) nthRoot = makeRule (powereq, "nth-root") \$ \(lhs :==: rhs) -> do guard \$ hasSomeVar lhs (a, x) <- match powerView lhs (c, (b, y)) <- match unitPowerView rhs return \$ a :==: build unitPowerView (c, (b, simplify (y ./. x))) -- x = a^x => x ~= d approxPower :: Rule (Relation Expr) approxPower = ruleTrans (powereq, "approx-power") \$ approxPowerT 2 -- x = a^x => x ~= d approxPowerT :: Int -> Transformation (Relation Expr) approxPowerT n = makeTrans \$ match equationView >=> f where f (Var x :==: d) = match doubleView d >>= Just . (Var x .~=.) . fromDouble . precision n f (d :==: Var x) = match doubleView d >>= Just . (.~=. Var x) . fromDouble . precision n f _ = Nothing -- a^x = a^y => x = y sameBase :: Rule (Equation Expr) sameBase = makeRule (powereq, "same-base") \$ \ expr -> do ((a, x), (b, y)) <- match (eqView powerView) expr guard \$ a == b return \$ x :==: y -- | c*a^x = d*(1/a)^y => c*a^x = d*a^-y reciprocalFor :: Rule (Equation Expr) reciprocalFor = makeRule (powereq, "reciprocal-for-base") \$ \ (lhs :==: rhs) -> do (_, (a, _)) <- match unitPowerView lhs (one, _) <- match divView rhs (d, (a'', y)) <- match consPowerView rhs guard \$ one == 1 && a'' == a return \$ lhs :==: d .*. a'' .^. negate y -- | a^x = 1 => x = 0 equalsOne :: Rule (Equation Expr) equalsOne = makeRule (powereq, "equals-one") \$ \ (lhs :==: rhs) -> do guard \$ rhs == 1 (_, x) <- match powerView lhs return \$ x :==: 0 ----------------------- Move these funcs to right place ---------------------- -- add these two functions to coverUpRules? coverUpRootWith :: ConfigCoverUp -> Rule (Equation Expr) coverUpRootWith = coverUpBinaryRule "root" (isBinary rootSymbol) (.^.) coverUpRoot :: Rule (Equation Expr) coverUpRoot = coverUpRootWith configCoverUp -- | Negations are pushed inside myCoverUpTimesWith :: ConfigCoverUp -> Rule (Equation Expr) myCoverUpTimesWith = doAfter f . coverUpTimesWith where f (lhs :==: rhs) = lhs :==: g (applyD distributeTimes rhs) g a = fromMaybe a (distributeDivisionT a) -- flip condition condXisRight :: Equation Expr -> Bool condXisRight (lhs :==: rhs) = hasVar "x" rhs && withoutVar "x" lhs --xToLeft = makeRule (powereq, "x -to-left") \$ toLeftRightT \$ elem "x" . vars -- toLeftRightT :: (Expr -> Bool) -> Transformation (Equation Expr) -- toLeftRightT p = makeTrans \$ -- \ (lhs :==: rhs) -> do -- (xs, cs) <- fmap (partition p) (match sumView lhs) -- (ys, ds) <- fmap (partition p) (match sumView rhs) -- guard \$ length cs > 0 || length ys > 0 -- return \$ fmap collectLikeTerms \$ -- build sumView (xs ++ map neg ys) :==: build sumView (ds ++ map neg cs)