{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wcpp-undef #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Debug.SimpleExpr.Expr
(
number,
variable,
unaryFunc,
binaryFunc,
simplifyExpr,
simplifyStep,
simplify,
SimpleExprF (NumberF, VariableF, SymbolicFuncF),
SimpleExpr,
SE,
Expr,
ListOf,
content,
dependencies,
showWithBrackets,
)
where
import Control.ExtendableMap (ExtandableMap, extendMap)
import Control.Monad (guard)
import Control.Monad.Fix (fix)
import Data.Fix (Fix (Fix, unFix))
import Data.Functor.Classes (Eq1, liftEq)
import Data.Hashable (Hashable(hashWithSalt))
import Data.Hashable.Lifted (Hashable1(liftHashWithSalt))
import Data.Hashable.Generic (genericLiftHashWithSalt)
import Data.List (intercalate, null, uncons, unsnoc, (++))
import Data.Maybe (isJust)
import GHC.Base
( Applicative (pure),
Bool(False),
Eq ((==)),
Functor (fmap),
Maybe (Just, Nothing),
String,
not,
seq,
($),
(&&),
(.),
(<>),
(>=)
)
import GHC.Generics (Generic1)
import GHC.Natural (Natural)
import GHC.Num (Num)
import GHC.Show (Show (show))
import NumHask
( Additive,
Divisive,
ExpField,
FromInteger,
Multiplicative,
Subtractive,
TrigField,
fromIntegral,
one,
zero,
)
import qualified NumHask as NH
import qualified Prelude as P
data SimpleExprF a
= NumberF Natural
| VariableF String
| SymbolicFuncF String [a]
deriving ((forall a b. (a -> b) -> SimpleExprF a -> SimpleExprF b)
-> (forall a b. a -> SimpleExprF b -> SimpleExprF a)
-> Functor SimpleExprF
forall a b. a -> SimpleExprF b -> SimpleExprF a
forall a b. (a -> b) -> SimpleExprF a -> SimpleExprF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SimpleExprF a -> SimpleExprF b
fmap :: forall a b. (a -> b) -> SimpleExprF a -> SimpleExprF b
$c<$ :: forall a b. a -> SimpleExprF b -> SimpleExprF a
<$ :: forall a b. a -> SimpleExprF b -> SimpleExprF a
Functor, SimpleExprF a -> SimpleExprF a -> Bool
(SimpleExprF a -> SimpleExprF a -> Bool)
-> (SimpleExprF a -> SimpleExprF a -> Bool) -> Eq (SimpleExprF a)
forall a. Eq a => SimpleExprF a -> SimpleExprF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => SimpleExprF a -> SimpleExprF a -> Bool
== :: SimpleExprF a -> SimpleExprF a -> Bool
$c/= :: forall a. Eq a => SimpleExprF a -> SimpleExprF a -> Bool
/= :: SimpleExprF a -> SimpleExprF a -> Bool
Eq, (forall a. SimpleExprF a -> Rep1 SimpleExprF a)
-> (forall a. Rep1 SimpleExprF a -> SimpleExprF a)
-> Generic1 SimpleExprF
forall a. Rep1 SimpleExprF a -> SimpleExprF a
forall a. SimpleExprF a -> Rep1 SimpleExprF a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. SimpleExprF a -> Rep1 SimpleExprF a
from1 :: forall a. SimpleExprF a -> Rep1 SimpleExprF a
$cto1 :: forall a. Rep1 SimpleExprF a -> SimpleExprF a
to1 :: forall a. Rep1 SimpleExprF a -> SimpleExprF a
Generic1)
instance Hashable1 SimpleExprF where
liftHashWithSalt :: forall a. (Int -> a -> Int) -> Int -> SimpleExprF a -> Int
liftHashWithSalt = (Int -> a -> Int) -> Int -> SimpleExprF a -> Int
forall (t :: * -> *) a.
(Generic1 t, GHashable One (Rep1 t)) =>
(Int -> a -> Int) -> Int -> t a -> Int
genericLiftHashWithSalt
instance Hashable a => Hashable (SimpleExprF a) where
hashWithSalt :: Int -> SimpleExprF a -> Int
hashWithSalt Int
salt (NumberF Natural
n) = Int -> Natural -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Natural
n
hashWithSalt Int
salt (VariableF String
s) = Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt String
s
hashWithSalt Int
salt (SymbolicFuncF String
name [a]
xs) =
Int
salt Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
name Int -> [a] -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` [a]
xs
instance Eq1 SimpleExprF where
liftEq :: (a -> b -> Bool) -> SimpleExprF a -> SimpleExprF b -> Bool
liftEq :: forall a b.
(a -> b -> Bool) -> SimpleExprF a -> SimpleExprF b -> Bool
liftEq a -> b -> Bool
eq SimpleExprF a
e1 SimpleExprF b
e2 = case (SimpleExprF a
e1, SimpleExprF b
e2) of
(NumberF Natural
n1, NumberF Natural
n2) -> Natural
n1 Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
n2
(VariableF String
v1, VariableF String
v2) -> String
v1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v2
(SymbolicFuncF String
name1 [a]
args1, SymbolicFuncF String
name2 [b]
args2) -> (String
name1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name2) Bool -> Bool -> Bool
&& (a -> b -> Bool) -> [a] -> [b] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq [a]
args1 [b]
args2
(SimpleExprF a, SimpleExprF b)
_ -> Bool
False
instance
(NH.FromIntegral Natural n) =>
NH.FromIntegral (SimpleExprF a) n
where
fromIntegral :: n -> SimpleExprF a
fromIntegral = Natural -> SimpleExprF a
forall a. Natural -> SimpleExprF a
NumberF (Natural -> SimpleExprF a) -> (n -> Natural) -> n -> SimpleExprF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Natural
forall a b. FromIntegral a b => b -> a
fromIntegral
type SimpleExpr = Fix SimpleExprF
type SE = SimpleExpr
number :: Natural -> SimpleExpr
number :: Natural -> SimpleExpr
number Natural
n = SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Natural -> SimpleExprF SimpleExpr
forall a. Natural -> SimpleExprF a
NumberF Natural
n)
variable :: String -> SimpleExpr
variable :: String -> SimpleExpr
variable String
name = SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (String -> SimpleExprF SimpleExpr
forall a. String -> SimpleExprF a
VariableF String
name)
dependencies :: SimpleExpr -> [SimpleExpr]
dependencies :: SimpleExpr -> [SimpleExpr]
dependencies (Fix SimpleExprF SimpleExpr
e) = case SimpleExprF SimpleExpr
e of
NumberF Natural
_ -> []
VariableF String
_ -> []
SymbolicFuncF String
_ [SimpleExpr]
args -> [SimpleExpr]
args
instance
(NH.FromIntegral Natural n) =>
NH.FromIntegral SimpleExpr n
where
fromIntegral :: n -> SimpleExpr
fromIntegral = Natural -> SimpleExpr
number (Natural -> SimpleExpr) -> (n -> Natural) -> n -> SimpleExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Natural
forall a b. FromIntegral a b => b -> a
fromIntegral
class ListOf inner outer where
content :: outer -> [inner]
instance ListOf inner () where
content :: () -> [inner]
content = [inner] -> () -> [inner]
forall a b. a -> b -> a
P.const []
instance ListOf inner inner where
content :: inner -> [inner]
content inner
e = [inner
e]
instance
(ListOf inner outer1, ListOf inner outer2) =>
ListOf inner (outer1, outer2)
where
content :: (outer1, outer2) -> [inner]
content (outer1
x1, outer2
x2) = outer1 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer1
x1 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer2 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer2
x2
instance
(ListOf inner outer1, ListOf inner outer2, ListOf inner outer3) =>
ListOf inner (outer1, outer2, outer3)
where
content :: (outer1, outer2, outer3) -> [inner]
content (outer1
x1, outer2
x2, outer3
x3) = outer1 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer1
x1 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer2 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer2
x2 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer3 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer3
x3
instance
(ListOf inner outer1, ListOf inner outer2, ListOf inner outer3, ListOf inner outer4) =>
ListOf inner (outer1, outer2, outer3, outer4)
where
content :: (outer1, outer2, outer3, outer4) -> [inner]
content (outer1
x1, outer2
x2, outer3
x3, outer4
x4) = outer1 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer1
x1 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer2 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer2
x2 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer3 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer3
x3 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer4 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer4
x4
instance
(ListOf inner outer1, ListOf inner outer2, ListOf inner outer3, ListOf inner outer4, ListOf inner outer5) =>
ListOf inner (outer1, outer2, outer3, outer4, outer5)
where
content :: (outer1, outer2, outer3, outer4, outer5) -> [inner]
content (outer1
x1, outer2
x2, outer3
x3, outer4
x4, outer5
x5) = outer1 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer1
x1 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer2 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer2
x2 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer3 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer3
x3 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer4 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer4
x4 [inner] -> [inner] -> [inner]
forall a. [a] -> [a] -> [a]
++ outer5 -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content outer5
x5
instance (ListOf inner outer) => ListOf inner [outer] where
content :: [outer] -> [inner]
content = (outer -> [inner]
forall inner outer. ListOf inner outer => outer -> [inner]
content (outer -> [inner]) -> [outer] -> [inner]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
P.=<<)
type Expr = ListOf SimpleExpr
instance {-# OVERLAPPING #-} Show SimpleExpr where
show :: SimpleExpr -> String
show (Fix SimpleExprF SimpleExpr
e) = case SimpleExprF SimpleExpr
e of
NumberF Natural
n -> Natural -> String
forall a. Show a => a -> String
show Natural
n
VariableF String
name -> String
name
sf :: SimpleExprF SimpleExpr
sf@(SymbolicFuncF String
name [SimpleExpr]
args) -> case SimpleExpr -> Maybe (String, SimpleExpr, SimpleExpr)
matchBinnaryFuncPattern (SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF SimpleExpr
sf) of
Just (String
name', SimpleExpr
leftArg, SimpleExpr
rightArg) -> SimpleExpr -> String
showWithBrackets SimpleExpr
leftArg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SimpleExpr -> String
showWithBrackets SimpleExpr
rightArg
Maybe (String, SimpleExpr, SimpleExpr)
Nothing -> String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((SimpleExpr -> String) -> [SimpleExpr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimpleExpr -> String
forall a. Show a => a -> String
show [SimpleExpr]
args) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
needBrackets :: SimpleExpr -> Bool
needBrackets :: SimpleExpr -> Bool
needBrackets = Maybe (String, SimpleExpr, SimpleExpr) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (String, SimpleExpr, SimpleExpr) -> Bool)
-> (SimpleExpr -> Maybe (String, SimpleExpr, SimpleExpr))
-> SimpleExpr
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleExpr -> Maybe (String, SimpleExpr, SimpleExpr)
matchBinnaryFuncPattern
showWithBrackets :: SimpleExpr -> String
showWithBrackets :: SimpleExpr -> String
showWithBrackets SimpleExpr
e =
if SimpleExpr -> Bool
needBrackets SimpleExpr
e
then String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SimpleExpr -> String
forall a. Show a => a -> String
show SimpleExpr
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
else SimpleExpr -> String
forall a. Show a => a -> String
show SimpleExpr
e
matchBinnaryFuncPattern :: SimpleExpr -> Maybe (String, SimpleExpr, SimpleExpr)
matchBinnaryFuncPattern :: SimpleExpr -> Maybe (String, SimpleExpr, SimpleExpr)
matchBinnaryFuncPattern (Fix (SymbolicFuncF String
name [SimpleExpr
x, SimpleExpr
y])) = do
(Char
first, String
rest1) <- String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
uncons String
name
(String
body, Char
lastCh) <- String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
unsnoc String
rest1
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Char
first Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Char
lastCh Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')'
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
body)
(String, SimpleExpr, SimpleExpr)
-> Maybe (String, SimpleExpr, SimpleExpr)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
body, SimpleExpr
x, SimpleExpr
y)
matchBinnaryFuncPattern SimpleExpr
_ = Maybe (String, SimpleExpr, SimpleExpr)
forall a. Maybe a
Nothing
unaryFunc :: String -> SimpleExpr -> SimpleExpr
unaryFunc :: String -> SimpleExpr -> SimpleExpr
unaryFunc String
name SimpleExpr
x = SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
name [SimpleExpr
x])
binaryFunc :: String -> SimpleExpr -> SimpleExpr -> SimpleExpr
binaryFunc :: String -> SimpleExpr -> SimpleExpr -> SimpleExpr
binaryFunc String
name SimpleExpr
x SimpleExpr
y = SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF (String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")") [SimpleExpr
x, SimpleExpr
y]
instance FromInteger SimpleExpr where
fromInteger :: Integer -> SimpleExpr
fromInteger Integer
n =
if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
then Natural -> SimpleExpr
number (Natural -> SimpleExpr) -> Natural -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. FromIntegral a b => b -> a
fromIntegral Integer
n
else SimpleExpr -> SimpleExpr
forall a. Subtractive a => a -> a
NH.negate (SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ Natural -> SimpleExpr
number (Natural -> SimpleExpr) -> Natural -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. FromIntegral a b => b -> a
fromIntegral (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
P.abs Integer
n
instance Additive SimpleExpr where
zero :: SimpleExpr
zero = Natural -> SimpleExpr
number Natural
0
+ :: SimpleExpr -> SimpleExpr -> SimpleExpr
(+) = String -> SimpleExpr -> SimpleExpr -> SimpleExpr
binaryFunc String
"+"
instance Subtractive SimpleExpr where
negate :: SimpleExpr -> SimpleExpr
negate = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"-"
(-) = String -> SimpleExpr -> SimpleExpr -> SimpleExpr
binaryFunc String
"-"
instance Multiplicative SimpleExpr where
one :: SimpleExpr
one = Natural -> SimpleExpr
number Natural
1
* :: SimpleExpr -> SimpleExpr -> SimpleExpr
(*) = String -> SimpleExpr -> SimpleExpr -> SimpleExpr
binaryFunc String
"*"
instance Divisive SimpleExpr where
/ :: SimpleExpr -> SimpleExpr -> SimpleExpr
(/) = String -> SimpleExpr -> SimpleExpr -> SimpleExpr
binaryFunc String
"/"
instance ExpField SimpleExpr where
exp :: SimpleExpr -> SimpleExpr
exp = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"exp"
log :: SimpleExpr -> SimpleExpr
log = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"log"
** :: SimpleExpr -> SimpleExpr -> SimpleExpr
(**) = String -> SimpleExpr -> SimpleExpr -> SimpleExpr
binaryFunc String
"^"
sqrt :: SimpleExpr -> SimpleExpr
sqrt = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"sqrt"
instance TrigField SimpleExpr where
pi :: SimpleExpr
pi = String -> SimpleExpr
variable String
"pi"
sin :: SimpleExpr -> SimpleExpr
sin = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"sin"
cos :: SimpleExpr -> SimpleExpr
cos = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"cos"
tan :: SimpleExpr -> SimpleExpr
tan = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"tg"
asin :: SimpleExpr -> SimpleExpr
asin = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"arcsin"
acos :: SimpleExpr -> SimpleExpr
acos = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"arccos"
atan :: SimpleExpr -> SimpleExpr
atan = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"arctan"
sinh :: SimpleExpr -> SimpleExpr
sinh = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"sh"
cosh :: SimpleExpr -> SimpleExpr
cosh = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"ch"
tanh :: SimpleExpr -> SimpleExpr
tanh = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"th"
atan2 :: SimpleExpr -> SimpleExpr -> SimpleExpr
atan2 SimpleExpr
a SimpleExpr
b = SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"atan2" [SimpleExpr
a, SimpleExpr
b]
asinh :: SimpleExpr -> SimpleExpr
asinh = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"arcsh"
acosh :: SimpleExpr -> SimpleExpr
acosh = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"arcch"
atanh :: SimpleExpr -> SimpleExpr
atanh = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"arcth"
instance Num SimpleExpr where
+ :: SimpleExpr -> SimpleExpr -> SimpleExpr
(+) = SimpleExpr -> SimpleExpr -> SimpleExpr
forall a. Additive a => a -> a -> a
(NH.+)
(-) = SimpleExpr -> SimpleExpr -> SimpleExpr
forall a. Subtractive a => a -> a -> a
(NH.-)
* :: SimpleExpr -> SimpleExpr -> SimpleExpr
(*) = SimpleExpr -> SimpleExpr -> SimpleExpr
forall a. Multiplicative a => a -> a -> a
(NH.*)
negate :: SimpleExpr -> SimpleExpr
negate = SimpleExpr -> SimpleExpr
forall a. Subtractive a => a -> a
NH.negate
abs :: SimpleExpr -> SimpleExpr
abs = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"abs"
signum :: SimpleExpr -> SimpleExpr
signum = String -> SimpleExpr -> SimpleExpr
unaryFunc String
"sign"
fromInteger :: Integer -> SimpleExpr
fromInteger = Integer -> SimpleExpr
forall a b. FromIntegral a b => b -> a
fromIntegral
iterateUntilEqual :: (Eq x) => (x -> x) -> x -> x
iterateUntilEqual :: forall x. Eq x => (x -> x) -> x -> x
iterateUntilEqual x -> x
f x
x =
let fx :: x
fx = x -> x
f x
x
in if x
fx x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
x
then x
x
else x -> x -> x
forall a b. a -> b -> b
seq x
fx ((x -> x) -> x -> x
forall x. Eq x => (x -> x) -> x -> x
iterateUntilEqual x -> x
f x
fx)
simplifyStep :: (SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr
simplifyStep :: (SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr
simplifyStep SimpleExpr -> SimpleExpr
f SimpleExpr
e = case SimpleExpr
e of
n :: SimpleExpr
n@(Fix (NumberF Natural
_)) -> SimpleExpr
n
c :: SimpleExpr
c@(Fix (VariableF String
_)) -> SimpleExpr
c
Fix (SymbolicFuncF String
name [SimpleExpr
arg]) -> case String
name of
String
"-" -> case SimpleExpr -> SimpleExprF SimpleExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix (SimpleExpr -> SimpleExpr
f SimpleExpr
arg) of
NumberF Natural
0 -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ Natural -> SimpleExprF SimpleExpr
forall a. Natural -> SimpleExprF a
NumberF Natural
0
SymbolicFuncF String
"-" [SimpleExpr
arg'] -> SimpleExpr -> SimpleExpr
f SimpleExpr
arg'
SymbolicFuncF String
"(-)" [SimpleExpr
leftArg, SimpleExpr
rightArg] -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"(-)" [SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg, SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg]
SimpleExprF SimpleExpr
_ -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"-" [SimpleExpr -> SimpleExpr
f SimpleExpr
arg]
String
_ -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
name [SimpleExpr -> SimpleExpr
f SimpleExpr
arg]
Fix (SymbolicFuncF String
name [SimpleExpr
leftArg, SimpleExpr
rightArg]) -> case String
name of
String
"(+)" -> case (SimpleExpr -> SimpleExprF SimpleExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix SimpleExpr
leftArg, SimpleExpr -> SimpleExprF SimpleExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix SimpleExpr
rightArg) of
(NumberF Natural
0, SimpleExprF SimpleExpr
_) -> SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg
(SimpleExprF SimpleExpr
_, NumberF Natural
0) -> SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg
(NumberF Natural
n, NumberF Natural
m) -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Natural -> SimpleExprF SimpleExpr
forall a. Natural -> SimpleExprF a
NumberF (Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
P.+ Natural
m))
(SimpleExprF SimpleExpr, SimpleExprF SimpleExpr)
_ -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"(+)" [SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg, SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg])
String
"(-)" -> case (SimpleExpr -> SimpleExprF SimpleExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix SimpleExpr
leftArg, SimpleExpr -> SimpleExprF SimpleExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix SimpleExpr
rightArg) of
(NumberF Natural
0, SimpleExprF SimpleExpr
_) -> (SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr
forall a. Subtractive a => a -> a
NH.negate SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg
(SimpleExprF SimpleExpr
_, NumberF Natural
0) -> SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg
(NumberF Natural
n, NumberF Natural
m) -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Natural -> SimpleExprF SimpleExpr
forall a. Natural -> SimpleExprF a
NumberF (Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
P.- Natural
m))
(SimpleExprF SimpleExpr, SimpleExprF SimpleExpr)
_ ->
if SimpleExpr
fX SimpleExpr -> SimpleExpr -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleExpr
fY
then SimpleExpr
forall a. Additive a => a
zero
else SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"(-)" [SimpleExpr
fX, SimpleExpr
fY])
where
fX :: SimpleExpr
fX = SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg
fY :: SimpleExpr
fY = SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg
String
"(*)" -> case (SimpleExpr -> SimpleExprF SimpleExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix SimpleExpr
leftArg, SimpleExpr -> SimpleExprF SimpleExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix SimpleExpr
rightArg) of
(NumberF Natural
0, SimpleExprF SimpleExpr
_) -> SimpleExpr
forall a. Additive a => a
zero
(SimpleExprF SimpleExpr
_, NumberF Natural
0) -> SimpleExpr
forall a. Additive a => a
zero
(NumberF Natural
1, SimpleExprF SimpleExpr
_) -> SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg
(SimpleExprF SimpleExpr
_, NumberF Natural
1) -> SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg
(NumberF Natural
n, NumberF Natural
m) -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Natural -> SimpleExprF SimpleExpr
forall a. Natural -> SimpleExprF a
NumberF (Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
P.* Natural
m))
(SymbolicFuncF String
"-" [SimpleExpr
leftArg'], SymbolicFuncF String
"-" [SimpleExpr
rightArg']) ->
SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"(*)" [SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg', SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg']
(SymbolicFuncF String
"-" [SimpleExpr
leftArg'], SimpleExprF SimpleExpr
rightArg') ->
SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"-" [SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"(*)" [SimpleExpr
leftArg', SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF SimpleExpr
rightArg']]
(SimpleExprF SimpleExpr
leftArg', SymbolicFuncF String
"-" [SimpleExpr
rightArg']) ->
SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"-" [SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SimpleExprF SimpleExpr -> SimpleExpr)
-> SimpleExprF SimpleExpr -> SimpleExpr
forall a b. (a -> b) -> a -> b
$ String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"(*)" [SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix SimpleExprF SimpleExpr
leftArg', SimpleExpr
rightArg']]
(SimpleExprF SimpleExpr, SimpleExprF SimpleExpr)
_ -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"(*)" [SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg, SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg])
String
"(^)" -> case (SimpleExpr -> SimpleExprF SimpleExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix SimpleExpr
leftArg, SimpleExpr -> SimpleExprF SimpleExpr
forall (f :: * -> *). Fix f -> f (Fix f)
unFix SimpleExpr
rightArg) of
(NumberF Natural
n, NumberF Natural
m) -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Natural -> SimpleExprF SimpleExpr
forall a. Natural -> SimpleExprF a
NumberF (Natural
n Natural -> Natural -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
P.^ Natural
m))
(NumberF Natural
0, SimpleExprF SimpleExpr
_) -> SimpleExpr
forall a. Additive a => a
zero
(SimpleExprF SimpleExpr
_, NumberF Natural
0) -> SimpleExpr
forall a. Multiplicative a => a
one
(NumberF Natural
1, SimpleExprF SimpleExpr
_) -> SimpleExpr
forall a. Multiplicative a => a
one
(SimpleExprF SimpleExpr
_, NumberF Natural
1) -> SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg
(SimpleExprF SimpleExpr, SimpleExprF SimpleExpr)
_ -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
"(^)" [SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg, SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg])
String
_ -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
name [SimpleExpr -> SimpleExpr
f SimpleExpr
leftArg, SimpleExpr -> SimpleExpr
f SimpleExpr
rightArg])
Fix (SymbolicFuncF String
name [SimpleExpr]
args) -> SimpleExprF SimpleExpr -> SimpleExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (String -> [SimpleExpr] -> SimpleExprF SimpleExpr
forall a. String -> [a] -> SimpleExprF a
SymbolicFuncF String
name ((SimpleExpr -> SimpleExpr) -> [SimpleExpr] -> [SimpleExpr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimpleExpr -> SimpleExpr
f [SimpleExpr]
args))
simplifyExpr :: SimpleExpr -> SimpleExpr
simplifyExpr :: SimpleExpr -> SimpleExpr
simplifyExpr = ((SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr)
-> SimpleExpr -> SimpleExpr
forall a. (a -> a) -> a
fix (((SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr)
-> SimpleExpr -> SimpleExpr)
-> ((SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr)
-> SimpleExpr
-> SimpleExpr
forall a b. (a -> b) -> a -> b
$ (SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr
forall x. Eq x => (x -> x) -> x -> x
iterateUntilEqual ((SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr)
-> ((SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr)
-> (SimpleExpr -> SimpleExpr)
-> SimpleExpr
-> SimpleExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr
simplifyStep
simplify :: (ExtandableMap SimpleExpr SimpleExpr a a) => a -> a
simplify :: forall a. ExtandableMap SimpleExpr SimpleExpr a a => a -> a
simplify = (SimpleExpr -> SimpleExpr) -> a -> a
forall a b c d. ExtandableMap a b c d => (a -> b) -> c -> d
extendMap SimpleExpr -> SimpleExpr
simplifyExpr