{-# LANGUAGE DeriveGeneric, PatternGuards, PatternSynonyms,
MultiParamTypeClasses, FlexibleContexts, DeriveDataTypeable,
GeneralizedNewtypeDeriving #-}
module Math.MFSolve
(
SimpleExpr(..), Expr, LinExpr(..), UnaryOp(..), BinaryOp(..),
SimpleVar(..),
makeVariable,
makeConstant, evalExpr, fromSimple, toSimple, evalSimple, hasVar,
mapSimple, mapExpr,
Dependencies, DepError(..),
noDeps, addEquation, eliminate,
getKnown, knownVars, varDefined, nonlinearEqs, dependendVars,
(===), (=&=), dependencies, getValue, getKnownM,
varDefinedM, eliminateM, ignore,
MFSolver,
runSolver, evalSolver, execSolver, unsafeSolve, showVars,
MFSolverT,
runSolverT, evalSolverT, execSolverT, unsafeSolveT)
where
import qualified Data.HashMap.Strict as M
import qualified Data.HashSet as H
import GHC.Generics
import Control.Monad
import Control.Monad.Except
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Identity
import Control.Monad.Cont
import Control.Exception
import Data.Typeable
import Data.Hashable
import Data.Maybe
import Data.List
import Data.Function(on)
data BinaryOp =
Add |
Mul
deriving BinaryOp -> BinaryOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryOp -> BinaryOp -> Bool
$c/= :: BinaryOp -> BinaryOp -> Bool
== :: BinaryOp -> BinaryOp -> Bool
$c== :: BinaryOp -> BinaryOp -> Bool
Eq
data UnaryOp =
Sin |
Cos |
Abs |
Recip |
Signum |
Exp |
Log |
Cosh |
Atanh |
Tan |
Tanh |
Sinh |
Asin |
Acos |
Asinh |
Acosh |
Atan
deriving (UnaryOp -> UnaryOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnaryOp -> UnaryOp -> Bool
$c/= :: UnaryOp -> UnaryOp -> Bool
== :: UnaryOp -> UnaryOp -> Bool
$c== :: UnaryOp -> UnaryOp -> Bool
Eq, forall x. Rep UnaryOp x -> UnaryOp
forall x. UnaryOp -> Rep UnaryOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnaryOp x -> UnaryOp
$cfrom :: forall x. UnaryOp -> Rep UnaryOp x
Generic)
data SimpleExpr v n =
SEBin BinaryOp (SimpleExpr v n) (SimpleExpr v n) |
SEUn UnaryOp (SimpleExpr v n) |
Var v |
Const n
newtype SimpleVar = SimpleVar String
deriving (SimpleVar -> SimpleVar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleVar -> SimpleVar -> Bool
$c/= :: SimpleVar -> SimpleVar -> Bool
== :: SimpleVar -> SimpleVar -> Bool
$c== :: SimpleVar -> SimpleVar -> Bool
Eq, Eq SimpleVar
SimpleVar -> SimpleVar -> Bool
SimpleVar -> SimpleVar -> Ordering
SimpleVar -> SimpleVar -> SimpleVar
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SimpleVar -> SimpleVar -> SimpleVar
$cmin :: SimpleVar -> SimpleVar -> SimpleVar
max :: SimpleVar -> SimpleVar -> SimpleVar
$cmax :: SimpleVar -> SimpleVar -> SimpleVar
>= :: SimpleVar -> SimpleVar -> Bool
$c>= :: SimpleVar -> SimpleVar -> Bool
> :: SimpleVar -> SimpleVar -> Bool
$c> :: SimpleVar -> SimpleVar -> Bool
<= :: SimpleVar -> SimpleVar -> Bool
$c<= :: SimpleVar -> SimpleVar -> Bool
< :: SimpleVar -> SimpleVar -> Bool
$c< :: SimpleVar -> SimpleVar -> Bool
compare :: SimpleVar -> SimpleVar -> Ordering
$ccompare :: SimpleVar -> SimpleVar -> Ordering
Ord, forall x. Rep SimpleVar x -> SimpleVar
forall x. SimpleVar -> Rep SimpleVar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimpleVar x -> SimpleVar
$cfrom :: forall x. SimpleVar -> Rep SimpleVar x
Generic, Typeable)
data Expr v n = Expr (LinExpr v n) [TrigTerm v n] [NonLinExpr v n]
deriving (Expr v n -> Expr v n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v n. (Eq n, Eq v) => Expr v n -> Expr v n -> Bool
/= :: Expr v n -> Expr v n -> Bool
$c/= :: forall v n. (Eq n, Eq v) => Expr v n -> Expr v n -> Bool
== :: Expr v n -> Expr v n -> Bool
$c== :: forall v n. (Eq n, Eq v) => Expr v n -> Expr v n -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v n x. Rep (Expr v n) x -> Expr v n
forall v n x. Expr v n -> Rep (Expr v n) x
$cto :: forall v n x. Rep (Expr v n) x -> Expr v n
$cfrom :: forall v n x. Expr v n -> Rep (Expr v n) x
Generic)
data LinExpr v n = LinExpr n [(v, n)]
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v n x. Rep (LinExpr v n) x -> LinExpr v n
forall v n x. LinExpr v n -> Rep (LinExpr v n) x
$cto :: forall v n x. Rep (LinExpr v n) x -> LinExpr v n
$cfrom :: forall v n x. LinExpr v n -> Rep (LinExpr v n) x
Generic, LinExpr v n -> LinExpr v n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v n. (Eq n, Eq v) => LinExpr v n -> LinExpr v n -> Bool
/= :: LinExpr v n -> LinExpr v n -> Bool
$c/= :: forall v n. (Eq n, Eq v) => LinExpr v n -> LinExpr v n -> Bool
== :: LinExpr v n -> LinExpr v n -> Bool
$c== :: forall v n. (Eq n, Eq v) => LinExpr v n -> LinExpr v n -> Bool
Eq, Int -> LinExpr v n -> String -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall v n.
(Show n, Show v) =>
Int -> LinExpr v n -> String -> String
forall v n. (Show n, Show v) => [LinExpr v n] -> String -> String
forall v n. (Show n, Show v) => LinExpr v n -> String
showList :: [LinExpr v n] -> String -> String
$cshowList :: forall v n. (Show n, Show v) => [LinExpr v n] -> String -> String
show :: LinExpr v n -> String
$cshow :: forall v n. (Show n, Show v) => LinExpr v n -> String
showsPrec :: Int -> LinExpr v n -> String -> String
$cshowsPrec :: forall v n.
(Show n, Show v) =>
Int -> LinExpr v n -> String -> String
Show)
type Period v n = [(v, n)]
type Phase n = n
type Amplitude v n = LinExpr v n
type TrigTerm v n = (Period v n, [(Phase n, Amplitude v n)])
data NonLinExpr v n =
UnaryApp UnaryOp (Expr v n) |
MulExp (Expr v n) (Expr v n) |
SinExp (Expr v n)
deriving (NonLinExpr v n -> NonLinExpr v n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v n.
(Eq v, Eq n) =>
NonLinExpr v n -> NonLinExpr v n -> Bool
/= :: NonLinExpr v n -> NonLinExpr v n -> Bool
$c/= :: forall v n.
(Eq v, Eq n) =>
NonLinExpr v n -> NonLinExpr v n -> Bool
== :: NonLinExpr v n -> NonLinExpr v n -> Bool
$c== :: forall v n.
(Eq v, Eq n) =>
NonLinExpr v n -> NonLinExpr v n -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v n x. Rep (NonLinExpr v n) x -> NonLinExpr v n
forall v n x. NonLinExpr v n -> Rep (NonLinExpr v n) x
$cto :: forall v n x. Rep (NonLinExpr v n) x -> NonLinExpr v n
$cfrom :: forall v n x. NonLinExpr v n -> Rep (NonLinExpr v n) x
Generic)
type LinearMap v n = M.HashMap v (LinExpr v n)
type TrigEq v n = (Period v n, Amplitude v n, Phase n, n)
type TrigEq2 v n = M.HashMap (Period v n)
(M.HashMap v (Expr v n))
pattern LinearE :: LinExpr v n -> Expr v n
pattern $bLinearE :: forall v n. LinExpr v n -> Expr v n
$mLinearE :: forall {r} {v} {n}.
Expr v n -> (LinExpr v n -> r) -> ((# #) -> r) -> r
LinearE l = Expr l [] []
pattern ConstE :: n -> Expr v n
pattern $bConstE :: forall n v. n -> Expr v n
$mConstE :: forall {r} {n} {v}. Expr v n -> (n -> r) -> ((# #) -> r) -> r
ConstE c = Expr (LinExpr c []) [] []
pattern LConst :: n -> LinExpr v n
pattern $bLConst :: forall n v. n -> LinExpr v n
$mLConst :: forall {r} {n} {v}. LinExpr v n -> (n -> r) -> ((# #) -> r) -> r
LConst c = LinExpr c []
instance (Hashable v, Hashable n) => Hashable (LinExpr v n)
instance (Hashable v, Hashable n) => Hashable (NonLinExpr v n)
instance Hashable UnaryOp
instance (Hashable v, Hashable n) => Hashable (Expr v n)
instance Hashable SimpleVar
instance Show SimpleVar where
show :: SimpleVar -> String
show (SimpleVar String
s) = String
s
data Dependencies v n = Dependencies
(M.HashMap v (H.HashSet v))
(LinearMap v n)
[TrigEq v n]
(TrigEq2 v n)
[Expr v n]
data DepError v n =
UndefinedVar v |
UnknownVar v n |
InconsistentEq n (Expr v n) |
RedundantEq (Expr v n)
deriving Typeable
instance (Ord n, Num n, Show v, Show n, Typeable v, Typeable n)
=> Exception (DepError v n)
instance (Ord n, Num n, Eq n, Show v, Show n) => Show (Expr v n) where
show :: Expr v n -> String
show Expr v n
e = forall a. Show a => a -> String
show (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e)
newtype MFSolverT v n m a =
MFSolverT (StateT (Dependencies v n) (ExceptT (DepError v n) m) a)
deriving (forall a b. a -> MFSolverT v n m b -> MFSolverT v n m a
forall a b. (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
forall v n (m :: * -> *) a b.
Functor m =>
a -> MFSolverT v n m b -> MFSolverT v n m a
forall v n (m :: * -> *) a b.
Functor m =>
(a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MFSolverT v n m b -> MFSolverT v n m a
$c<$ :: forall v n (m :: * -> *) a b.
Functor m =>
a -> MFSolverT v n m b -> MFSolverT v n m a
fmap :: forall a b. (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
$cfmap :: forall v n (m :: * -> *) a b.
Functor m =>
(a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
Functor, forall a. a -> MFSolverT v n m a
forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m a
forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
forall a b.
MFSolverT v n m (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
forall a b c.
(a -> b -> c)
-> MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m c
forall {v} {n} {m :: * -> *}. Monad m => Functor (MFSolverT v n m)
forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m a
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
forall v n (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m a
$c<* :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m a
*> :: forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
$c*> :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
liftA2 :: forall a b c.
(a -> b -> c)
-> MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m c
$cliftA2 :: forall v n (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m c
<*> :: forall a b.
MFSolverT v n m (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
$c<*> :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
pure :: forall a. a -> MFSolverT v n m a
$cpure :: forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
Applicative, forall a. a -> MFSolverT v n m a
forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
forall a b.
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b
forall v n (m :: * -> *). Monad m => Applicative (MFSolverT v n m)
forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> MFSolverT v n m a
$creturn :: forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
>> :: forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
$c>> :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
>>= :: forall a b.
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b
$c>>= :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b
Monad, forall a. IO a -> MFSolverT v n m a
forall {v} {n} {m :: * -> *}. MonadIO m => Monad (MFSolverT v n m)
forall v n (m :: * -> *) a. MonadIO m => IO a -> MFSolverT v n m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> MFSolverT v n m a
$cliftIO :: forall v n (m :: * -> *) a. MonadIO m => IO a -> MFSolverT v n m a
MonadIO, MonadState (Dependencies v n),
MonadError (DepError v n), MonadReader s, MonadWriter s,
forall a b.
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a
forall {v} {n} {m :: * -> *}.
MonadCont m =>
Monad (MFSolverT v n m)
forall v n (m :: * -> *) a b.
MonadCont m =>
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
callCC :: forall a b.
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a
$ccallCC :: forall v n (m :: * -> *) a b.
MonadCont m =>
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a
MonadCont)
instance MonadTrans (MFSolverT v n) where
lift :: forall (m :: * -> *) a. Monad m => m a -> MFSolverT v n m a
lift = forall v n (m :: * -> *) a.
StateT (Dependencies v n) (ExceptT (DepError v n) m) a
-> MFSolverT v n m a
MFSolverT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
runSolverT :: MFSolverT v n m a -> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT :: forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT (MFSolverT StateT (Dependencies v n) (ExceptT (DepError v n) m) a
s) = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT (Dependencies v n) (ExceptT (DepError v n) m) a
s
type MFSolver v n a = MFSolverT v n Identity a
withParens :: (Show t1, Show t, Ord t1, Num t1, Eq t1) => SimpleExpr t t1
-> [BinaryOp] -> String
withParens :: forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens e :: SimpleExpr t t1
e@(SEBin BinaryOp
op SimpleExpr t t1
_ SimpleExpr t t1
_) [BinaryOp]
ops
| BinaryOp
op forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BinaryOp]
ops = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SimpleExpr t t1
e forall a. [a] -> [a] -> [a]
++ String
")"
withParens SimpleExpr t t1
e [BinaryOp]
_ = forall a. Show a => a -> String
show SimpleExpr t t1
e
instance (Show v, Ord n, Show n, Num n, Eq n) => Show (SimpleExpr v n) where
show :: SimpleExpr v n -> String
show (Var v
v) = forall a. Show a => a -> String
show v
v
show (Const n
n) = forall a. Show a => a -> String
show n
n
show (SEBin BinaryOp
Add SimpleExpr v n
e1 (SEBin BinaryOp
Mul (Const n
e2) SimpleExpr v n
e3))
| n
e2 forall a. Ord a => a -> a -> Bool
< n
0 =
forall a. Show a => a -> String
show SimpleExpr v n
e1 forall a. [a] -> [a] -> [a]
++ String
" - " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (forall v n. n -> SimpleExpr v n
Const (forall a. Num a => a -> a
negate n
e2)) SimpleExpr v n
e3)
show (SEBin BinaryOp
Add SimpleExpr v n
e1 SimpleExpr v n
e2) =
forall a. Show a => a -> String
show SimpleExpr v n
e1 forall a. [a] -> [a] -> [a]
++ String
" + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SimpleExpr v n
e2
show (SEBin BinaryOp
Mul (Const n
1) SimpleExpr v n
e) = forall a. Show a => a -> String
show SimpleExpr v n
e
show (SEBin BinaryOp
Mul SimpleExpr v n
e (Const n
1)) = forall a. Show a => a -> String
show SimpleExpr v n
e
show (SEBin BinaryOp
Mul SimpleExpr v n
e1 (SEUn UnaryOp
Recip SimpleExpr v n
e2)) =
forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e1 [BinaryOp
Add] forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e2 [BinaryOp
Add, BinaryOp
Mul]
show (SEBin BinaryOp
Mul SimpleExpr v n
e1 SimpleExpr v n
e2) =
forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e1 [BinaryOp
Add] forall a. [a] -> [a] -> [a]
++ String
"*" forall a. [a] -> [a] -> [a]
++ forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e2 [BinaryOp
Add]
show (SEUn UnaryOp
Exp (SEBin BinaryOp
Mul (SEUn UnaryOp
Log SimpleExpr v n
e1) SimpleExpr v n
e2)) =
forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e1 [BinaryOp
Add, BinaryOp
Mul] forall a. [a] -> [a] -> [a]
++ String
"**" forall a. [a] -> [a] -> [a]
++ forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e2 [BinaryOp
Add, BinaryOp
Mul]
show (SEUn UnaryOp
op SimpleExpr v n
e) = forall a. Show a => a -> String
show UnaryOp
op forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SimpleExpr v n
e forall a. [a] -> [a] -> [a]
++ String
")"
instance Show BinaryOp where
show :: BinaryOp -> String
show BinaryOp
Add = String
"+"
show BinaryOp
Mul = String
"*"
instance Show UnaryOp where
show :: UnaryOp -> String
show UnaryOp
Sin = String
"sin"
show UnaryOp
Abs = String
"abs"
show UnaryOp
Recip = String
"1/"
show UnaryOp
Signum = String
"sign"
show UnaryOp
Exp = String
"exp"
show UnaryOp
Log = String
"log"
show UnaryOp
Cos = String
"cos"
show UnaryOp
Cosh = String
"cosh"
show UnaryOp
Atanh = String
"atanh"
show UnaryOp
Tan = String
"tan"
show UnaryOp
Tanh = String
"tanh"
show UnaryOp
Sinh = String
"sinh"
show UnaryOp
Asin = String
"asin"
show UnaryOp
Acos = String
"acos"
show UnaryOp
Asinh = String
"asinh"
show UnaryOp
Acosh = String
"acosh"
show UnaryOp
Atan = String
"atan"
instance (Floating n, Ord n, Ord v) => Num (Expr v n) where
+ :: Expr v n -> Expr v n -> Expr v n
(+) = forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
addExpr
* :: Expr v n -> Expr v n -> Expr v n
(*) = forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
mulExpr
negate :: Expr v n -> Expr v n
negate = forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
mulExpr (forall n v. n -> Expr v n
ConstE (-n
1))
abs :: Expr v n -> Expr v n
abs = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Abs
signum :: Expr v n -> Expr v n
signum = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Signum
fromInteger :: Integer -> Expr v n
fromInteger = forall n v. n -> Expr v n
ConstE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
instance (Floating n, Ord n, Ord v) => Fractional (Expr v n) where
recip :: Expr v n -> Expr v n
recip = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Recip
fromRational :: Rational -> Expr v n
fromRational = forall n v. n -> Expr v n
ConstE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
instance (Floating n, Ord n, Ord v) => Floating (Expr v n) where
pi :: Expr v n
pi = forall n v. n -> Expr v n
ConstE forall a. Floating a => a
pi
exp :: Expr v n -> Expr v n
exp = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Exp
log :: Expr v n -> Expr v n
log = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Log
sin :: Expr v n -> Expr v n
sin = forall n v. Floating n => Expr v n -> Expr v n
sinExpr
cos :: Expr v n -> Expr v n
cos Expr v n
a = forall n v. Floating n => Expr v n -> Expr v n
sinExpr (Expr v n
a forall a. Num a => a -> a -> a
+ forall n v. n -> Expr v n
ConstE (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/n
2))
cosh :: Expr v n -> Expr v n
cosh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Cosh
atanh :: Expr v n -> Expr v n
atanh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Atanh
tan :: Expr v n -> Expr v n
tan = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Tan
tanh :: Expr v n -> Expr v n
tanh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Tanh
sinh :: Expr v n -> Expr v n
sinh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Sinh
asin :: Expr v n -> Expr v n
asin = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Asin
acos :: Expr v n -> Expr v n
acos = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Acos
asinh :: Expr v n -> Expr v n
asinh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Asinh
acosh :: Expr v n -> Expr v n
acosh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Acosh
atan :: Expr v n -> Expr v n
atan = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Atan
instance (Show n, Floating n, Ord n, Ord v, Show v)
=> Show (Dependencies v n) where
show :: Dependencies v n -> String
show dep :: Dependencies v n
dep@(Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
[String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall {n} {a} {v}.
(Ord n, Num n, Show a, Show v, Show n) =>
(a, LinExpr v n) -> String
showLin (forall k v. HashMap k v -> [(k, v)]
M.toList LinearMap v n
lin) forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
showNl (forall n v.
(Ord n, Ord v, Floating n) =>
Dependencies v n -> [Expr v n]
nonlinearEqs Dependencies v n
dep))
where showLin :: (a, LinExpr v n) -> String
showLin (a
v, LinExpr v n
e) = forall a. Show a => a -> String
show a
v forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
e)
showNl :: a -> String
showNl a
e = forall a. Show a => a -> String
show a
e forall a. [a] -> [a] -> [a]
++ String
" = 0"
instance (Num n, Ord n, Show n, Show v) => Show (DepError v n) where
show :: DepError v n -> String
show (InconsistentEq n
a Expr v n
e) =
String
"Inconsistent equations, off by " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show n
a forall a. [a] -> [a] -> [a]
++
String
". original expression: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Expr v n
e
show (RedundantEq Expr v n
e) =
String
"Redundant Equation: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Expr v n
e
show (UndefinedVar v
v) =
forall a. HasCallStack => String -> a
error (String
"Variable is undefined: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show v
v)
show (UnknownVar v
v n
n) =
forall a. HasCallStack => String -> a
error (String
"Value of variable not known: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show v
v forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show n
n)
addSimple :: (Num t1, Eq t1) => SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimple :: forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimple (Const t1
0) SimpleExpr t t1
e = SimpleExpr t t1
e
addSimple SimpleExpr t t1
e (Const t1
0) = SimpleExpr t t1
e
addSimple SimpleExpr t t1
e1 SimpleExpr t t1
e2 = forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Add SimpleExpr t t1
e1 SimpleExpr t t1
e2
seHasVar :: Eq v => v -> SimpleExpr v t -> Bool
seHasVar :: forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v1 (Var v
v2) = v
v1 forall a. Eq a => a -> a -> Bool
== v
v2
seHasVar v
_ (Const t
_) = Bool
False
seHasVar v
v (SEBin BinaryOp
_ SimpleExpr v t
e1 SimpleExpr v t
e2) =
forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v SimpleExpr v t
e1 Bool -> Bool -> Bool
||
forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v SimpleExpr v t
e2
seHasVar v
v (SEUn UnaryOp
_ SimpleExpr v t
e) = forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v SimpleExpr v t
e
hasVar :: (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar :: forall t v. (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar v
v = forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple
linToSimple :: (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple :: forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple (LinExpr n
v [(v, n)]
t) =
forall v n. n -> SimpleExpr v n
Const n
v forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
`addSimple`
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimpleforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {n} {v}. (Eq n, Num n) => (v, n) -> SimpleExpr v n
mul) (forall v n. n -> SimpleExpr v n
Const n
0) [(v, n)]
t
where
mul :: (v, n) -> SimpleExpr v n
mul (v
v2, n
1) = forall v n. v -> SimpleExpr v n
Var v
v2
mul (v
v2, n
c) = forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (forall v n. n -> SimpleExpr v n
Const n
c) (forall v n. v -> SimpleExpr v n
Var v
v2)
trigToSimple :: (Num n, Eq n) => TrigTerm v n -> SimpleExpr v n
trigToSimple :: forall n v. (Num n, Eq n) => TrigTerm v n -> SimpleExpr v n
trigToSimple (Period v n
theta, [(n, Amplitude v n)]
t) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimpleforall b c a. (b -> c) -> (a -> b) -> a -> c
.(n, Amplitude v n) -> SimpleExpr v n
makeSin) (forall v n. n -> SimpleExpr v n
Const n
0) [(n, Amplitude v n)]
t
where
makeSin :: (n, Amplitude v n) -> SimpleExpr v n
makeSin (n
alpha, Amplitude v n
n) =
forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple Amplitude v n
n)
(forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
Sin SimpleExpr v n
angle) where
angle :: SimpleExpr v n
angle = forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple (forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
alpha Period v n
theta)
nonlinToSimple :: (Num n, Eq n) => NonLinExpr v n -> SimpleExpr v n
nonlinToSimple :: forall n v. (Num n, Eq n) => NonLinExpr v n -> SimpleExpr v n
nonlinToSimple (UnaryApp UnaryOp
o Expr v n
e) =
forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
o (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e)
nonlinToSimple (MulExp Expr v n
e1 Expr v n
e2) =
forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e1) (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e2)
nonlinToSimple (SinExp Expr v n
e) =
forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
Sin (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e)
toSimple :: (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple :: forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple (Expr LinExpr v n
lin [TrigTerm v n]
trig [NonLinExpr v n]
nonlin) =
forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple LinExpr v n
lin forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
`addSimple`
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimpleforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v. (Num n, Eq n) => TrigTerm v n -> SimpleExpr v n
trigToSimple)
(forall v n. n -> SimpleExpr v n
Const n
0) [TrigTerm v n]
trig forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
`addSimple`
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimpleforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v. (Num n, Eq n) => NonLinExpr v n -> SimpleExpr v n
nonlinToSimple)
(forall v n. n -> SimpleExpr v n
Const n
0) [NonLinExpr v n]
nonlin
evalBin :: (Floating n) => BinaryOp -> n -> n -> n
evalBin :: forall n. Floating n => BinaryOp -> n -> n -> n
evalBin BinaryOp
Add = forall a. Num a => a -> a -> a
(+)
evalBin BinaryOp
Mul = forall a. Num a => a -> a -> a
(*)
evalUn :: (Floating n) => UnaryOp -> n -> n
evalUn :: forall n. Floating n => UnaryOp -> n -> n
evalUn UnaryOp
Sin = forall a. Floating a => a -> a
sin
evalUn UnaryOp
Abs = forall a. Num a => a -> a
abs
evalUn UnaryOp
Recip = forall a. Fractional a => a -> a
recip
evalUn UnaryOp
Signum = forall a. Num a => a -> a
signum
evalUn UnaryOp
Exp = forall a. Floating a => a -> a
exp
evalUn UnaryOp
Log = forall a. Floating a => a -> a
log
evalUn UnaryOp
Cos = forall a. Floating a => a -> a
cos
evalUn UnaryOp
Cosh = forall a. Floating a => a -> a
cosh
evalUn UnaryOp
Atanh = forall a. Floating a => a -> a
atanh
evalUn UnaryOp
Tan = forall a. Floating a => a -> a
tan
evalUn UnaryOp
Tanh = forall a. Floating a => a -> a
tanh
evalUn UnaryOp
Sinh = forall a. Floating a => a -> a
sinh
evalUn UnaryOp
Asin = forall a. Floating a => a -> a
asin
evalUn UnaryOp
Acos = forall a. Floating a => a -> a
acos
evalUn UnaryOp
Asinh = forall a. Floating a => a -> a
asinh
evalUn UnaryOp
Acosh = forall a. Floating a => a -> a
acosh
evalUn UnaryOp
Atan = forall a. Floating a => a -> a
atan
evalSimple :: Floating m => (n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple :: forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> m
_ v -> m
s (Var v
v) = v -> m
s v
v
evalSimple n -> m
g v -> m
_ (Const n
c) = n -> m
g n
c
evalSimple n -> m
g v -> m
s (SEBin BinaryOp
f SimpleExpr v n
e1 SimpleExpr v n
e2) =
forall n. Floating n => BinaryOp -> n -> n -> n
evalBin BinaryOp
f (forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> m
g v -> m
s SimpleExpr v n
e1) (forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> m
g v -> m
s SimpleExpr v n
e2)
evalSimple n -> m
g v -> m
s (SEUn UnaryOp
f SimpleExpr v n
e) =
forall n. Floating n => UnaryOp -> n -> n
evalUn UnaryOp
f (forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> m
g v -> m
s SimpleExpr v n
e)
mapSimple :: (Floating m, Floating n) => (n -> m) -> (v -> u) -> SimpleExpr v n
-> SimpleExpr u m
mapSimple :: forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
_ v -> u
g (Var v
v) = forall v n. v -> SimpleExpr v n
Var (v -> u
g v
v)
mapSimple n -> m
f v -> u
_ (Const n
c) = forall v n. n -> SimpleExpr v n
Const (n -> m
f n
c)
mapSimple n -> m
f v -> u
g (SEBin BinaryOp
h SimpleExpr v n
e1 SimpleExpr v n
e2) =
forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
h (forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
f v -> u
g SimpleExpr v n
e1) (forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
f v -> u
g SimpleExpr v n
e2)
mapSimple n -> m
f v -> u
g (SEUn UnaryOp
h SimpleExpr v n
e) =
forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
h (forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
f v -> u
g SimpleExpr v n
e)
mapExpr :: (Floating m, Floating n, Ord u, Ord v, Eq n, Ord m) =>
(n -> m) -> (v -> u) -> Expr v n -> Expr u m
mapExpr :: forall m n u v.
(Floating m, Floating n, Ord u, Ord v, Eq n, Ord m) =>
(n -> m) -> (v -> u) -> Expr v n -> Expr u m
mapExpr n -> m
f v -> u
g = forall n v.
(Floating n, Ord n, Ord v) =>
SimpleExpr v n -> Expr v n
fromSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
f v -> u
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple
fromSimple :: (Floating n, Ord n, Ord v) => SimpleExpr v n -> Expr v n
fromSimple :: forall n v.
(Floating n, Ord n, Ord v) =>
SimpleExpr v n -> Expr v n
fromSimple = forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple forall n v. n -> Expr v n
makeConstant forall n v. Num n => v -> Expr v n
makeVariable
evalExpr :: (Floating n) => (v -> n) -> SimpleExpr v n -> n
evalExpr :: forall n v. Floating n => (v -> n) -> SimpleExpr v n -> n
evalExpr = forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple forall a. a -> a
id
zeroTerm :: (Num n) => LinExpr v n
zeroTerm :: forall n v. Num n => LinExpr v n
zeroTerm = forall n v. n -> LinExpr v n
LConst n
0
zeroExpr :: (Num n) => Expr v n
zeroExpr :: forall n v. Num n => Expr v n
zeroExpr = forall n v. n -> Expr v n
makeConstant n
0
makeConstant :: n -> Expr v n
makeConstant :: forall n v. n -> Expr v n
makeConstant = forall n v. n -> Expr v n
ConstE
makeVariable :: Num n => v -> Expr v n
makeVariable :: forall n v. Num n => v -> Expr v n
makeVariable v
v = forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v
v, n
1)]
trigExpr :: (Num n) => [TrigTerm v n] -> Expr v n
trigExpr :: forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [TrigTerm v n]
t = forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr forall n v. Num n => LinExpr v n
zeroTerm [TrigTerm v n]
t []
nonlinExpr :: Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr :: forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr = forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr forall n v. Num n => LinExpr v n
zeroTerm []
isConst :: LinExpr v n -> Bool
isConst :: forall v n. LinExpr v n -> Bool
isConst (LConst n
_) = Bool
True
isConst LinExpr v n
_ = Bool
False
linVars :: LinExpr v n -> [v]
linVars :: forall v n. LinExpr v n -> [v]
linVars (LinExpr n
_ [(v, n)]
v) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(v, n)]
v
addLin :: (Ord v, Num n, Eq n) => LinExpr v n -> LinExpr v n -> LinExpr v n
addLin :: forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
addLin (LinExpr n
c1 [(v, n)]
terms1) (LinExpr n
c2 [(v, n)]
terms2) =
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
c1forall a. Num a => a -> a -> a
+n
c2) [(v, n)]
terms3 where
terms3 :: [(v, n)]
terms3 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= n
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [(v, n)]
terms1 [(v, n)]
terms2 forall a. Num a => a -> a -> a
(+)
addExpr :: (Ord n, Ord v, Floating n) => Expr v n -> Expr v n -> Expr v n
addExpr :: forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
addExpr (Expr LinExpr v n
lt1 [TrigTerm v n]
trig1 [NonLinExpr v n]
nl1) (Expr LinExpr v n
lt2 [TrigTerm v n]
trig2 [NonLinExpr v n]
nl2) =
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr (forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
addLin LinExpr v n
lt1 LinExpr v n
lt2) [TrigTerm v n]
trig3 ([NonLinExpr v n]
nl1forall a. [a] -> [a] -> [a]
++[NonLinExpr v n]
nl2)
where
trig3 :: [TrigTerm v n]
trig3 = forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [TrigTerm v n]
trig1 [TrigTerm v n]
trig2 forall a t.
(Ord a, Ord t, Floating a) =>
[(a, LinExpr t a)] -> [(a, LinExpr t a)] -> [(a, LinExpr t a)]
addTrigTerms
merge :: Ord k => [(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge :: forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [] [(k, v)]
l v -> v -> v
_ = [(k, v)]
l
merge [(k, v)]
l [] v -> v -> v
_ = [(k, v)]
l
merge (a :: (k, v)
a@(k
k,v
v):[(k, v)]
as) (b :: (k, v)
b@(k
k2,v
v2):[(k, v)]
bs) v -> v -> v
f = case forall a. Ord a => a -> a -> Ordering
compare k
k k
k2 of
Ordering
LT -> (k, v)
aforall a. a -> [a] -> [a]
: forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [(k, v)]
as ((k, v)
bforall a. a -> [a] -> [a]
:[(k, v)]
bs) v -> v -> v
f
Ordering
EQ -> (k
k, v -> v -> v
f v
v v
v2)forall a. a -> [a] -> [a]
: forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [(k, v)]
as [(k, v)]
bs v -> v -> v
f
Ordering
GT -> (k, v)
bforall a. a -> [a] -> [a]
: forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge ((k, v)
aforall a. a -> [a] -> [a]
:[(k, v)]
as) [(k, v)]
bs v -> v -> v
f
addTrigTerms :: (Ord a, Ord t, Floating a)
=> [(a, LinExpr t a)] -> [(a, LinExpr t a)]
-> [(a, LinExpr t a)]
addTrigTerms :: forall a t.
(Ord a, Ord t, Floating a) =>
[(a, LinExpr t a)] -> [(a, LinExpr t a)] -> [(a, LinExpr t a)]
addTrigTerms [] [(a, LinExpr t a)]
p = [(a, LinExpr t a)]
p
addTrigTerms [(a, LinExpr t a)]
terms [(a, LinExpr t a)]
terms2 =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {v}.
(Ord a, Ord v, Floating a) =>
(a, LinExpr v a) -> [(a, LinExpr v a)] -> [(a, LinExpr v a)]
mergeTerms [(a, LinExpr t a)]
terms [(a, LinExpr t a)]
terms2
where
mergeTerms :: (a, LinExpr v a) -> [(a, LinExpr v a)] -> [(a, LinExpr v a)]
mergeTerms (a
alpha, LinExpr v a
n) ((a
beta, LinExpr v a
m):[(a, LinExpr v a)]
rest) =
case forall a t.
(Ord a, Ord t, Floating a) =>
a -> LinExpr t a -> a -> LinExpr t a -> Maybe (a, LinExpr t a)
addTrigTerm a
alpha LinExpr v a
n a
beta LinExpr v a
m of
Just (a
_, LConst a
0) -> [(a, LinExpr v a)]
rest
Just (a
gamma, LinExpr v a
o) ->
(a, LinExpr v a) -> [(a, LinExpr v a)] -> [(a, LinExpr v a)]
mergeTerms (a
gamma, LinExpr v a
o) [(a, LinExpr v a)]
rest
Maybe (a, LinExpr v a)
Nothing ->
(a
beta, LinExpr v a
m) forall a. a -> [a] -> [a]
: (a, LinExpr v a) -> [(a, LinExpr v a)] -> [(a, LinExpr v a)]
mergeTerms (a
alpha, LinExpr v a
n) [(a, LinExpr v a)]
rest
mergeTerms (a, LinExpr v a)
a [] = [(a, LinExpr v a)
a]
addTrigTerm :: (Ord a, Ord t, Floating a)
=> a -> LinExpr t a -> a -> LinExpr t a -> Maybe (a, LinExpr t a)
addTrigTerm :: forall a t.
(Ord a, Ord t, Floating a) =>
a -> LinExpr t a -> a -> LinExpr t a -> Maybe (a, LinExpr t a)
addTrigTerm a
alpha LinExpr t a
n a
beta LinExpr t a
m
| a
alpha forall a. Eq a => a -> a -> Bool
== a
beta =
forall a. a -> Maybe a
Just (a
alpha, forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
addLin LinExpr t a
n LinExpr t a
m)
| Just a
r <- forall a t.
(Ord a, Fractional a, Eq t) =>
LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple LinExpr t a
n LinExpr t a
m =
let gamma :: a
gamma = forall a. Floating a => a -> a
atan (a
dividentforall a. Fractional a => a -> a -> a
/a
divisor) forall a. Num a => a -> a -> a
+
(if a
divisor forall a. Ord a => a -> a -> Bool
< a
0 then forall a. Floating a => a
pi else a
0)
divident :: a
divident = a
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
sin a
alpha forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
sin a
beta
divisor :: a
divisor = a
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos a
alpha forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
cos a
beta
o :: a
o = forall a. Floating a => a -> a
sqrt(a
dividentforall a. Num a => a -> a -> a
*a
divident forall a. Num a => a -> a -> a
+ a
divisorforall a. Num a => a -> a -> a
*a
divisor)
in forall a. a -> Maybe a
Just (a
gamma, forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
o LinExpr t a
m)
| Bool
otherwise = forall a. Maybe a
Nothing
termIsMultiple :: (Ord a, Fractional a, Eq t)
=> LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple :: forall a t.
(Ord a, Fractional a, Eq t) =>
LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple (LinExpr a
_ [(t, a)]
_) (LinExpr a
0 []) = forall a. Maybe a
Nothing
termIsMultiple (LinExpr a
0 []) (LinExpr a
_ [(t, a)]
_) = forall a. Maybe a
Nothing
termIsMultiple (LinExpr a
0 r1 :: [(t, a)]
r1@((t
_, a
d1):[(t, a)]
_)) (LinExpr a
0 r2 :: [(t, a)]
r2@((t
_, a
d2):[(t, a)]
_))
| forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [(t, a)]
r1 [(t, a)]
r2 (forall a1 a.
(Ord a1, Fractional a1, Eq a) =>
a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm (a
d1forall a. Fractional a => a -> a -> a
/a
d2)) =
forall a. a -> Maybe a
Just (a
d1forall a. Fractional a => a -> a -> a
/a
d2)
termIsMultiple (LinExpr a
c1 [(t, a)]
r1) (LinExpr a
c2 [(t, a)]
r2)
| forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [(t, a)]
r1 [(t, a)]
r2 (forall a1 a.
(Ord a1, Fractional a1, Eq a) =>
a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm (a
c1forall a. Fractional a => a -> a -> a
/a
c2)) =
forall a. a -> Maybe a
Just (a
c1forall a. Fractional a => a -> a -> a
/a
c2)
| Bool
otherwise = forall a. Maybe a
Nothing
compareTerm :: (Ord a1, Fractional a1, Eq a) => a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm :: forall a1 a.
(Ord a1, Fractional a1, Eq a) =>
a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm a1
ratio (a
v3,a1
c3) (a
v4, a1
c4) =
a
v3 forall a. Eq a => a -> a -> Bool
== a
v4 Bool -> Bool -> Bool
&& (forall a. Num a => a -> a
abs(a1
c3 forall a. Num a => a -> a -> a
- (a1
c4 forall a. Num a => a -> a -> a
* a1
ratio)) forall a. Ord a => a -> a -> Bool
<= forall a. Num a => a -> a
abs a1
c3forall a. Num a => a -> a -> a
*a1
2e-50)
compareBy :: [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy :: forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [] [] a -> b -> Bool
_ = Bool
True
compareBy (a
e:[a]
l) (b
e2:[b]
l2) a -> b -> Bool
f =
a -> b -> Bool
f a
e b
e2 Bool -> Bool -> Bool
&& forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [a]
l [b]
l2 a -> b -> Bool
f
compareBy [a]
_ [b]
_ a -> b -> Bool
_ = Bool
False
mulLinExpr :: Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr :: forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr n
x (LinExpr n
e [(v, n)]
terms) =
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
eforall a. Num a => a -> a -> a
*n
x) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
*n
x)) [(v, n)]
terms
mulConstTrig :: (Ord n, Num n) => n -> TrigTerm v n -> TrigTerm v n
mulConstTrig :: forall n v. (Ord n, Num n) => n -> TrigTerm v n -> TrigTerm v n
mulConstTrig n
c (Period v n
theta, [(n, Amplitude v n)]
terms) = (Period v n
theta, [(n, Amplitude v n)]
tt) where
tt :: [(n, Amplitude v n)]
tt = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr n
c)) [(n, Amplitude v n)]
terms
mulLinTrig :: (Ord n, Ord v, Floating n)
=> LinExpr v n -> TrigTerm v n -> Expr v n
mulLinTrig :: forall n v.
(Ord n, Ord v, Floating n) =>
LinExpr v n -> TrigTerm v n -> Expr v n
mulLinTrig LinExpr v n
lt (Period v n
theta, [(n, LinExpr v n)]
terms) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(n, LinExpr v n) -> Expr v n
mul1) Expr v n
0 [(n, LinExpr v n)]
terms
where
mul1 :: (n, LinExpr v n) -> Expr v n
mul1 (n
alpha, LinExpr n
c []) =
forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [(Period v n
theta, [(n
alpha, forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr n
c LinExpr v n
lt)])]
mul1 (n, LinExpr v n)
t =
forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [forall v n. Expr v n -> Expr v n -> NonLinExpr v n
MulExp (forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [(Period v n
theta, [(n, LinExpr v n)
t])])
(forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr LinExpr v n
lt [] [])]
mulExpr :: (Ord a, Ord t, Floating a) => Expr t a -> Expr t a -> Expr t a
mulExpr :: forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
mulExpr (ConstE a
c) (Expr LinExpr t a
lt2 [TrigTerm t a]
trig []) =
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt2)
(forall a b. (a -> b) -> [a] -> [b]
map (forall n v. (Ord n, Num n) => n -> TrigTerm v n -> TrigTerm v n
mulConstTrig a
c) [TrigTerm t a]
trig) []
mulExpr (Expr LinExpr t a
lt2 [TrigTerm t a]
trig []) (ConstE a
c) =
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt2)
(forall a b. (a -> b) -> [a] -> [b]
map (forall n v. (Ord n, Num n) => n -> TrigTerm v n -> TrigTerm v n
mulConstTrig a
c) [TrigTerm t a]
trig) []
mulExpr (LinearE LinExpr t a
lt) (Expr (LConst a
c) [TrigTerm t a]
trig []) =
forall v n. LinExpr v n -> Expr v n
LinearE (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt) forall a. Num a => a -> a -> a
+
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v.
(Ord n, Ord v, Floating n) =>
LinExpr v n -> TrigTerm v n -> Expr v n
mulLinTrig LinExpr t a
lt) Expr t a
0 [TrigTerm t a]
trig
mulExpr (Expr (LConst a
c) [TrigTerm t a]
trig []) (LinearE LinExpr t a
lt) =
forall v n. LinExpr v n -> Expr v n
LinearE (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt) forall a. Num a => a -> a -> a
+
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v.
(Ord n, Ord v, Floating n) =>
LinExpr v n -> TrigTerm v n -> Expr v n
mulLinTrig LinExpr t a
lt) Expr t a
0 [TrigTerm t a]
trig
mulExpr Expr t a
e1 Expr t a
e2 = forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [forall v n. Expr v n -> Expr v n -> NonLinExpr v n
MulExp Expr t a
e1 Expr t a
e2]
sinExpr :: Floating n => Expr v n -> Expr v n
sinExpr :: forall n v. Floating n => Expr v n -> Expr v n
sinExpr (Expr (LinExpr n
c [(v, n)]
t) [] [])
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(v, n)]
t = forall n v. n -> Expr v n
ConstE (forall a. Floating a => a -> a
sin n
c)
| Bool
otherwise = forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [([(v, n)]
t, [(n
c, forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
1 [])])]
sinExpr Expr v n
e = forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [forall v n. Expr v n -> NonLinExpr v n
SinExp Expr v n
e]
unExpr :: Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr :: forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
f (ConstE n
c) = forall n v. n -> Expr v n
ConstE (forall n. Floating n => UnaryOp -> n -> n
evalUn UnaryOp
f n
c)
unExpr UnaryOp
f Expr v n
e = forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [forall v n. UnaryOp -> Expr v n -> NonLinExpr v n
UnaryApp UnaryOp
f Expr v n
e]
substVarLin :: (Ord v, Num n, Eq n)
=> (v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin :: forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin v -> Maybe (LinExpr v n)
s (LinExpr n
a [(v, n)]
terms) =
let substOne :: (v, n) -> LinExpr v n
substOne (v
v, n
c) =
case v -> Maybe (LinExpr v n)
s v
v of
Maybe (LinExpr v n)
Nothing -> forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v
v, n
c)]
Just LinExpr v n
expr -> forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr n
c LinExpr v n
expr
in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
addLinforall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> LinExpr v n
substOne) (forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
a []) [(v, n)]
terms
substVarNonLin :: (Ord n, Ord v, Floating n)
=> (v -> Maybe (LinExpr v n)) -> NonLinExpr v n -> Expr v n
substVarNonLin :: forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> NonLinExpr v n -> Expr v n
substVarNonLin v -> Maybe (LinExpr v n)
s (UnaryApp UnaryOp
f Expr v n
e1) =
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
f (forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s Expr v n
e1)
substVarNonLin v -> Maybe (LinExpr v n)
s (MulExp Expr v n
e1 Expr v n
e2) =
forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s Expr v n
e1 forall a. Num a => a -> a -> a
* forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s Expr v n
e2
substVarNonLin v -> Maybe (LinExpr v n)
s (SinExp Expr v n
e1) =
forall a. Floating a => a -> a
sin (forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s Expr v n
e1)
substVarTrig :: (Ord v, Ord n, Floating n)
=> (v -> Maybe (LinExpr v n)) -> ([(v, n)], [(n, LinExpr v n)]) -> Expr v n
substVarTrig :: forall v n.
(Ord v, Ord n, Floating n) =>
(v -> Maybe (LinExpr v n))
-> ([(v, n)], [(n, LinExpr v n)]) -> Expr v n
substVarTrig v -> Maybe (LinExpr v n)
s ([(v, n)]
period, [(n, LinExpr v n)]
terms) =
let period2 :: Expr v n
period2 = forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin v -> Maybe (LinExpr v n)
s (forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v, n)]
period)
terms2 :: [(n, Expr v n)]
terms2 = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall v n. LinExpr v n -> Expr v n
LinearE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin v -> Maybe (LinExpr v n)
s) [(n, LinExpr v n)]
terms
in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(n
p,Expr v n
a) -> (forall a. Num a => a -> a -> a
+ (Expr v n
a forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (forall n v. n -> Expr v n
ConstE n
p forall a. Num a => a -> a -> a
+ Expr v n
period2))))
Expr v n
0 [(n, Expr v n)]
terms2
subst :: (Ord n, Ord v, Floating n)
=> (v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst :: forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s (Expr LinExpr v n
lt [TrigTerm v n]
trig [NonLinExpr v n]
nl) =
forall v n. LinExpr v n -> Expr v n
LinearE (forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin v -> Maybe (LinExpr v n)
s LinExpr v n
lt) forall a. Num a => a -> a -> a
+
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall v n.
(Ord v, Ord n, Floating n) =>
(v -> Maybe (LinExpr v n))
-> ([(v, n)], [(n, LinExpr v n)]) -> Expr v n
substVarTrig v -> Maybe (LinExpr v n)
s) Expr v n
0 [TrigTerm v n]
trig forall a. Num a => a -> a -> a
+
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> NonLinExpr v n -> Expr v n
substVarNonLin v -> Maybe (LinExpr v n)
s) Expr v n
0 [NonLinExpr v n]
nl
noDeps :: Dependencies v n
noDeps :: forall v n. Dependencies v n
noDeps = forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies forall k v. HashMap k v
M.empty forall k v. HashMap k v
M.empty [] forall k v. HashMap k v
M.empty []
simpleSubst :: Eq a => a -> b -> a -> Maybe b
simpleSubst :: forall a b. Eq a => a -> b -> a -> Maybe b
simpleSubst a
x b
y a
z
| a
x forall a. Eq a => a -> a -> Bool
== a
z = forall a. a -> Maybe a
Just b
y
| Bool
otherwise = forall a. Maybe a
Nothing
trigToExpr :: (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr :: forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr (Period v n
p, Amplitude v n
a, n
ph, n
c) =
forall v n. LinExpr v n -> Expr v n
LinearE Amplitude v n
a forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin(forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
ph Period v n
p) forall a. Num a => a -> a -> a
+
forall n v. n -> Expr v n
ConstE n
c
trig2ToExpr :: (Ord v, Floating n, Ord n) => M.HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr :: forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr =
forall a b. (a -> b) -> [a] -> [b]
map (\(v
v,Expr v n
e)-> forall n v. Num n => v -> Expr v n
makeVariable v
vforall a. Num a => a -> a -> a
-Expr v n
e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
M.toList
addEqs :: (Hashable v, Hashable n, RealFrac (Phase n), Ord v, Floating n)
=> Dependencies v n -> [Expr v n]
-> Either (DepError v n) (Dependencies v n)
addEqs :: forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
addEqs = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall n v.
(Hashable n, Hashable v, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n)
addEquation
addEquation :: (Hashable n, Hashable v, RealFrac (Phase n), Ord v,
Floating n) =>
Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n)
addEquation :: forall n v.
(Hashable n, Hashable v, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n)
addEquation deps :: Dependencies v n
deps@(Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) Expr v n
expr =
forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 Dependencies v n
deps Expr v n
expr forall a b. (a -> b) -> a -> b
$
forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup LinearMap v n
lin) Expr v n
expr
select :: [a] -> [(a, [a])]
select :: forall a. [a] -> [(a, [a])]
select [] = []
select (a
x:[a]
xs) =
(a
x,[a]
xs) forall a. a -> [a] -> [a]
: [(a
y,a
xforall a. a -> [a] -> [a]
:[a]
ys) | (a
y,[a]
ys) <- forall a. [a] -> [(a, [a])]
select [a]
xs]
substDep :: (Hashable v, Ord v, Num n, Eq n) =>
M.HashMap v (H.HashSet v) -> M.HashMap v (LinExpr v n)
-> v -> LinExpr v n -> Bool
-> (M.HashMap v (H.HashSet v), LinearMap v n)
substDep :: forall v n.
(Hashable v, Ord v, Num n, Eq n) =>
HashMap v (HashSet v)
-> HashMap v (LinExpr v n)
-> v
-> LinExpr v n
-> Bool
-> (HashMap v (HashSet v), HashMap v (LinExpr v n))
substDep HashMap v (HashSet v)
vdep HashMap v (LinExpr v n)
lin v
v LinExpr v n
lt Bool
insertp =
let depVars :: HashSet v
depVars = forall a. a -> Maybe a -> a
fromMaybe forall a. HashSet a
H.empty (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v HashMap v (HashSet v)
vdep)
lin' :: HashMap v (LinExpr v n)
lin' = (if Bool
insertp then forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert v
v LinExpr v n
lt
else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b -> a) -> a -> HashSet b -> a
H.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
M.adjust forall a b. (a -> b) -> a -> b
$
forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin forall a b. (a -> b) -> a -> b
$
forall a b. Eq a => a -> b -> a -> Maybe b
simpleSubst v
v LinExpr v n
lt)
HashMap v (LinExpr v n)
lin HashSet v
depVars
depVars2 :: HashSet v
depVars2 | Bool
insertp = forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
H.insert v
v HashSet v
depVars
| Bool
otherwise = HashSet v
depVars
tryUnion :: v -> HashSet v -> HashSet v -> HashSet v
tryUnion v
k HashSet v
m1 HashSet v
m2 =
let xs :: HashSet v
xs = forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
H.intersection HashSet v
m1 HashSet v
m2
hasvar :: v -> Bool
hasvar v
v2 = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v2 HashMap v (LinExpr v n)
lin' of
Maybe (LinExpr v n)
Nothing -> Bool
False
Just (LinExpr n
_ [(v, n)]
vs) ->
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
==v
k)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [(v, n)]
vs
in forall a. (a -> Bool) -> HashSet a -> HashSet a
H.filter v -> Bool
hasvar HashSet v
xs
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`H.union` forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
H.difference HashSet v
m1 HashSet v
xs
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`H.union` forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
H.difference HashSet v
m2 HashSet v
xs
vdep' :: HashMap v (HashSet v)
vdep' = forall a b. (a -> b -> a) -> a -> HashSet b -> a
H.foldl'
(\HashMap v (HashSet v)
mp v
k -> forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
M.insertWith (v -> HashSet v -> HashSet v -> HashSet v
tryUnion v
k) v
k HashSet v
depVars2 HashMap v (HashSet v)
mp)
(forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete v
v HashMap v (HashSet v)
vdep)
(forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList forall a b. (a -> b) -> a -> b
$ forall v n. LinExpr v n -> [v]
linVars LinExpr v n
lt)
in (HashMap v (HashSet v)
vdep', HashMap v (LinExpr v n)
lin')
addEq0 :: (Hashable v, Hashable n, RealFrac (Phase n), Ord v, Floating n)
=> Dependencies v n -> Expr v n -> Expr v n
-> Either (DepError v n) (Dependencies v n)
addEq0 :: forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 Dependencies v n
_ Expr v n
e (ConstE n
c) =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ if forall a. Num a => a -> a
abs n
c forall a. Ord a => a -> a -> Bool
< n
eps
then forall v n. Expr v n -> DepError v n
RedundantEq Expr v n
e
else forall v n. n -> Expr v n -> DepError v n
InconsistentEq n
c Expr v n
e
where eps :: n
eps = n
0.0001
addEq0 (Dependencies HashMap v (HashSet v)
vdep LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nonlin) Expr v n
_ (Expr LinExpr v n
lt [] []) =
let (v
v, n
_, LinExpr v n
lt2) = forall b v.
(Ord b, Fractional b, Eq v) =>
LinExpr v b -> (v, b, LinExpr v b)
splitMax LinExpr v n
lt
(HashMap v (HashSet v)
vdep', LinearMap v n
lin') = forall v n.
(Hashable v, Ord v, Num n, Eq n) =>
HashMap v (HashSet v)
-> HashMap v (LinExpr v n)
-> v
-> LinExpr v n
-> Bool
-> (HashMap v (HashSet v), HashMap v (LinExpr v n))
substDep HashMap v (HashSet v)
vdep LinearMap v n
lin v
v LinExpr v n
lt2 Bool
True
trig' :: [Expr v n]
trig' = forall a b. (a -> b) -> [a] -> [b]
map forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig
trig2' :: [Expr v n]
trig2' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [v]
M.elems TrigEq2 v n
trig2
in forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
addEqs (forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
vdep' LinearMap v n
lin' [] forall k v. HashMap k v
M.empty []) ([Expr v n]
trig'forall a. [a] -> [a] -> [a]
++[Expr v n]
trig2'forall a. [a] -> [a] -> [a]
++[Expr v n]
nonlin)
addEq0 deps :: Dependencies v n
deps@(Dependencies HashMap v (HashSet v)
vdep LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nl) Expr v n
orig
(Expr (LinExpr n
c Period v n
lt) [(Period v n
theta, [(n
alpha, LConst n
n)])] []) =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Period v n
lt then
forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 Dependencies v n
deps Expr v n
orig (forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
alpha forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
asin (-n
cforall a. Fractional a => a -> a -> a
/n
n)) Period v n
theta)
else
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Period v n
theta TrigEq2 v n
trig2 of
Maybe (HashMap v (Expr v n))
Nothing -> forall {a}. LinExpr v n -> n -> n -> Either a (Dependencies v n)
addSin (forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
c Period v n
lt) n
alpha n
n
Just HashMap v (Expr v n)
map2 ->
case forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> Expr v n
doSubst)
(forall n v. n -> Expr v n
ConstE n
c forall a. Num a => a -> a -> a
+
forall n v. n -> Expr v n
ConstE n
n forall a. Num a => a -> a -> a
*
forall a. Floating a => a -> a
sin (forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
alpha Period v n
theta))
Period v n
lt of
Expr LinExpr v n
lt2 [(Period v n
_, [(n
alpha2, LConst n
n2)])] []
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall v n. LinExpr v n -> Bool
isConst LinExpr v n
lt2
-> forall {a}. LinExpr v n -> n -> n -> Either a (Dependencies v n)
addSin LinExpr v n
lt2 n
alpha2 n
n2
Expr v n
e2 -> forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 Dependencies v n
deps Expr v n
orig Expr v n
e2
where
doSubst :: (v, n) -> Expr v n
doSubst (v
v,n
c2) = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v HashMap v (Expr v n)
map2 of
Maybe (Expr v n)
Nothing -> forall n v. Num n => v -> Expr v n
makeVariable v
v forall a. Num a => a -> a -> a
* forall n v. n -> Expr v n
ConstE n
c2
Just Expr v n
e2 -> Expr v n
e2 forall a. Num a => a -> a -> a
* forall n v. n -> Expr v n
ConstE n
c2
where
addSin :: LinExpr v n -> n -> n -> Either a (Dependencies v n)
addSin LinExpr v n
l' n
a' n
n' =
let (v
v, n
c', LinExpr v n
r) = forall b v.
(Ord b, Fractional b, Eq v) =>
LinExpr v b -> (v, b, LinExpr v b)
splitMax LinExpr v n
l'
trig2' :: TrigEq2 v n
trig2' = forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
M.insertWith forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
M.union Period v n
theta
(forall k v. Hashable k => k -> v -> HashMap k v
M.singleton v
v forall a b. (a -> b) -> a -> b
$
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr LinExpr v n
r [(Period v n
theta, [(n
a', forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
n'forall a. Fractional a => a -> a -> a
/forall a. Num a => a -> a
negate n
c') [])])] [])
TrigEq2 v n
trig2
in forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
vdep LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2' [Expr v n]
nl
addEq0 (Dependencies HashMap v (HashSet v)
d LinearMap v n
lin [] TrigEq2 v n
trig2 [Expr v n]
nl) Expr v n
_
(Expr (LConst n
c) [(Period v n
theta, [(n
alpha, LinExpr v n
n)])] []) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
d LinearMap v n
lin [(Period v n
theta, LinExpr v n
n, n
alpha, n
c)] TrigEq2 v n
trig2 [Expr v n]
nl
addEq0 (Dependencies HashMap v (HashSet v)
deps LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nl) Expr v n
_
(Expr (LConst n
x) [(Period v n
theta, [(n
a, LinExpr v n
n)])] []) =
case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. (TrigEq v n, b) -> Maybe ((n, n), b)
similarTrig forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(a, [a])]
select [TrigEq v n]
trig of
[] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
deps LinearMap v n
lin ((Period v n
theta, LinExpr v n
n, n
a, n
x)forall a. a -> [a] -> [a]
:[TrigEq v n]
trig) TrigEq2 v n
trig2 [Expr v n]
nl
[((n, n), [TrigEq v n])]
l -> forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
addEqs (forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
deps LinearMap v n
lin [TrigEq v n]
rest TrigEq2 v n
trig2 [Expr v n]
nl) [Expr v n
lin1, Expr v n
lin2]
where
((n
b,n
y), [TrigEq v n]
rest) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall {b} {b}. (n, b) -> (n, b) -> Ordering
maxTrig forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) [((n, n), [TrigEq v n])]
l
maxTrig :: (n, b) -> (n, b) -> Ordering
maxTrig (n
t1,b
_) (n
t2,b
_) =
forall a. Ord a => a -> a -> Ordering
compare ((n
t1forall a. Num a => a -> a -> a
-n
a)forall a. RealFrac a => a -> a -> a
`dmod`forall a. Floating a => a
pi) ((n
t2forall a. Num a => a -> a -> a
-n
a)forall a. RealFrac a => a -> a -> a
`dmod`forall a. Floating a => a
pi)
d :: n
d = forall a. Floating a => a -> a
sin(n
aforall a. Num a => a -> a -> a
-n
b)
e :: n
e = n
yforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos(n
aforall a. Num a => a -> a -> a
-n
b)forall a. Num a => a -> a -> a
-n
x
theta2 :: n
theta2 = forall a. Floating a => a -> a
atan (-n
yforall a. Num a => a -> a -> a
*n
dforall a. Fractional a => a -> a -> a
/n
e)forall a. Num a => a -> a -> a
-n
b forall a. Num a => a -> a -> a
+
(if (n
dforall a. Num a => a -> a -> a
*n
e) forall a. Ord a => a -> a -> Bool
< n
0 then forall a. Floating a => a
pi else n
0)
n2 :: n
n2 = forall a. Floating a => a -> a
sqrt(n
yforall a. Num a => a -> a -> a
*n
y forall a. Num a => a -> a -> a
+ n
eforall a. Num a => a -> a -> a
*n
eforall a. Fractional a => a -> a -> a
/(n
dforall a. Num a => a -> a -> a
*n
d))
lin1 :: Expr v n
lin1 = forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (-n
theta2) Period v n
theta
lin2 :: Expr v n
lin2 = forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
n forall a. Num a => a -> a -> a
- forall n v. n -> Expr v n
ConstE n
n2
where
similarTrig :: (TrigEq v n, b) -> Maybe ((n, n), b)
similarTrig ((Period v n
t,LinExpr v n
m,n
b,n
y),b
rest)
| Just n
r <- forall a t.
(Ord a, Fractional a, Eq t) =>
LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple LinExpr v n
m LinExpr v n
n,
Period v n
t forall a. Eq a => a -> a -> Bool
== Period v n
theta Bool -> Bool -> Bool
&&
(n
bforall a. Num a => a -> a -> a
-n
a) forall a. RealFrac a => a -> a -> a
`dmod` forall a. Floating a => a
pi forall a. Ord a => a -> a -> Bool
> forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/n
8 =
forall a. a -> Maybe a
Just ((n
b,n
yforall a. Fractional a => a -> a -> a
/n
r),b
rest)
| Bool
otherwise = forall a. Maybe a
Nothing
addEq0 (Dependencies HashMap v (HashSet v)
d LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nonlin) Expr v n
_ Expr v n
e =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
d LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 (Expr v n
eforall a. a -> [a] -> [a]
:[Expr v n]
nonlin)
deleteDep :: (Hashable k, Hashable b, Eq k, Eq b) =>
M.HashMap b (H.HashSet k)
-> M.HashMap k (LinExpr b n) -> k
-> Maybe (M.HashMap b (H.HashSet k), M.HashMap k (LinExpr b n),
LinExpr b n)
deleteDep :: forall k b n.
(Hashable k, Hashable b, Eq k, Eq b) =>
HashMap b (HashSet k)
-> HashMap k (LinExpr b n)
-> k
-> Maybe
(HashMap b (HashSet k), HashMap k (LinExpr b n), LinExpr b n)
deleteDep HashMap b (HashSet k)
vdep HashMap k (LinExpr b n)
lin k
v =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
v HashMap k (LinExpr b n)
lin of
Maybe (LinExpr b n)
Nothing -> forall a. Maybe a
Nothing
Just LinExpr b n
lt -> forall a. a -> Maybe a
Just (HashMap b (HashSet k)
vdep', HashMap k (LinExpr b n)
lin', LinExpr b n
lt)
where
lin' :: HashMap k (LinExpr b n)
lin' = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete k
v HashMap k (LinExpr b n)
lin
vdep' :: HashMap b (HashSet k)
vdep' = forall a b. (a -> b -> a) -> a -> HashSet b -> a
H.foldl'
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
M.adjust forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
H.delete k
v)
HashMap b (HashSet k)
vdep (forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList forall a b. (a -> b) -> a -> b
$ forall v n. LinExpr v n -> [v]
linVars LinExpr b n
lt)
eliminate :: (Hashable n, Show n, Hashable v, RealFrac (Phase n), Ord v, Show v,
Floating n)
=> Dependencies v n -> v -> (Dependencies v n, [Expr v n])
eliminate :: forall n v.
(Hashable n, Show n, Hashable v, RealFrac n, Ord v, Show v,
Floating n) =>
Dependencies v n -> v -> (Dependencies v n, [Expr v n])
eliminate (Dependencies HashMap v (HashSet v)
vdep LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nonlin) v
v
| Just (HashMap v (HashSet v)
vdep', LinearMap v n
lin', LinExpr v n
lt) <- forall k b n.
(Hashable k, Hashable b, Eq k, Eq b) =>
HashMap b (HashSet k)
-> HashMap k (LinExpr b n)
-> k
-> Maybe
(HashMap b (HashSet k), HashMap k (LinExpr b n), LinExpr b n)
deleteDep HashMap v (HashSet v)
vdep LinearMap v n
lin v
v =
(forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
vdep' LinearMap v n
lin' [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nonlin,
[forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
lt forall a. Num a => a -> a -> a
- forall n v. Num n => v -> Expr v n
makeVariable v
v])
| Just HashSet v
vars <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v HashMap v (HashSet v)
vdep,
(v
v2:[v]
_) <- forall a. HashSet a -> [a]
H.toList HashSet v
vars =
case forall k b n.
(Hashable k, Hashable b, Eq k, Eq b) =>
HashMap b (HashSet k)
-> HashMap k (LinExpr b n)
-> k
-> Maybe
(HashMap b (HashSet k), HashMap k (LinExpr b n), LinExpr b n)
deleteDep HashMap v (HashSet v)
vdep LinearMap v n
lin v
v2 of
Maybe (HashMap v (HashSet v), LinearMap v n, LinExpr v n)
Nothing ->
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Internal error: found empty dependency on " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show v
v2
Just (HashMap v (HashSet v)
vdep', LinearMap v n
lin', LinExpr v n
lt) ->
let lt2 :: LinExpr v n
lt2 = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall v n.
(Show v, Ord v, Fractional n, Eq n) =>
v -> LinExpr v n -> v -> (n, LinExpr v n)
reArrange v
v2 LinExpr v n
lt v
v
(HashMap v (HashSet v)
vdep'', LinearMap v n
lin'') = forall v n.
(Hashable v, Ord v, Num n, Eq n) =>
HashMap v (HashSet v)
-> HashMap v (LinExpr v n)
-> v
-> LinExpr v n
-> Bool
-> (HashMap v (HashSet v), HashMap v (LinExpr v n))
substDep HashMap v (HashSet v)
vdep' LinearMap v n
lin' v
v LinExpr v n
lt2 Bool
False
trig' :: [Expr v n]
trig' = forall a b. (a -> b) -> [a] -> [b]
map forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig
trig2' :: [Expr v n]
trig2' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [v]
M.elems TrigEq2 v n
trig2
deps :: Dependencies v n
deps = forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
vdep'' LinearMap v n
lin'' [] forall k v. HashMap k v
M.empty []
e :: [Expr v n]
e = [forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
lt2 forall a. Num a => a -> a -> a
- forall n v. Num n => v -> Expr v n
makeVariable v
v]
in case forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 forall n v. Num n => Expr v n
zeroExpr)
Dependencies v n
deps forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> b -> a -> Maybe b
simpleSubst v
v LinExpr v n
lt2)
([Expr v n]
trig'forall a. [a] -> [a] -> [a]
++[Expr v n]
trig2'forall a. [a] -> [a] -> [a]
++[Expr v n]
nonlin) of
Left DepError v n
_ -> (Dependencies v n
deps, [Expr v n]
e)
Right Dependencies v n
d -> (Dependencies v n
d, [Expr v n]
e)
| Bool
otherwise =
let ([Expr v n]
l, TrigEq2 v n
trig2') =
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
M.foldrWithKey forall {n}.
(Floating n, Ord n, Hashable n) =>
Period v n
-> HashMap v (Expr v n)
-> ([Expr v n], HashMap (Period v n) (HashMap v (Expr v n)))
-> ([Expr v n], HashMap (Period v n) (HashMap v (Expr v n)))
trigFold
([], forall k v. HashMap k v
M.empty) TrigEq2 v n
trig2
trigFold :: Period v n
-> HashMap v (Expr v n)
-> ([Expr v n], HashMap (Period v n) (HashMap v (Expr v n)))
-> ([Expr v n], HashMap (Period v n) (HashMap v (Expr v n)))
trigFold Period v n
p HashMap v (Expr v n)
t ([Expr v n]
l2, HashMap (Period v n) (HashMap v (Expr v n))
m2) =
let ([Expr v n]
l3, HashMap v (Expr v n)
m1) = forall v n.
(Show v, Ord v, Hashable v, Floating n, Ord n) =>
Period v n
-> HashMap v (Expr v n) -> v -> ([Expr v n], HashMap v (Expr v n))
elimTrig Period v n
p HashMap v (Expr v n)
t v
v
mp :: HashMap (Period v n) (HashMap v (Expr v n))
mp | forall k v. HashMap k v -> Bool
M.null HashMap v (Expr v n)
m1 = HashMap (Period v n) (HashMap v (Expr v n))
m2
| Bool
otherwise = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Period v n
p HashMap v (Expr v n)
m1 HashMap (Period v n) (HashMap v (Expr v n))
m2
in ([Expr v n]
l3forall a. [a] -> [a] -> [a]
++[Expr v n]
l2, HashMap (Period v n) (HashMap v (Expr v n))
mp)
([Expr v n]
nlWith, [Expr v n]
nlWithout) =
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall t v. (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar v
v) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig forall a. [a] -> [a] -> [a]
++ [Expr v n]
nonlin
deps :: Dependencies v n
deps = forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
vdep LinearMap v n
lin [] TrigEq2 v n
trig2' []
in case forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 forall n v. Num n => Expr v n
zeroExpr) Dependencies v n
deps
[Expr v n]
nlWithout of
Left DepError v n
_ -> (Dependencies v n
deps, [Expr v n]
nlWithforall a. [a] -> [a] -> [a]
++[Expr v n]
l)
Right Dependencies v n
d -> (Dependencies v n
d, [Expr v n]
nlWithforall a. [a] -> [a] -> [a]
++[Expr v n]
l)
reArrange :: (Show v, Ord v, Fractional n, Eq n) =>
v -> LinExpr v n -> v -> (n, LinExpr v n)
reArrange :: forall v n.
(Show v, Ord v, Fractional n, Eq n) =>
v -> LinExpr v n -> v -> (n, LinExpr v n)
reArrange v
v2 (LinExpr n
c [(v, n)]
vars) v
v =
case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==v
v)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fstforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(a, [a])]
select [(v, n)]
vars of
Maybe ((v, n), [(v, n)])
Nothing ->
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Internal error: variable " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show v
v forall a. [a] -> [a] -> [a]
++
String
" not in linear expression "
Just ((v
_,n
c2), [(v, n)]
r) ->
(n
c2,
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
cforall a. Fractional a => a -> a -> a
/forall a. Num a => a -> a
negate n
c2) [(v, n)]
r
forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
`addLin` forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v
v2, n
1forall a. Fractional a => a -> a -> a
/n
c2)])
reArrangeTrig :: (Show v, Ord t1, Ord v, Floating t1)
=> v -> Expr v t1 -> v -> Expr v t1
reArrangeTrig :: forall v t1.
(Show v, Ord t1, Ord v, Floating t1) =>
v -> Expr v t1 -> v -> Expr v t1
reArrangeTrig v
v2 (Expr LinExpr v t1
lt [TrigTerm v t1]
trig [NonLinExpr v t1]
_) v
v =
let (t1
c2, LinExpr v t1
lt2) = forall v n.
(Show v, Ord v, Fractional n, Eq n) =>
v -> LinExpr v n -> v -> (n, LinExpr v n)
reArrange v
v2 LinExpr v t1
lt v
v
in forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v t1
lt2 forall a. Num a => a -> a -> a
- forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [TrigTerm v t1]
trig forall a. Fractional a => a -> a -> a
/ forall n v. n -> Expr v n
ConstE t1
c2
elimTrig :: (Show v, Ord v, Hashable v, Floating n, Ord n) =>
Period v n -> M.HashMap v (Expr v n) -> v
-> ([Expr v n], M.HashMap v (Expr v n))
elimTrig :: forall v n.
(Show v, Ord v, Hashable v, Floating n, Ord n) =>
Period v n
-> HashMap v (Expr v n) -> v -> ([Expr v n], HashMap v (Expr v n))
elimTrig Period v n
p HashMap v (Expr v n)
m v
v
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
==v
v)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) Period v n
p =
(forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr HashMap v (Expr v n)
m, forall k v. HashMap k v
M.empty)
| Just Expr v n
e <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v HashMap v (Expr v n)
m =
([forall n v. Num n => v -> Expr v n
makeVariable v
v forall a. Num a => a -> a -> a
- Expr v n
e],
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete v
v HashMap v (Expr v n)
m)
| Just (v
v2, Expr v n
e) <-
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall t v. (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar v
vforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
M.toList HashMap v (Expr v n)
m =
let e2 :: Expr v n
e2 = forall v t1.
(Show v, Ord t1, Ord v, Floating t1) =>
v -> Expr v t1 -> v -> Expr v t1
reArrangeTrig v
v2 Expr v n
e v
v
substOne :: (v, n) -> Expr v n
substOne (v
v3, n
c)
| v
v forall a. Eq a => a -> a -> Bool
== v
v3 = Expr v n
e2 forall a. Num a => a -> a -> a
* forall n v. n -> Expr v n
ConstE n
c
| Bool
otherwise = forall n v. Num n => v -> Expr v n
makeVariable v
v3 forall a. Num a => a -> a -> a
* forall n v. n -> Expr v n
ConstE n
c
doSubst :: Expr v n -> Expr v n
doSubst (Expr (LinExpr n
c Period v n
lt) [TrigTerm v n]
trig [NonLinExpr v n]
_) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> Expr v n
substOne)
(forall n v. n -> Expr v n
ConstE n
c forall a. Num a => a -> a -> a
+ forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [TrigTerm v n]
trig) Period v n
lt
in ([forall n v. Num n => v -> Expr v n
makeVariable v
v forall a. Num a => a -> a -> a
- Expr v n
e],
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map Expr v n -> Expr v n
doSubst forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete v
v2 HashMap v (Expr v n)
m)
| Bool
otherwise =
([], HashMap v (Expr v n)
m)
dmod :: RealFrac a => a -> a -> a
dmod :: forall a. RealFrac a => a -> a -> a
dmod a
a a
b = forall a. Num a => a -> a
abs((a
aforall a. Fractional a => a -> a -> a
/a
b) forall a. Num a => a -> a -> a
- forall a. Num a => Integer -> a
fromInteger (forall a b. (RealFrac a, Integral b) => a -> b
round (a
aforall a. Fractional a => a -> a -> a
/a
b)) forall a. Num a => a -> a -> a
* a
b)
splitMax :: (Ord b, Fractional b, Eq v) => LinExpr v b -> (v, b, LinExpr v b)
splitMax :: forall b v.
(Ord b, Fractional b, Eq v) =>
LinExpr v b -> (v, b, LinExpr v b)
splitMax (LinExpr b
c [(v, b)]
t) =
let ((v
v,b
c2),[(v, b)]
r) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a. Num a => a -> a
absforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
sndforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst)) forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [(a, [a])]
select [(v, b)]
t
in (v
v, b
c2,
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (-b
cforall a. Fractional a => a -> a -> a
/b
c2) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a
negateforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. Fractional a => a -> a -> a
/b
c2))) [(v, b)]
r)
varDefined :: (Eq v, Hashable v) => v -> Dependencies v n -> Bool
varDefined :: forall v n. (Eq v, Hashable v) => v -> Dependencies v n -> Bool
varDefined v
v (Dependencies HashMap v (HashSet v)
_ LinearMap v n
dep [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v LinearMap v n
dep of
Maybe (LinExpr v n)
Nothing -> Bool
False
Maybe (LinExpr v n)
_ -> Bool
True
dependendVars :: (Eq n) => Dependencies v n -> [(v, LinExpr v n)]
dependendVars :: forall n v. Eq n => Dependencies v n -> [(v, LinExpr v n)]
dependendVars (Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
forall a. (a -> Bool) -> [a] -> [a]
filter (forall v n. LinExpr v n -> Bool
notConstforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) (forall k v. HashMap k v -> [(k, v)]
M.toList LinearMap v n
lin)
where
notConst :: LinExpr v n -> Bool
notConst (LinExpr n
_ []) = Bool
False
notConst LinExpr v n
_ = Bool
True
knownVars :: Dependencies v n -> [(v, n)]
knownVars :: forall v n. Dependencies v n -> [(v, n)]
knownVars (Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {v} {b}. (a, LinExpr v b) -> Maybe (a, b)
knownVar forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
M.toList LinearMap v n
lin
where
knownVar :: (a, LinExpr v b) -> Maybe (a, b)
knownVar (a
v, LinExpr b
n []) = forall a. a -> Maybe a
Just (a
v, b
n)
knownVar (a, LinExpr v b)
_ = forall a. Maybe a
Nothing
getKnown :: (Eq v, Hashable v) => v -> Dependencies v n -> Either [v] n
getKnown :: forall v n.
(Eq v, Hashable v) =>
v -> Dependencies v n -> Either [v] n
getKnown v
var (Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
var LinearMap v n
lin of
Maybe (LinExpr v n)
Nothing -> forall a b. a -> Either a b
Left []
Just (LinExpr n
a []) ->
forall a b. b -> Either a b
Right n
a
Just (LinExpr n
_ [(v, n)]
v) ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(v, n)]
v
nonlinearEqs :: (Ord n, Ord v, Floating n) => Dependencies v n -> [Expr v n]
nonlinearEqs :: forall n v.
(Ord n, Ord v, Floating n) =>
Dependencies v n -> [Expr v n]
nonlinearEqs (Dependencies HashMap v (HashSet v)
_ LinearMap v n
_ [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nl) =
forall a b. (a -> b) -> [a] -> [b]
map forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (\(v
v, Expr v n
e) -> forall n v. Num n => v -> Expr v n
makeVariable v
v forall a. Num a => a -> a -> a
- Expr v n
e)
(forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall k v. HashMap k v -> [(k, v)]
M.toList (forall k v. HashMap k v -> [v]
M.elems TrigEq2 v n
trig2)) forall a. [a] -> [a] -> [a]
++
[Expr v n]
nl
showVars :: (Show n, Show v, Ord n, Ord v, Floating n)
=> Either (DepError v n) (Dependencies v n) -> IO ()
showVars :: forall n v.
(Show n, Show v, Ord n, Ord v, Floating n) =>
Either (DepError v n) (Dependencies v n) -> IO ()
showVars (Left DepError v n
e) = forall a. Show a => a -> IO ()
print DepError v n
e
showVars (Right Dependencies v n
dep) = forall a. Show a => a -> IO ()
print Dependencies v n
dep
dependencies :: (MonadState (Dependencies v n) m) => m (Dependencies v n)
dependencies :: forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies = forall s (m :: * -> *). MonadState s m => m s
get
getValue :: (MonadState (Dependencies v n) m,
MonadError (DepError v n) m,
Eq v, Hashable v) =>
v -> m n
getValue :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
Eq v, Hashable v) =>
v -> m n
getValue v
v = do
Either [v] n
v2 <- forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, Hashable v, Eq v) =>
v -> m (Either [v] n)
getKnownM v
v
case Either [v] n
v2 of
Right n
e -> forall (m :: * -> *) a. Monad m => a -> m a
return n
e
Left [v]
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall v n. v -> DepError v n
UndefinedVar v
v
varDefinedM :: (MonadState (Dependencies v n) m, Hashable v, Eq v) =>
v -> m Bool
varDefinedM :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, Hashable v, Eq v) =>
v -> m Bool
varDefinedM v
v = forall v n. (Eq v, Hashable v) => v -> Dependencies v n -> Bool
varDefined v
v forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies
getKnownM :: (MonadState (Dependencies v n) m, Hashable v, Eq v) =>
v -> m (Either [v] n)
getKnownM :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, Hashable v, Eq v) =>
v -> m (Either [v] n)
getKnownM v
v = forall v n.
(Eq v, Hashable v) =>
v -> Dependencies v n -> Either [v] n
getKnown v
v forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies
eliminateM :: (MonadState (Dependencies v n) m, Hashable n, Hashable v,
Show n, Show v, RealFrac n, Ord v, Floating n) =>
v -> m [Expr v n]
eliminateM :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, Hashable n, Hashable v, Show n,
Show v, RealFrac n, Ord v, Floating n) =>
v -> m [Expr v n]
eliminateM v
v = do
Dependencies v n
dep <- forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies
let (Dependencies v n
dep2, [Expr v n]
e) = forall n v.
(Hashable n, Show n, Hashable v, RealFrac n, Ord v, Show v,
Floating n) =>
Dependencies v n -> v -> (Dependencies v n, [Expr v n])
eliminate Dependencies v n
dep v
v
forall s (m :: * -> *). MonadState s m => s -> m ()
put Dependencies v n
dep2
forall (m :: * -> *) a. Monad m => a -> m a
return [Expr v n]
e
infixr 1 === , =&=
(===) :: (MonadState (Dependencies v n) m,
MonadError (DepError v n) m,
Eq v, Hashable v, Hashable n,
RealFrac n, Floating n, Ord v) =>
Expr v n -> Expr v n -> m ()
=== :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
Expr v n -> Expr v n -> m ()
(===) Expr v n
lhs Expr v n
rhs = do
Dependencies v n
deps <- forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies
case forall n v.
(Hashable n, Hashable v, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n)
addEquation Dependencies v n
deps (Expr v n
lhs forall a. Num a => a -> a -> a
- Expr v n
rhs) of
Left DepError v n
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DepError v n
e
Right Dependencies v n
dep -> forall s (m :: * -> *). MonadState s m => s -> m ()
put Dependencies v n
dep
(=&=) :: (MonadState (Dependencies v n) m,
MonadError (DepError v n) m,
Eq v, Hashable v, Hashable n,
RealFrac n, Floating n, Ord v) =>
(Expr v n, Expr v n) -> (Expr v n, Expr v n) -> m ()
=&= :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
(Expr v n, Expr v n) -> (Expr v n, Expr v n) -> m ()
(=&=) (Expr v n
a, Expr v n
b) (Expr v n
c, Expr v n
d) =
do forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (Expr v n
a forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
Expr v n -> Expr v n -> m ()
=== Expr v n
c) forall a b. (a -> b) -> a -> b
$ \DepError v n
e ->
case DepError v n
e of
RedundantEq Expr v n
_ ->
Expr v n
b forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
Expr v n -> Expr v n -> m ()
=== Expr v n
d
DepError v n
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DepError v n
e
forall v n (m :: * -> *).
MonadError (DepError v n) m =>
m () -> m ()
ignore forall a b. (a -> b) -> a -> b
$ Expr v n
b forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
Expr v n -> Expr v n -> m ()
=== Expr v n
d
ignore :: MonadError (DepError v n) m => m () -> m ()
ignore :: forall v n (m :: * -> *).
MonadError (DepError v n) m =>
m () -> m ()
ignore m ()
m =
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m ()
m forall a b. (a -> b) -> a -> b
$ \DepError v n
e ->
case DepError v n
e of
RedundantEq Expr v n
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
DepError v n
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DepError v n
e
runSolver :: MFSolver v n a -> Dependencies v n -> Either (DepError v n) (a, Dependencies v n)
runSolver :: forall v n a.
MFSolver v n a
-> Dependencies v n -> Either (DepError v n) (a, Dependencies v n)
runSolver MFSolver v n a
s = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT MFSolver v n a
s
unsafeSolveT :: (Num n, Ord n, Show n, Show v, Typeable n, Typeable v, Monad m) =>
Dependencies v n -> MFSolverT v n m a -> m a
unsafeSolveT :: forall n v (m :: * -> *) a.
(Num n, Ord n, Show n, Show v, Typeable n, Typeable v, Monad m) =>
Dependencies v n -> MFSolverT v n m a -> m a
unsafeSolveT Dependencies v n
dep MFSolverT v n m a
s = do
Either (DepError v n) (a, Dependencies v n)
res <- forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT MFSolverT v n m a
s Dependencies v n
dep
case Either (DepError v n) (a, Dependencies v n)
res of
Right (a
v, Dependencies v n
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return a
v
Left DepError v n
e -> forall a e. Exception e => e -> a
throw DepError v n
e
evalSolverT :: Functor f =>
MFSolverT v n f b
-> Dependencies v n -> f (Either (DepError v n) b)
evalSolverT :: forall (f :: * -> *) v n b.
Functor f =>
MFSolverT v n f b
-> Dependencies v n -> f (Either (DepError v n) b)
evalSolverT MFSolverT v n f b
s Dependencies v n
dep =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT MFSolverT v n f b
s Dependencies v n
dep
execSolverT :: Functor m =>
MFSolverT v n m a
-> Dependencies v n -> m (Either (DepError v n) (Dependencies v n))
execSolverT :: forall (m :: * -> *) v n a.
Functor m =>
MFSolverT v n m a
-> Dependencies v n -> m (Either (DepError v n) (Dependencies v n))
execSolverT MFSolverT v n m a
s Dependencies v n
dep =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT MFSolverT v n m a
s Dependencies v n
dep
unsafeSolve :: (Typeable n, Typeable v, Show n, Show v, Ord n, Num n) =>
Dependencies v n -> MFSolver v n a -> a
unsafeSolve :: forall n v a.
(Typeable n, Typeable v, Show n, Show v, Ord n, Num n) =>
Dependencies v n -> MFSolver v n a -> a
unsafeSolve Dependencies v n
dep = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n v (m :: * -> *) a.
(Num n, Ord n, Show n, Show v, Typeable n, Typeable v, Monad m) =>
Dependencies v n -> MFSolverT v n m a -> m a
unsafeSolveT Dependencies v n
dep
evalSolver :: MFSolver v n a
-> Dependencies v n -> Either (DepError v n) a
evalSolver :: forall v n a.
MFSolver v n a -> Dependencies v n -> Either (DepError v n) a
evalSolver MFSolver v n a
s = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) v n b.
Functor f =>
MFSolverT v n f b
-> Dependencies v n -> f (Either (DepError v n) b)
evalSolverT MFSolver v n a
s
execSolver :: MFSolver v n a
-> Dependencies v n -> Either (DepError v n) (Dependencies v n)
execSolver :: forall v n a.
MFSolver v n a
-> Dependencies v n -> Either (DepError v n) (Dependencies v n)
execSolver MFSolver v n a
s = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) v n a.
Functor m =>
MFSolverT v n m a
-> Dependencies v n -> m (Either (DepError v n) (Dependencies v n))
execSolverT MFSolver v n a
s