{-# LANGUAGE PatternGuards #-}
module Recognize.Expr.Normalform
( nf, nf4, nfComAssoc, nfCom
, rewriteSqrt, distributeExponent
, ceilingExpr, floorExpr
, roundDouble, doubleRoundedView
, (===)
) where
import Util.Cache
import Data.Function
import Data.List
import Domain.Algebra.SmartGroup
import Domain.Math.Expr
import Domain.Math.Numeric.Views
import Domain.Math.Polynomial.Views
import Ideas.Common.Id
import Ideas.Common.Rewriting
import Ideas.Common.View as IV
import Ideas.Utils.Prelude
import Ideas.Utils.Uniplate
distributeExponent :: Expr -> Expr
distributeExponent e@(Sym s1 [x,i]) | isPowerSymbol s1
, Sym s2 [y,j] <- x
, isPowerSymbol s2
= Sym s1 [y,i .*. j]
distributeExponent e = e
rewriteSqrt :: Expr -> Expr
rewriteSqrt (Sqrt e) = Sym powerSymbol [e,1/2]
rewriteSqrt e = e
(===) :: Expr -> Expr -> Bool
a === b = nf2 a == nf2 b
nf :: Expr -> Expr
nf = cached "nf" $ \expr ->
case expr of
Sym s xs -> Sym s (map nf xs)
_ -> transform (simplify (polyViewWith rationalApproxView)) expr
nf2 :: Expr -> Expr
nf2 (Sym s xs) = Sym s (map nf2 xs)
nf2 e = simplify rationalApproxView e
nf3 :: Int -> Expr -> Expr
nf3 n (Sym s xs) = Sym s $ map (nf3 n) xs
nf3 n e = simplify (doubleRoundedView (roundDouble n)) e
nf4 :: Int -> Expr -> Expr
nf4 n e
| hasSomeVar e = nfComAssoc $ nf e
| otherwise = nf3 n e
doubleRoundedView :: (Double -> Double) -> View Expr Double
doubleRoundedView round = "num.double.rounded" @> doubleView >>> makeView (Just. round) id
ceilingExpr :: Expr -> Expr
ceilingExpr (Number d) = Nat $ ceiling d
ceilingExpr e = e
floorExpr :: Expr -> Expr
floorExpr (Number d) = Nat $ floor d
floorExpr e = e
nfComAssoc :: Expr -> Expr
nfComAssoc = cached "nfComAssoc" $ \expr ->
case expr of
Number _ -> nf expr
_ ->
case (from sumView expr, from productView expr) of
(xs, _) | length xs > 1 ->
to sumView $ sortBy (compare `on` nf) (map nfComAssoc xs)
(_, (b, xs)) | length xs > 1 ->
to productView (b, sortBy (compare `on` nf) (map nfComAssoc xs))
_ ->
descend nfComAssoc expr
nfCom :: Expr -> Expr
nfCom = cached "nfCom" $ \expr ->
case expr of
_ :+: _ -> sum (sort (map nfCom (collect expr)))
where
collect (x :+: y) = collect x ++ collect y
collect (x :-: y) = collect x ++ map neg (collect y)
collect (Negate x) = map neg (collect x)
collect a = [a]
x :*: y
| x' <= y' -> x' :*: y'
| otherwise -> y' :*: x'
where
x' = nfCom x
y' = nfCom y
Number _ -> simplify rationalApproxView expr
_ -> descend nfCom expr
roundDouble :: Int -> Double -> Double
roundDouble n d = fromIntegral (roundNearest (d * 10Prelude.^n)) / 10Prelude.^n
roundNearest :: (RealFrac a, Integral b) => a -> b
roundNearest a = let (n,r) = properFraction a
in if r >= 0.5 then n + 1 else n