{-# 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.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 Control.Applicative hiding (Const)
import Data.Hashable
import Data.Maybe
import Data.List
import Data.Function(on)
data BinaryOp =
Add |
Mul
deriving BinaryOp -> BinaryOp -> Bool
(BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool) -> Eq BinaryOp
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
(UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool) -> Eq UnaryOp
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. UnaryOp -> Rep UnaryOp x)
-> (forall x. Rep UnaryOp x -> UnaryOp) -> Generic UnaryOp
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
(SimpleVar -> SimpleVar -> Bool)
-> (SimpleVar -> SimpleVar -> Bool) -> Eq SimpleVar
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
Eq SimpleVar
-> (SimpleVar -> SimpleVar -> Ordering)
-> (SimpleVar -> SimpleVar -> Bool)
-> (SimpleVar -> SimpleVar -> Bool)
-> (SimpleVar -> SimpleVar -> Bool)
-> (SimpleVar -> SimpleVar -> Bool)
-> (SimpleVar -> SimpleVar -> SimpleVar)
-> (SimpleVar -> SimpleVar -> SimpleVar)
-> Ord 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
$cp1Ord :: Eq SimpleVar
Ord, (forall x. SimpleVar -> Rep SimpleVar x)
-> (forall x. Rep SimpleVar x -> SimpleVar) -> Generic SimpleVar
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
(Expr v n -> Expr v n -> Bool)
-> (Expr v n -> Expr v n -> Bool) -> Eq (Expr v n)
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 x. Expr v n -> Rep (Expr v n) x)
-> (forall x. Rep (Expr v n) x -> Expr v n) -> Generic (Expr v n)
forall x. Rep (Expr v n) x -> Expr v n
forall x. Expr v n -> Rep (Expr v n) x
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 x. LinExpr v n -> Rep (LinExpr v n) x)
-> (forall x. Rep (LinExpr v n) x -> LinExpr v n)
-> Generic (LinExpr v n)
forall x. Rep (LinExpr v n) x -> LinExpr v n
forall x. LinExpr v n -> Rep (LinExpr v n) x
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
(LinExpr v n -> LinExpr v n -> Bool)
-> (LinExpr v n -> LinExpr v n -> Bool) -> Eq (LinExpr v n)
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 -> ShowS
[LinExpr v n] -> ShowS
LinExpr v n -> String
(Int -> LinExpr v n -> ShowS)
-> (LinExpr v n -> String)
-> ([LinExpr v n] -> ShowS)
-> Show (LinExpr v n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v n. (Show n, Show v) => Int -> LinExpr v n -> ShowS
forall v n. (Show n, Show v) => [LinExpr v n] -> ShowS
forall v n. (Show n, Show v) => LinExpr v n -> String
showList :: [LinExpr v n] -> ShowS
$cshowList :: forall v n. (Show n, Show v) => [LinExpr v n] -> ShowS
show :: LinExpr v n -> String
$cshow :: forall v n. (Show n, Show v) => LinExpr v n -> String
showsPrec :: Int -> LinExpr v n -> ShowS
$cshowsPrec :: forall v n. (Show n, Show v) => Int -> LinExpr v n -> ShowS
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
(NonLinExpr v n -> NonLinExpr v n -> Bool)
-> (NonLinExpr v n -> NonLinExpr v n -> Bool)
-> Eq (NonLinExpr v n)
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 x. NonLinExpr v n -> Rep (NonLinExpr v n) x)
-> (forall x. Rep (NonLinExpr v n) x -> NonLinExpr v n)
-> Generic (NonLinExpr v n)
forall x. Rep (NonLinExpr v n) x -> NonLinExpr v n
forall x. NonLinExpr v n -> Rep (NonLinExpr v n) x
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 $bLinearE :: LinExpr v n -> Expr v n
$mLinearE :: forall r v n. Expr v n -> (LinExpr v n -> r) -> (Void# -> r) -> r
LinearE l = Expr l [] []
pattern $bConstE :: n -> Expr v n
$mConstE :: forall r v n. Expr v n -> (n -> r) -> (Void# -> r) -> r
ConstE c = Expr (LinExpr c []) [] []
pattern $bLConst :: n -> LinExpr v n
$mLConst :: forall r v n. LinExpr v n -> (n -> r) -> (Void# -> 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 = SimpleExpr v n -> String
forall a. Show a => a -> String
show (Expr v n -> SimpleExpr v n
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 (a -> MFSolverT v n m b -> MFSolverT v n m a
(a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
(forall a b. (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b)
-> (forall a b. a -> MFSolverT v n m b -> MFSolverT v n m a)
-> Functor (MFSolverT v n m)
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
<$ :: 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 :: (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, Functor (MFSolverT v n m)
a -> MFSolverT v n m a
Functor (MFSolverT v n m)
-> (forall a. a -> MFSolverT v n m a)
-> (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 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 -> MFSolverT v n m b -> MFSolverT v n m a)
-> Applicative (MFSolverT v n m)
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m a
MFSolverT v n m (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
(a -> b -> c)
-> MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> MFSolverT v n m a
$cpure :: forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
$cp1Applicative :: forall v n (m :: * -> *). Monad m => Functor (MFSolverT v n m)
Applicative, Applicative (MFSolverT v n m)
a -> MFSolverT v n m a
Applicative (MFSolverT v n m)
-> (forall a b.
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b)
-> (forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b)
-> (forall a. a -> MFSolverT v n m a)
-> Monad (MFSolverT v n m)
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
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 :: a -> MFSolverT v n m a
$creturn :: forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
>> :: 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
>>= :: 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
$cp1Monad :: forall v n (m :: * -> *). Monad m => Applicative (MFSolverT v n m)
Monad, Monad (MFSolverT v n m)
Monad (MFSolverT v n m)
-> (forall a. IO a -> MFSolverT v n m a)
-> MonadIO (MFSolverT v n m)
IO a -> MFSolverT v n m a
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 :: IO a -> MFSolverT v n m a
$cliftIO :: forall v n (m :: * -> *) a. MonadIO m => IO a -> MFSolverT v n m a
$cp1MonadIO :: forall v n (m :: * -> *). MonadIO m => Monad (MFSolverT v n m)
MonadIO, MonadState (Dependencies v n),
MonadError (DepError v n), MonadReader s, MonadWriter s,
Monad (MFSolverT v n m)
Monad (MFSolverT v n m)
-> (forall a b.
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a)
-> MonadCont (MFSolverT v n m)
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a
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 :: ((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
$cp1MonadCont :: forall v n (m :: * -> *). MonadCont m => Monad (MFSolverT v n m)
MonadCont)
instance MonadTrans (MFSolverT v n) where
lift :: m a -> MFSolverT v n m a
lift = StateT (Dependencies v n) (ExceptT (DepError v n) m) a
-> MFSolverT v n m a
forall v n (m :: * -> *) a.
StateT (Dependencies v n) (ExceptT (DepError v n) m) a
-> MFSolverT v n m a
MFSolverT (StateT (Dependencies v n) (ExceptT (DepError v n) m) a
-> MFSolverT v n m a)
-> (m a -> StateT (Dependencies v n) (ExceptT (DepError v n) m) a)
-> m a
-> MFSolverT v n m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT (DepError v n) m a
-> StateT (Dependencies v n) (ExceptT (DepError v n) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift(ExceptT (DepError v n) m a
-> StateT (Dependencies v n) (ExceptT (DepError v n) m) a)
-> (m a -> ExceptT (DepError v n) m a)
-> m a
-> StateT (Dependencies v n) (ExceptT (DepError v n) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT (DepError v n) m a
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 :: 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) = ExceptT (DepError v n) m (a, Dependencies v n)
-> m (Either (DepError v n) (a, Dependencies v n))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (DepError v n) m (a, Dependencies v n)
-> m (Either (DepError v n) (a, Dependencies v n)))
-> (Dependencies v n
-> ExceptT (DepError v n) m (a, Dependencies v n))
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (Dependencies v n) (ExceptT (DepError v n) m) a
-> Dependencies v n
-> ExceptT (DepError v n) m (a, Dependencies v n)
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 :: SimpleExpr t t1 -> [BinaryOp] -> String
withParens e :: SimpleExpr t t1
e@(SEBin BinaryOp
op SimpleExpr t t1
_ SimpleExpr t t1
_) [BinaryOp]
ops
| BinaryOp
op BinaryOp -> [BinaryOp] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BinaryOp]
ops = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleExpr t t1 -> String
forall a. Show a => a -> String
show SimpleExpr t t1
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
withParens SimpleExpr t t1
e [BinaryOp]
_ = SimpleExpr t t1 -> String
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) = v -> String
forall a. Show a => a -> String
show v
v
show (Const n
n) = n -> String
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 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0 =
SimpleExpr v n -> String
forall a. Show a => a -> String
show SimpleExpr v n
e1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleExpr v n -> String
forall a. Show a => a -> String
show (BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (n -> SimpleExpr v n
forall v n. n -> SimpleExpr v n
Const (n -> n
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) =
SimpleExpr v n -> String
forall a. Show a => a -> String
show SimpleExpr v n
e1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleExpr v n -> String
forall a. Show a => a -> String
show SimpleExpr v n
e2
show (SEBin BinaryOp
Mul (Const n
1) SimpleExpr v n
e) = SimpleExpr v n -> String
forall a. Show a => a -> String
show SimpleExpr v n
e
show (SEBin BinaryOp
Mul SimpleExpr v n
e (Const n
1)) = SimpleExpr v n -> String
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)) =
SimpleExpr v n -> [BinaryOp] -> String
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] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleExpr v n -> [BinaryOp] -> String
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) =
SimpleExpr v n -> [BinaryOp] -> String
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] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleExpr v n -> [BinaryOp] -> String
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)) =
SimpleExpr v n -> [BinaryOp] -> String
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] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"**" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleExpr v n -> [BinaryOp] -> String
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) = UnaryOp -> String
forall a. Show a => a -> String
show UnaryOp
op String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleExpr v n -> String
forall a. Show a => a -> String
show SimpleExpr v n
e String -> ShowS
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
(+) = 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
(*) = 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 = 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 (n -> Expr v n
forall v n. n -> Expr v n
ConstE (-n
1))
abs :: Expr v n -> Expr v n
abs = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Abs
signum :: Expr v n -> Expr v n
signum = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Signum
fromInteger :: Integer -> Expr v n
fromInteger = n -> Expr v n
forall v n. n -> Expr v n
ConstE (n -> Expr v n) -> (Integer -> n) -> Integer -> Expr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> n
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 = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Recip
fromRational :: Rational -> Expr v n
fromRational = n -> Expr v n
forall v n. n -> Expr v n
ConstE (n -> Expr v n) -> (Rational -> n) -> Rational -> Expr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> n
forall a. Fractional a => Rational -> a
fromRational
instance (Floating n, Ord n, Ord v) => Floating (Expr v n) where
pi :: Expr v n
pi = n -> Expr v n
forall v n. n -> Expr v n
ConstE n
forall a. Floating a => a
pi
exp :: Expr v n -> Expr v n
exp = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Exp
log :: Expr v n -> Expr v n
log = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Log
sin :: Expr v n -> Expr v n
sin = Expr v n -> Expr v n
forall n v. Floating n => Expr v n -> Expr v n
sinExpr
cos :: Expr v n -> Expr v n
cos Expr v n
a = Expr v n -> Expr v n
forall n v. Floating n => Expr v n -> Expr v n
sinExpr (Expr v n
a Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
+ n -> Expr v n
forall v n. n -> Expr v n
ConstE (n
forall a. Floating a => a
pin -> n -> n
forall a. Fractional a => a -> a -> a
/n
2))
cosh :: Expr v n -> Expr v n
cosh = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Cosh
atanh :: Expr v n -> Expr v n
atanh = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Atanh
tan :: Expr v n -> Expr v n
tan = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Tan
tanh :: Expr v n -> Expr v n
tanh = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Tanh
sinh :: Expr v n -> Expr v n
sinh = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Sinh
asin :: Expr v n -> Expr v n
asin = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Asin
acos :: Expr v n -> Expr v n
acos = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Acos
asinh :: Expr v n -> Expr v n
asinh = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Asinh
acosh :: Expr v n -> Expr v n
acosh = UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Acosh
atan :: Expr v n -> Expr v n
atan = UnaryOp -> Expr v n -> Expr v n
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 (((v, LinExpr v n) -> String) -> [(v, LinExpr v n)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (v, LinExpr v n) -> String
forall n a v.
(Ord n, Num n, Show a, Show v, Show n) =>
(a, LinExpr v n) -> String
showLin (LinearMap v n -> [(v, LinExpr v n)]
forall k v. HashMap k v -> [(k, v)]
M.toList LinearMap v n
lin) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(Expr v n -> String) -> [Expr v n] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Expr v n -> String
forall a. Show a => a -> String
showNl (Dependencies v n -> [Expr v n]
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) = a -> String
forall a. Show a => a -> String
show a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr v n -> String
forall a. Show a => a -> String
show (LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
e)
showNl :: a -> String
showNl a
e = a -> String
forall a. Show a => a -> String
show a
e String -> ShowS
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ n -> String
forall a. Show a => a -> String
show n
a String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
". original expression: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr v n -> String
forall a. Show a => a -> String
show Expr v n
e
show (RedundantEq Expr v n
e) =
String
"Redundant Equation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr v n -> String
forall a. Show a => a -> String
show Expr v n
e
show (UndefinedVar v
v) =
ShowS
forall a. HasCallStack => String -> a
error (String
"Variable is undefined: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> String
forall a. Show a => a -> String
show v
v)
show (UnknownVar v
v n
n) =
ShowS
forall a. HasCallStack => String -> a
error (String
"Value of variable not known: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> String
forall a. Show a => a -> String
show v
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ n -> String
forall a. Show a => a -> String
show n
n)
addSimple :: (Num t1, Eq t1) => SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimple :: 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 = BinaryOp -> SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
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 :: v -> SimpleExpr v t -> Bool
seHasVar v
v1 (Var v
v2) = v
v1 v -> v -> Bool
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) =
v -> SimpleExpr v t -> Bool
forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v SimpleExpr v t
e1 Bool -> Bool -> Bool
||
v -> SimpleExpr v t -> 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) = v -> SimpleExpr v t -> Bool
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 :: v -> Expr v t -> Bool
hasVar v
v = v -> SimpleExpr v t -> Bool
forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v (SimpleExpr v t -> Bool)
-> (Expr v t -> SimpleExpr v t) -> Expr v t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr v t -> SimpleExpr v t
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 :: LinExpr v n -> SimpleExpr v n
linToSimple (LinExpr n
v [(v, n)]
t) =
n -> SimpleExpr v n
forall v n. n -> SimpleExpr v n
Const n
v SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
`addSimple`
((v, n) -> SimpleExpr v n -> SimpleExpr v n)
-> SimpleExpr v n -> [(v, n)] -> SimpleExpr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimple(SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n)
-> ((v, n) -> SimpleExpr v n)
-> (v, n)
-> SimpleExpr v n
-> SimpleExpr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> SimpleExpr v n
forall n v. (Eq n, Num n) => (v, n) -> SimpleExpr v n
mul) (n -> SimpleExpr v n
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) = v -> SimpleExpr v n
forall v n. v -> SimpleExpr v n
Var v
v2
mul (v
v2, n
c) = BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (n -> SimpleExpr v n
forall v n. n -> SimpleExpr v n
Const n
c) (v -> SimpleExpr v n
forall v n. v -> SimpleExpr v n
Var v
v2)
trigToSimple :: (Num n, Eq n) => TrigTerm v n -> SimpleExpr v n
trigToSimple :: TrigTerm v n -> SimpleExpr v n
trigToSimple (Period v n
theta, [(n, Amplitude v n)]
t) =
((n, Amplitude v n) -> SimpleExpr v n -> SimpleExpr v n)
-> SimpleExpr v n -> [(n, Amplitude v n)] -> SimpleExpr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimple(SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n)
-> ((n, Amplitude v n) -> SimpleExpr v n)
-> (n, Amplitude v n)
-> SimpleExpr v n
-> SimpleExpr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(n, Amplitude v n) -> SimpleExpr v n
makeSin) (n -> SimpleExpr v n
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) =
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (Amplitude v n -> SimpleExpr v n
forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple Amplitude v n
n)
(UnaryOp -> SimpleExpr v n -> SimpleExpr v n
forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
Sin SimpleExpr v n
angle) where
angle :: SimpleExpr v n
angle = Amplitude v n -> SimpleExpr v n
forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple (n -> Period v n -> Amplitude v n
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 :: NonLinExpr v n -> SimpleExpr v n
nonlinToSimple (UnaryApp UnaryOp
o Expr v n
e) =
UnaryOp -> SimpleExpr v n -> SimpleExpr v n
forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
o (Expr v n -> SimpleExpr v n
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) =
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (Expr v n -> SimpleExpr v n
forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e1) (Expr v n -> SimpleExpr v n
forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e2)
nonlinToSimple (SinExp Expr v n
e) =
UnaryOp -> SimpleExpr v n -> SimpleExpr v n
forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
Sin (Expr v n -> SimpleExpr v n
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 :: Expr v n -> SimpleExpr v n
toSimple (Expr LinExpr v n
lin [TrigTerm v n]
trig [NonLinExpr v n]
nonlin) =
LinExpr v n -> SimpleExpr v n
forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple LinExpr v n
lin SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
`addSimple`
(TrigTerm v n -> SimpleExpr v n -> SimpleExpr v n)
-> SimpleExpr v n -> [TrigTerm v n] -> SimpleExpr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimple(SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n)
-> (TrigTerm v n -> SimpleExpr v n)
-> TrigTerm v n
-> SimpleExpr v n
-> SimpleExpr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrigTerm v n -> SimpleExpr v n
forall n v. (Num n, Eq n) => TrigTerm v n -> SimpleExpr v n
trigToSimple)
(n -> SimpleExpr v n
forall v n. n -> SimpleExpr v n
Const n
0) [TrigTerm v n]
trig SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
`addSimple`
(NonLinExpr v n -> SimpleExpr v n -> SimpleExpr v n)
-> SimpleExpr v n -> [NonLinExpr v n] -> SimpleExpr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimple(SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n)
-> (NonLinExpr v n -> SimpleExpr v n)
-> NonLinExpr v n
-> SimpleExpr v n
-> SimpleExpr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonLinExpr v n -> SimpleExpr v n
forall n v. (Num n, Eq n) => NonLinExpr v n -> SimpleExpr v n
nonlinToSimple)
(n -> SimpleExpr v n
forall v n. n -> SimpleExpr v n
Const n
0) [NonLinExpr v n]
nonlin
evalBin :: (Floating n) => BinaryOp -> n -> n -> n
evalBin :: BinaryOp -> n -> n -> n
evalBin BinaryOp
Add = n -> n -> n
forall a. Num a => a -> a -> a
(+)
evalBin BinaryOp
Mul = n -> n -> n
forall a. Num a => a -> a -> a
(*)
evalUn :: (Floating n) => UnaryOp -> n -> n
evalUn :: UnaryOp -> n -> n
evalUn UnaryOp
Sin = n -> n
forall a. Floating a => a -> a
sin
evalUn UnaryOp
Abs = n -> n
forall a. Num a => a -> a
abs
evalUn UnaryOp
Recip = n -> n
forall a. Fractional a => a -> a
recip
evalUn UnaryOp
Signum = n -> n
forall a. Num a => a -> a
signum
evalUn UnaryOp
Exp = n -> n
forall a. Floating a => a -> a
exp
evalUn UnaryOp
Log = n -> n
forall a. Floating a => a -> a
log
evalUn UnaryOp
Cos = n -> n
forall a. Floating a => a -> a
cos
evalUn UnaryOp
Cosh = n -> n
forall a. Floating a => a -> a
cosh
evalUn UnaryOp
Atanh = n -> n
forall a. Floating a => a -> a
atanh
evalUn UnaryOp
Tan = n -> n
forall a. Floating a => a -> a
tan
evalUn UnaryOp
Tanh = n -> n
forall a. Floating a => a -> a
tanh
evalUn UnaryOp
Sinh = n -> n
forall a. Floating a => a -> a
sinh
evalUn UnaryOp
Asin = n -> n
forall a. Floating a => a -> a
asin
evalUn UnaryOp
Acos = n -> n
forall a. Floating a => a -> a
acos
evalUn UnaryOp
Asinh = n -> n
forall a. Floating a => a -> a
asinh
evalUn UnaryOp
Acosh = n -> n
forall a. Floating a => a -> a
acosh
evalUn UnaryOp
Atan = n -> n
forall a. Floating a => a -> a
atan
evalSimple :: Floating m => (n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple :: (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) =
BinaryOp -> m -> m -> m
forall n. Floating n => BinaryOp -> n -> n -> n
evalBin BinaryOp
f ((n -> m) -> (v -> m) -> SimpleExpr v n -> m
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) ((n -> m) -> (v -> m) -> SimpleExpr v n -> m
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) =
UnaryOp -> m -> m
forall n. Floating n => UnaryOp -> n -> n
evalUn UnaryOp
f ((n -> m) -> (v -> m) -> SimpleExpr v n -> m
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 :: (n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
_ v -> u
g (Var v
v) = u -> SimpleExpr u m
forall v n. v -> SimpleExpr v n
Var (v -> u
g v
v)
mapSimple n -> m
f v -> u
_ (Const n
c) = m -> SimpleExpr u m
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) =
BinaryOp -> SimpleExpr u m -> SimpleExpr u m -> SimpleExpr u m
forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
h ((n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
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) ((n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
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) =
UnaryOp -> SimpleExpr u m -> SimpleExpr u m
forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
h ((n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
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 :: (n -> m) -> (v -> u) -> Expr v n -> Expr u m
mapExpr n -> m
f v -> u
g = SimpleExpr u m -> Expr u m
forall n v.
(Floating n, Ord n, Ord v) =>
SimpleExpr v n -> Expr v n
fromSimple (SimpleExpr u m -> Expr u m)
-> (Expr v n -> SimpleExpr u m) -> Expr v n -> Expr u m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
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 -> SimpleExpr u m)
-> (Expr v n -> SimpleExpr v n) -> Expr v n -> SimpleExpr u m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr v n -> SimpleExpr v n
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 :: SimpleExpr v n -> Expr v n
fromSimple = (n -> Expr v n) -> (v -> Expr v n) -> SimpleExpr v n -> Expr v n
forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> Expr v n
forall n v. n -> Expr v n
makeConstant v -> Expr v n
forall n v. Num n => v -> Expr v n
makeVariable
evalExpr :: (Floating n) => (v -> n) -> SimpleExpr v n -> n
evalExpr :: (v -> n) -> SimpleExpr v n -> n
evalExpr = (n -> n) -> (v -> n) -> SimpleExpr v n -> n
forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> n
forall a. a -> a
id
zeroTerm :: (Num n) => LinExpr v n
zeroTerm :: LinExpr v n
zeroTerm = n -> LinExpr v n
forall v n. n -> LinExpr v n
LConst n
0
zeroExpr :: (Num n) => Expr v n
zeroExpr :: Expr v n
zeroExpr = n -> Expr v n
forall n v. n -> Expr v n
makeConstant n
0
makeConstant :: n -> Expr v n
makeConstant :: n -> Expr v n
makeConstant = n -> Expr v n
forall v n. n -> Expr v n
ConstE
makeVariable :: Num n => v -> Expr v n
makeVariable :: v -> Expr v n
makeVariable v
v = LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE (LinExpr v n -> Expr v n) -> LinExpr v n -> Expr v n
forall a b. (a -> b) -> a -> b
$ n -> [(v, n)] -> LinExpr v n
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 :: [TrigTerm v n] -> Expr v n
trigExpr [TrigTerm v n]
t = LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr LinExpr v n
forall n v. Num n => LinExpr v n
zeroTerm [TrigTerm v n]
t []
nonlinExpr :: Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr :: [NonLinExpr v n] -> Expr v n
nonlinExpr = LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr LinExpr v n
forall n v. Num n => LinExpr v n
zeroTerm []
isConst :: LinExpr v n -> Bool
isConst :: LinExpr v n -> Bool
isConst (LConst n
_) = Bool
True
isConst LinExpr v n
_ = Bool
False
linVars :: LinExpr v n -> [v]
linVars :: LinExpr v n -> [v]
linVars (LinExpr n
_ [(v, n)]
v) = ((v, n) -> v) -> [(v, n)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, n) -> v
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 :: LinExpr v n -> LinExpr v n -> LinExpr v n
addLin (LinExpr n
c1 [(v, n)]
terms1) (LinExpr n
c2 [(v, n)]
terms2) =
n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
c1n -> n -> n
forall a. Num a => a -> a -> a
+n
c2) [(v, n)]
terms3 where
terms3 :: [(v, n)]
terms3 = ((v, n) -> Bool) -> [(v, n)] -> [(v, n)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((n -> n -> Bool
forall a. Eq a => a -> a -> Bool
/= n
0) (n -> Bool) -> ((v, n) -> n) -> (v, n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, n) -> n
forall a b. (a, b) -> b
snd) ([(v, n)] -> [(v, n)]) -> [(v, n)] -> [(v, n)]
forall a b. (a -> b) -> a -> b
$
[(v, n)] -> [(v, n)] -> (n -> n -> n) -> [(v, n)]
forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [(v, n)]
terms1 [(v, n)]
terms2 n -> n -> n
forall a. Num a => a -> a -> a
(+)
addExpr :: (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
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) =
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr (LinExpr v n -> LinExpr v n -> LinExpr v n
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]
nl1[NonLinExpr v n] -> [NonLinExpr v n] -> [NonLinExpr v n]
forall a. [a] -> [a] -> [a]
++[NonLinExpr v n]
nl2)
where
trig3 :: [TrigTerm v n]
trig3 = [TrigTerm v n]
-> [TrigTerm v n]
-> ([(n, LinExpr v n)] -> [(n, LinExpr v n)] -> [(n, LinExpr v n)])
-> [TrigTerm v n]
forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [TrigTerm v n]
trig1 [TrigTerm v n]
trig2 [(n, LinExpr v n)] -> [(n, LinExpr v n)] -> [(n, LinExpr v n)]
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 :: [(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 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
k2 of
Ordering
LT -> (k, v)
a(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [(k, v)]
as ((k, v)
b(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:[(k, v)]
bs) v -> v -> v
f
Ordering
EQ -> (k
k, v -> v -> v
f v
v v
v2)(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
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)
b(k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
: [(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge ((k, v)
a(k, v) -> [(k, v)] -> [(k, v)]
forall 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 :: [(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 =
((a, LinExpr t a) -> [(a, LinExpr t a)] -> [(a, LinExpr t a)])
-> [(a, LinExpr t a)] -> [(a, LinExpr t a)] -> [(a, LinExpr t a)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, LinExpr t a) -> [(a, LinExpr t a)] -> [(a, LinExpr t a)]
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 a -> LinExpr v a -> a -> LinExpr v a -> Maybe (a, LinExpr v a)
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) (a, LinExpr v a) -> [(a, LinExpr v a)] -> [(a, LinExpr v a)]
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 :: 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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
beta =
(a, LinExpr t a) -> Maybe (a, LinExpr t a)
forall a. a -> Maybe a
Just (a
alpha, LinExpr t a -> LinExpr t a -> LinExpr t a
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 <- LinExpr t a -> LinExpr t a -> Maybe a
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 = a -> a
forall a. Floating a => a -> a
atan (a
dividenta -> a -> a
forall a. Fractional a => a -> a -> a
/a
divisor) a -> a -> a
forall a. Num a => a -> a -> a
+
(if a
divisor a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then a
forall a. Floating a => a
pi else a
0)
divident :: a
divident = a
ra -> a -> a
forall a. Num a => a -> a -> a
*a -> a
forall a. Floating a => a -> a
sin a
alpha a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
sin a
beta
divisor :: a
divisor = a
ra -> a -> a
forall a. Num a => a -> a -> a
*a -> a
forall a. Floating a => a -> a
cos a
alpha a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
cos a
beta
o :: a
o = a -> a
forall a. Floating a => a -> a
sqrt(a
dividenta -> a -> a
forall a. Num a => a -> a -> a
*a
divident a -> a -> a
forall a. Num a => a -> a -> a
+ a
divisora -> a -> a
forall a. Num a => a -> a -> a
*a
divisor)
in (a, LinExpr t a) -> Maybe (a, LinExpr t a)
forall a. a -> Maybe a
Just (a
gamma, a -> LinExpr t a -> LinExpr t a
forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
o LinExpr t a
m)
| Bool
otherwise = Maybe (a, LinExpr t a)
forall a. Maybe a
Nothing
termIsMultiple :: (Ord a, Fractional a, Eq t)
=> LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple :: LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple (LinExpr a
_ [(t, a)]
_) (LinExpr a
0 []) = Maybe a
forall a. Maybe a
Nothing
termIsMultiple (LinExpr a
0 []) (LinExpr a
_ [(t, a)]
_) = Maybe 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)]
_))
| [(t, a)] -> [(t, a)] -> ((t, a) -> (t, a) -> Bool) -> Bool
forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [(t, a)]
r1 [(t, a)]
r2 (a -> (t, a) -> (t, a) -> Bool
forall a1 a.
(Ord a1, Fractional a1, Eq a) =>
a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm (a
d1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
d2)) =
a -> Maybe a
forall a. a -> Maybe a
Just (a
d1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
d2)
termIsMultiple (LinExpr a
c1 [(t, a)]
r1) (LinExpr a
c2 [(t, a)]
r2)
| [(t, a)] -> [(t, a)] -> ((t, a) -> (t, a) -> Bool) -> Bool
forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [(t, a)]
r1 [(t, a)]
r2 (a -> (t, a) -> (t, a) -> Bool
forall a1 a.
(Ord a1, Fractional a1, Eq a) =>
a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm (a
c1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
c2)) =
a -> Maybe a
forall a. a -> Maybe a
Just (a
c1a -> a -> a
forall a. Fractional a => a -> a -> a
/a
c2)
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
compareTerm :: (Ord a1, Fractional a1, Eq a) => a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm :: a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm a1
ratio (a
v3,a1
c3) (a
v4, a1
c4) =
a
v3 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v4 Bool -> Bool -> Bool
&& (a1 -> a1
forall a. Num a => a -> a
abs(a1
c3 a1 -> a1 -> a1
forall a. Num a => a -> a -> a
- (a1
c4 a1 -> a1 -> a1
forall a. Num a => a -> a -> a
* a1
ratio)) a1 -> a1 -> Bool
forall a. Ord a => a -> a -> Bool
<= a1 -> a1
forall a. Num a => a -> a
abs a1
c3a1 -> a1 -> a1
forall a. Num a => a -> a -> a
*a1
2e-50)
compareBy :: [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy :: [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
&& [a] -> [b] -> (a -> b -> 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 :: n -> LinExpr v n -> LinExpr v n
mulLinExpr n
x (LinExpr n
e [(v, n)]
terms) =
n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
en -> n -> n
forall a. Num a => a -> a -> a
*n
x) ([(v, n)] -> LinExpr v n) -> [(v, n)] -> LinExpr v n
forall a b. (a -> b) -> a -> b
$ ((v, n) -> (v, n)) -> [(v, n)] -> [(v, n)]
forall a b. (a -> b) -> [a] -> [b]
map ((n -> n) -> (v, n) -> (v, n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (n -> n -> n
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 :: 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 = ((n, Amplitude v n) -> (n, Amplitude v n))
-> [(n, Amplitude v n)] -> [(n, Amplitude v n)]
forall a b. (a -> b) -> [a] -> [b]
map ((Amplitude v n -> Amplitude v n)
-> (n, Amplitude v n) -> (n, Amplitude v n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (n -> Amplitude v n -> Amplitude v n
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 :: LinExpr v n -> TrigTerm v n -> Expr v n
mulLinTrig LinExpr v n
lt (Period v n
theta, [(n, LinExpr v n)]
terms) =
((n, LinExpr v n) -> Expr v n -> Expr v n)
-> Expr v n -> [(n, LinExpr v n)] -> Expr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
(+)(Expr v n -> Expr v n -> Expr v n)
-> ((n, LinExpr v n) -> Expr v n)
-> (n, LinExpr v n)
-> Expr v n
-> Expr v n
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 []) =
[TrigTerm v n] -> Expr v n
forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [(Period v n
theta, [(n
alpha, n -> LinExpr v n -> LinExpr v n
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 =
[NonLinExpr v n] -> Expr v n
forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [Expr v n -> Expr v n -> NonLinExpr v n
forall v n. Expr v n -> Expr v n -> NonLinExpr v n
MulExp ([TrigTerm v n] -> Expr v n
forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [(Period v n
theta, [(n, LinExpr v n)
t])])
(LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
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 :: Expr t a -> Expr t a -> Expr t a
mulExpr (ConstE a
c) (Expr LinExpr t a
lt2 [TrigTerm t a]
trig []) =
LinExpr t a -> [TrigTerm t a] -> [NonLinExpr t a] -> Expr t a
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr (a -> LinExpr t a -> LinExpr t a
forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt2)
((TrigTerm t a -> TrigTerm t a) -> [TrigTerm t a] -> [TrigTerm t a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> TrigTerm t a -> TrigTerm t a
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) =
LinExpr t a -> [TrigTerm t a] -> [NonLinExpr t a] -> Expr t a
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr (a -> LinExpr t a -> LinExpr t a
forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt2)
((TrigTerm t a -> TrigTerm t a) -> [TrigTerm t a] -> [TrigTerm t a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> TrigTerm t a -> TrigTerm t a
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 []) =
LinExpr t a -> Expr t a
forall v n. LinExpr v n -> Expr v n
LinearE (a -> LinExpr t a -> LinExpr t a
forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt) Expr t a -> Expr t a -> Expr t a
forall a. Num a => a -> a -> a
+
(TrigTerm t a -> Expr t a -> Expr t a)
-> Expr t a -> [TrigTerm t a] -> Expr t a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Expr t a -> Expr t a -> Expr t a
forall a. Num a => a -> a -> a
(+)(Expr t a -> Expr t a -> Expr t a)
-> (TrigTerm t a -> Expr t a)
-> TrigTerm t a
-> Expr t a
-> Expr t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LinExpr t a -> TrigTerm t a -> Expr t a
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) =
LinExpr t a -> Expr t a
forall v n. LinExpr v n -> Expr v n
LinearE (a -> LinExpr t a -> LinExpr t a
forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt) Expr t a -> Expr t a -> Expr t a
forall a. Num a => a -> a -> a
+
(TrigTerm t a -> Expr t a -> Expr t a)
-> Expr t a -> [TrigTerm t a] -> Expr t a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Expr t a -> Expr t a -> Expr t a
forall a. Num a => a -> a -> a
(+)(Expr t a -> Expr t a -> Expr t a)
-> (TrigTerm t a -> Expr t a)
-> TrigTerm t a
-> Expr t a
-> Expr t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LinExpr t a -> TrigTerm t a -> Expr t a
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 = [NonLinExpr t a] -> Expr t a
forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [Expr t a -> Expr t a -> NonLinExpr t a
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 :: Expr v n -> Expr v n
sinExpr (Expr (LinExpr n
c [(v, n)]
t) [] [])
| [(v, n)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(v, n)]
t = n -> Expr v n
forall v n. n -> Expr v n
ConstE (n -> n
forall a. Floating a => a -> a
sin n
c)
| Bool
otherwise = [TrigTerm v n] -> Expr v n
forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [([(v, n)]
t, [(n
c, n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
1 [])])]
sinExpr Expr v n
e = [NonLinExpr v n] -> Expr v n
forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [Expr v n -> NonLinExpr v n
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 :: UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
f (ConstE n
c) = n -> Expr v n
forall v n. n -> Expr v n
ConstE (UnaryOp -> n -> n
forall n. Floating n => UnaryOp -> n -> n
evalUn UnaryOp
f n
c)
unExpr UnaryOp
f Expr v n
e = [NonLinExpr v n] -> Expr v n
forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [UnaryOp -> Expr v n -> NonLinExpr v n
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 :: (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 -> n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v
v, n
c)]
Just LinExpr v n
expr -> n -> LinExpr v n -> LinExpr v n
forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr n
c LinExpr v n
expr
in ((v, n) -> LinExpr v n -> LinExpr v n)
-> LinExpr v n -> [(v, n)] -> LinExpr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (LinExpr v n -> LinExpr v n -> LinExpr v n
forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
addLin(LinExpr v n -> LinExpr v n -> LinExpr v n)
-> ((v, n) -> LinExpr v n) -> (v, n) -> LinExpr v n -> LinExpr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> LinExpr v n
substOne) (n -> [(v, n)] -> LinExpr v n
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 :: (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) =
UnaryOp -> Expr v n -> Expr v n
forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
f ((v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
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) =
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
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 Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
* (v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
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) =
Expr v n -> Expr v n
forall a. Floating a => a -> a
sin ((v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
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 :: (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 = LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE (LinExpr v n -> Expr v n) -> LinExpr v n -> Expr v n
forall a b. (a -> b) -> a -> b
$ (v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
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 -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v, n)]
period)
terms2 :: [(n, Expr v n)]
terms2 = ((n, LinExpr v n) -> (n, Expr v n))
-> [(n, LinExpr v n)] -> [(n, Expr v n)]
forall a b. (a -> b) -> [a] -> [b]
map ((LinExpr v n -> Expr v n) -> (n, LinExpr v n) -> (n, Expr v n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LinExpr v n -> Expr v n) -> (n, LinExpr v n) -> (n, Expr v n))
-> (LinExpr v n -> Expr v n) -> (n, LinExpr v n) -> (n, Expr v n)
forall a b. (a -> b) -> a -> b
$ LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE (LinExpr v n -> Expr v n)
-> (LinExpr v n -> LinExpr v n) -> LinExpr v n -> Expr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
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 ((n, Expr v n) -> Expr v n -> Expr v n)
-> Expr v n -> [(n, Expr v n)] -> Expr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(n
p,Expr v n
a) -> (Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
+ (Expr v n
a Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
* Expr v n -> Expr v n
forall a. Floating a => a -> a
sin (n -> Expr v n
forall v n. n -> Expr v n
ConstE n
p Expr v n -> Expr v n -> Expr v n
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 :: (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) =
LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE ((v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
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) Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
+
(TrigTerm v n -> Expr v n -> Expr v n)
-> Expr v n -> [TrigTerm v n] -> Expr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
(+)(Expr v n -> Expr v n -> Expr v n)
-> (TrigTerm v n -> Expr v n)
-> TrigTerm v n
-> Expr v n
-> Expr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v -> Maybe (LinExpr v n)) -> TrigTerm v n -> Expr v n
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 Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
+
(NonLinExpr v n -> Expr v n -> Expr v n)
-> Expr v n -> [NonLinExpr v n] -> Expr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
(+)(Expr v n -> Expr v n -> Expr v n)
-> (NonLinExpr v n -> Expr v n)
-> NonLinExpr v n
-> Expr v n
-> Expr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v -> Maybe (LinExpr v n)) -> NonLinExpr v n -> Expr v n
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 :: Dependencies v n
noDeps = HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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)
forall k v. HashMap k v
M.empty LinearMap v n
forall k v. HashMap k v
M.empty [] TrigEq2 v n
forall k v. HashMap k v
M.empty []
simpleSubst :: Eq a => a -> b -> a -> Maybe b
simpleSubst :: a -> b -> a -> Maybe b
simpleSubst a
x b
y a
z
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z = b -> Maybe b
forall a. a -> Maybe a
Just b
y
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
trigToExpr :: (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr :: TrigEq v n -> Expr v n
trigToExpr (Period v n
p, Amplitude v n
a, n
ph, n
c) =
Amplitude v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE Amplitude v n
a Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
* Expr v n -> Expr v n
forall a. Floating a => a -> a
sin(Amplitude v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE (Amplitude v n -> Expr v n) -> Amplitude v n -> Expr v n
forall a b. (a -> b) -> a -> b
$ n -> Period v n -> Amplitude v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
ph Period v n
p) Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
+
n -> Expr v n
forall v n. n -> Expr v n
ConstE n
c
trig2ToExpr :: (Ord v, Floating n, Ord n) => M.HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr :: HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr =
((v, Expr v n) -> Expr v n) -> [(v, Expr v n)] -> [Expr v n]
forall a b. (a -> b) -> [a] -> [b]
map (\(v
v,Expr v n
e)-> v -> Expr v n
forall n v. Num n => v -> Expr v n
makeVariable v
vExpr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
-Expr v n
e)
([(v, Expr v n)] -> [Expr v n])
-> (HashMap v (Expr v n) -> [(v, Expr v n)])
-> HashMap v (Expr v n)
-> [Expr v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap v (Expr v n) -> [(v, Expr v n)]
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 :: Dependencies v n
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
addEqs = (Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n))
-> Dependencies v n
-> [Expr v n]
-> Either (DepError v n) (Dependencies v n)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n)
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 :: 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 =
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
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 (Expr v n -> Either (DepError v n) (Dependencies v n))
-> Expr v n -> Either (DepError v n) (Dependencies v n)
forall a b. (a -> b) -> a -> b
$
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst ((v -> LinearMap v n -> Maybe (LinExpr v n))
-> LinearMap v n -> v -> Maybe (LinExpr v n)
forall a b c. (a -> b -> c) -> b -> a -> c
flip v -> LinearMap v n -> Maybe (LinExpr v n)
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 :: [a] -> [(a, [a])]
select [] = []
select (a
x:[a]
xs) =
(a
x,[a]
xs) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [(a
y,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) | (a
y,[a]
ys) <- [a] -> [(a, [a])]
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 :: 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 = HashSet v -> Maybe (HashSet v) -> HashSet v
forall a. a -> Maybe a -> a
fromMaybe HashSet v
forall a. HashSet a
H.empty (v -> HashMap v (HashSet v) -> Maybe (HashSet v)
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 v
-> LinExpr v n
-> HashMap v (LinExpr v n)
-> HashMap v (LinExpr v n)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert v
v LinExpr v n
lt
else HashMap v (LinExpr v n) -> HashMap v (LinExpr v n)
forall a. a -> a
id) (HashMap v (LinExpr v n) -> HashMap v (LinExpr v n))
-> HashMap v (LinExpr v n) -> HashMap v (LinExpr v n)
forall a b. (a -> b) -> a -> b
$
(HashMap v (LinExpr v n) -> v -> HashMap v (LinExpr v n))
-> HashMap v (LinExpr v n) -> HashSet v -> HashMap v (LinExpr v n)
forall a b. (a -> b -> a) -> a -> HashSet b -> a
H.foldl' ((v -> HashMap v (LinExpr v n) -> HashMap v (LinExpr v n))
-> HashMap v (LinExpr v n) -> v -> HashMap v (LinExpr v n)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((v -> HashMap v (LinExpr v n) -> HashMap v (LinExpr v n))
-> HashMap v (LinExpr v n) -> v -> HashMap v (LinExpr v n))
-> (v -> HashMap v (LinExpr v n) -> HashMap v (LinExpr v n))
-> HashMap v (LinExpr v n)
-> v
-> HashMap v (LinExpr v n)
forall a b. (a -> b) -> a -> b
$ (LinExpr v n -> LinExpr v n)
-> v -> HashMap v (LinExpr v n) -> HashMap v (LinExpr v n)
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
M.adjust ((LinExpr v n -> LinExpr v n)
-> v -> HashMap v (LinExpr v n) -> HashMap v (LinExpr v n))
-> (LinExpr v n -> LinExpr v n)
-> v
-> HashMap v (LinExpr v n)
-> HashMap v (LinExpr v n)
forall a b. (a -> b) -> a -> b
$
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
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)) -> LinExpr v n -> LinExpr v n)
-> (v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
forall a b. (a -> b) -> a -> b
$
v -> LinExpr v n -> v -> Maybe (LinExpr v n)
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 = v -> HashSet v -> HashSet v
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 = HashSet v -> HashSet v -> HashSet v
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 v -> HashMap v (LinExpr v n) -> Maybe (LinExpr v n)
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) ->
((v, n) -> Bool) -> [(v, n)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((v -> v -> Bool
forall a. Eq a => a -> a -> Bool
==v
k)(v -> Bool) -> ((v, n) -> v) -> (v, n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> v
forall a b. (a, b) -> a
fst) [(v, n)]
vs
in (v -> Bool) -> HashSet v -> HashSet v
forall a. (a -> Bool) -> HashSet a -> HashSet a
H.filter v -> Bool
hasvar HashSet v
xs
HashSet v -> HashSet v -> HashSet v
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`H.union` HashSet v -> HashSet v -> HashSet v
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
H.difference HashSet v
m1 HashSet v
xs
HashSet v -> HashSet v -> HashSet v
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`H.union` HashSet v -> HashSet v -> HashSet v
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' = (HashMap v (HashSet v) -> v -> HashMap v (HashSet v))
-> HashMap v (HashSet v) -> HashSet v -> HashMap v (HashSet v)
forall a b. (a -> b -> a) -> a -> HashSet b -> a
H.foldl'
(\HashMap v (HashSet v)
mp v
k -> (HashSet v -> HashSet v -> HashSet v)
-> v -> HashSet v -> HashMap v (HashSet v) -> HashMap v (HashSet v)
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)
(v -> HashMap v (HashSet v) -> HashMap v (HashSet v)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete v
v HashMap v (HashSet v)
vdep)
([v] -> HashSet v
forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList ([v] -> HashSet v) -> [v] -> HashSet v
forall a b. (a -> b) -> a -> b
$ LinExpr v n -> [v]
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 :: 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) =
DepError v n -> Either (DepError v n) (Dependencies v n)
forall a b. a -> Either a b
Left (DepError v n -> Either (DepError v n) (Dependencies v n))
-> DepError v n -> Either (DepError v n) (Dependencies v n)
forall a b. (a -> b) -> a -> b
$ if n -> n
forall a. Num a => a -> a
abs n
c n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
eps
then Expr v n -> DepError v n
forall v n. Expr v n -> DepError v n
RedundantEq Expr v n
e
else n -> Expr v n -> DepError v n
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) = LinExpr v n -> (v, n, LinExpr v n)
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') = HashMap v (HashSet v)
-> LinearMap v n
-> v
-> LinExpr v n
-> Bool
-> (HashMap v (HashSet v), LinearMap v n)
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' = (TrigEq v n -> Expr v n) -> [TrigEq v n] -> [Expr v n]
forall a b. (a -> b) -> [a] -> [b]
map TrigEq v n -> Expr v n
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' = (HashMap v (Expr v n) -> [Expr v n])
-> [HashMap v (Expr v n)] -> [Expr v n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HashMap v (Expr v n) -> [Expr v n]
forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr ([HashMap v (Expr v n)] -> [Expr v n])
-> [HashMap v (Expr v n)] -> [Expr v n]
forall a b. (a -> b) -> a -> b
$ TrigEq2 v n -> [HashMap v (Expr v n)]
forall k v. HashMap k v -> [v]
M.elems TrigEq2 v n
trig2
in Dependencies v n
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
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 (HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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
forall k v. HashMap k v
M.empty []) ([Expr v n]
trig'[Expr v n] -> [Expr v n] -> [Expr v n]
forall a. [a] -> [a] -> [a]
++[Expr v n]
trig2'[Expr v n] -> [Expr v n] -> [Expr v n]
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 [(v, n)]
lt) [([(v, n)]
theta, [(n
alpha, LConst n
n)])] []) =
if [(v, n)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(v, n)]
lt then
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
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 (LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE (LinExpr v n -> Expr v n) -> LinExpr v n -> Expr v n
forall a b. (a -> b) -> a -> b
$ n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
alpha n -> n -> n
forall a. Num a => a -> a -> a
- n -> n
forall a. Floating a => a -> a
asin (-n
cn -> n -> n
forall a. Fractional a => a -> a -> a
/n
n)) [(v, n)]
theta)
else
case [(v, n)] -> TrigEq2 v n -> Maybe (HashMap v (Expr v n))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup [(v, n)]
theta TrigEq2 v n
trig2 of
Maybe (HashMap v (Expr v n))
Nothing -> LinExpr v n -> n -> n -> Either (DepError v n) (Dependencies v n)
forall a. LinExpr v n -> n -> n -> Either a (Dependencies v n)
addSin (n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
c [(v, n)]
lt) n
alpha n
n
Just HashMap v (Expr v n)
map2 ->
case ((v, n) -> Expr v n -> Expr v n)
-> Expr v n -> [(v, n)] -> Expr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
(+)(Expr v n -> Expr v n -> Expr v n)
-> ((v, n) -> Expr v n) -> (v, n) -> Expr v n -> Expr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> Expr v n
doSubst)
(n -> Expr v n
forall v n. n -> Expr v n
ConstE n
c Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
+
n -> Expr v n
forall v n. n -> Expr v n
ConstE n
n Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
*
Expr v n -> Expr v n
forall a. Floating a => a -> a
sin (LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE (LinExpr v n -> Expr v n) -> LinExpr v n -> Expr v n
forall a b. (a -> b) -> a -> b
$ n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
alpha [(v, n)]
theta))
[(v, n)]
lt of
Expr LinExpr v n
lt2 [([(v, n)]
_, [(n
alpha2, LConst n
n2)])] []
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LinExpr v n -> Bool
forall v n. LinExpr v n -> Bool
isConst LinExpr v n
lt2
-> LinExpr v n -> n -> n -> Either (DepError v n) (Dependencies v n)
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 -> Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
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 v -> HashMap v (Expr v n) -> Maybe (Expr v n)
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 -> v -> Expr v n
forall n v. Num n => v -> Expr v n
makeVariable v
v Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
* n -> Expr v n
forall v n. n -> Expr v n
ConstE n
c2
Just Expr v n
e2 -> Expr v n
e2 Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
* n -> Expr v n
forall v n. 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) = LinExpr v n -> (v, n, LinExpr v n)
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' = (HashMap v (Expr v n)
-> HashMap v (Expr v n) -> HashMap v (Expr v n))
-> [(v, n)] -> HashMap v (Expr v n) -> TrigEq2 v n -> TrigEq2 v n
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
M.insertWith HashMap v (Expr v n)
-> HashMap v (Expr v n) -> HashMap v (Expr v n)
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
M.union [(v, n)]
theta
(v -> Expr v n -> HashMap v (Expr v n)
forall k v. Hashable k => k -> v -> HashMap k v
M.singleton v
v (Expr v n -> HashMap v (Expr v n))
-> Expr v n -> HashMap v (Expr v n)
forall a b. (a -> b) -> a -> b
$
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr LinExpr v n
r [([(v, n)]
theta, [(n
a', n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
n'n -> n -> n
forall a. Fractional a => a -> a -> a
/n -> n
forall a. Num a => a -> a
negate n
c') [])])] [])
TrigEq2 v n
trig2
in Dependencies v n -> Either a (Dependencies v n)
forall a b. b -> Either a b
Right (Dependencies v n -> Either a (Dependencies v n))
-> Dependencies v n -> Either a (Dependencies v n)
forall a b. (a -> b) -> a -> b
$ HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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) [([(v, n)]
theta, [(n
alpha, LinExpr v n
n)])] []) =
Dependencies v n -> Either (DepError v n) (Dependencies v n)
forall a b. b -> Either a b
Right (Dependencies v n -> Either (DepError v n) (Dependencies v n))
-> Dependencies v n -> Either (DepError v n) (Dependencies v n)
forall a b. (a -> b) -> a -> b
$ HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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 [([(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) [([(v, n)]
theta, [(n
a, LinExpr v n
n)])] []) =
case ((TrigEq v n, [TrigEq v n]) -> Maybe ((n, n), [TrigEq v n]))
-> [(TrigEq v n, [TrigEq v n])] -> [((n, n), [TrigEq v n])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TrigEq v n, [TrigEq v n]) -> Maybe ((n, n), [TrigEq v n])
forall b. (TrigEq v n, b) -> Maybe ((n, n), b)
similarTrig ([(TrigEq v n, [TrigEq v n])] -> [((n, n), [TrigEq v n])])
-> [(TrigEq v n, [TrigEq v n])] -> [((n, n), [TrigEq v n])]
forall a b. (a -> b) -> a -> b
$ [TrigEq v n] -> [(TrigEq v n, [TrigEq v n])]
forall a. [a] -> [(a, [a])]
select [TrigEq v n]
trig of
[] -> Dependencies v n -> Either (DepError v n) (Dependencies v n)
forall a b. b -> Either a b
Right (Dependencies v n -> Either (DepError v n) (Dependencies v n))
-> Dependencies v n -> Either (DepError v n) (Dependencies v n)
forall a b. (a -> b) -> a -> b
$ HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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 (([(v, n)]
theta, LinExpr v n
n, n
a, n
x)TrigEq v n -> [TrigEq v n] -> [TrigEq v n]
forall a. a -> [a] -> [a]
:[TrigEq v n]
trig) TrigEq2 v n
trig2 [Expr v n]
nl
[((n, n), [TrigEq v n])]
l -> Dependencies v n
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
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 (HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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) = (((n, n), [TrigEq v n]) -> ((n, n), [TrigEq v n]) -> Ordering)
-> [((n, n), [TrigEq v n])] -> ((n, n), [TrigEq v n])
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((n, n) -> (n, n) -> Ordering
forall b b. (n, b) -> (n, b) -> Ordering
maxTrig ((n, n) -> (n, n) -> Ordering)
-> (((n, n), [TrigEq v n]) -> (n, n))
-> ((n, n), [TrigEq v n])
-> ((n, n), [TrigEq v n])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((n, n), [TrigEq v n]) -> (n, n)
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
_) =
n -> n -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((n
t1n -> n -> n
forall a. Num a => a -> a -> a
-n
a)n -> n -> n
forall a. RealFrac a => a -> a -> a
`dmod`n
forall a. Floating a => a
pi) ((n
t2n -> n -> n
forall a. Num a => a -> a -> a
-n
a)n -> n -> n
forall a. RealFrac a => a -> a -> a
`dmod`n
forall a. Floating a => a
pi)
d :: n
d = n -> n
forall a. Floating a => a -> a
sin(n
an -> n -> n
forall a. Num a => a -> a -> a
-n
b)
e :: n
e = n
yn -> n -> n
forall a. Num a => a -> a -> a
*n -> n
forall a. Floating a => a -> a
cos(n
an -> n -> n
forall a. Num a => a -> a -> a
-n
b)n -> n -> n
forall a. Num a => a -> a -> a
-n
x
theta2 :: n
theta2 = n -> n
forall a. Floating a => a -> a
atan (-n
yn -> n -> n
forall a. Num a => a -> a -> a
*n
dn -> n -> n
forall a. Fractional a => a -> a -> a
/n
e)n -> n -> n
forall a. Num a => a -> a -> a
-n
b n -> n -> n
forall a. Num a => a -> a -> a
+
(if (n
dn -> n -> n
forall a. Num a => a -> a -> a
*n
e) n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0 then n
forall a. Floating a => a
pi else n
0)
n2 :: n
n2 = n -> n
forall a. Floating a => a -> a
sqrt(n
yn -> n -> n
forall a. Num a => a -> a -> a
*n
y n -> n -> n
forall a. Num a => a -> a -> a
+ n
en -> n -> n
forall a. Num a => a -> a -> a
*n
en -> n -> n
forall a. Fractional a => a -> a -> a
/(n
dn -> n -> n
forall a. Num a => a -> a -> a
*n
d))
lin1 :: Expr v n
lin1 = LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE (LinExpr v n -> Expr v n) -> LinExpr v n -> Expr v n
forall a b. (a -> b) -> a -> b
$ n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (-n
theta2) [(v, n)]
theta
lin2 :: Expr v n
lin2 = LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
n Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
- n -> Expr v n
forall v n. n -> Expr v n
ConstE n
n2
where
similarTrig :: (TrigEq v n, b) -> Maybe ((n, n), b)
similarTrig (([(v, n)]
t,LinExpr v n
m,n
b,n
y),b
rest)
| Just n
r <- LinExpr v n -> LinExpr v n -> Maybe n
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,
[(v, n)]
t [(v, n)] -> [(v, n)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(v, n)]
theta Bool -> Bool -> Bool
&&
(n
bn -> n -> n
forall a. Num a => a -> a -> a
-n
a) n -> n -> n
forall a. RealFrac a => a -> a -> a
`dmod` n
forall a. Floating a => a
pi n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
forall a. Floating a => a
pin -> n -> n
forall a. Fractional a => a -> a -> a
/n
8 =
((n, n), b) -> Maybe ((n, n), b)
forall a. a -> Maybe a
Just ((n
b,n
yn -> n -> n
forall a. Fractional a => a -> a -> a
/n
r),b
rest)
| Bool
otherwise = Maybe ((n, n), b)
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 =
Dependencies v n -> Either (DepError v n) (Dependencies v n)
forall a b. b -> Either a b
Right (Dependencies v n -> Either (DepError v n) (Dependencies v n))
-> Dependencies v n -> Either (DepError v n) (Dependencies v n)
forall a b. (a -> b) -> a -> b
$ HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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
eExpr v n -> [Expr v n] -> [Expr v n]
forall 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 :: 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 k -> HashMap k (LinExpr b n) -> Maybe (LinExpr b n)
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 -> Maybe (HashMap b (HashSet k), HashMap k (LinExpr b n), LinExpr b n)
forall a. Maybe a
Nothing
Just LinExpr b n
lt -> (HashMap b (HashSet k), HashMap k (LinExpr b n), LinExpr b n)
-> Maybe
(HashMap b (HashSet k), HashMap k (LinExpr b n), LinExpr b n)
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' = k -> HashMap k (LinExpr b n) -> HashMap k (LinExpr b n)
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' = (HashMap b (HashSet k) -> b -> HashMap b (HashSet k))
-> HashMap b (HashSet k) -> HashSet b -> HashMap b (HashSet k)
forall a b. (a -> b -> a) -> a -> HashSet b -> a
H.foldl'
((b -> HashMap b (HashSet k) -> HashMap b (HashSet k))
-> HashMap b (HashSet k) -> b -> HashMap b (HashSet k)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> HashMap b (HashSet k) -> HashMap b (HashSet k))
-> HashMap b (HashSet k) -> b -> HashMap b (HashSet k))
-> (b -> HashMap b (HashSet k) -> HashMap b (HashSet k))
-> HashMap b (HashSet k)
-> b
-> HashMap b (HashSet k)
forall a b. (a -> b) -> a -> b
$ (HashSet k -> HashSet k)
-> b -> HashMap b (HashSet k) -> HashMap b (HashSet k)
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
M.adjust ((HashSet k -> HashSet k)
-> b -> HashMap b (HashSet k) -> HashMap b (HashSet k))
-> (HashSet k -> HashSet k)
-> b
-> HashMap b (HashSet k)
-> HashMap b (HashSet k)
forall a b. (a -> b) -> a -> b
$ k -> HashSet k -> HashSet k
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
H.delete k
v)
HashMap b (HashSet k)
vdep ([b] -> HashSet b
forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList ([b] -> HashSet b) -> [b] -> HashSet b
forall a b. (a -> b) -> a -> b
$ LinExpr b n -> [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 :: 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) <- HashMap v (HashSet v)
-> LinearMap v n
-> v
-> Maybe (HashMap v (HashSet v), LinearMap v n, LinExpr v n)
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 =
(HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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,
[LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
lt Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
- v -> Expr v n
forall n v. Num n => v -> Expr v n
makeVariable v
v])
| Just HashSet v
vars <- v -> HashMap v (HashSet v) -> Maybe (HashSet v)
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]
_) <- HashSet v -> [v]
forall a. HashSet a -> [a]
H.toList HashSet v
vars =
case HashMap v (HashSet v)
-> LinearMap v n
-> v
-> Maybe (HashMap v (HashSet v), LinearMap v n, LinExpr v n)
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 ->
String -> (Dependencies v n, [Expr v n])
forall a. HasCallStack => String -> a
error (String -> (Dependencies v n, [Expr v n]))
-> String -> (Dependencies v n, [Expr v n])
forall a b. (a -> b) -> a -> b
$ String
"Internal error: found empty dependency on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> String
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 = (n, LinExpr v n) -> LinExpr v n
forall a b. (a, b) -> b
snd ((n, LinExpr v n) -> LinExpr v n)
-> (n, LinExpr v n) -> LinExpr v n
forall a b. (a -> b) -> a -> b
$ v -> LinExpr v n -> v -> (n, LinExpr v n)
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'') = HashMap v (HashSet v)
-> LinearMap v n
-> v
-> LinExpr v n
-> Bool
-> (HashMap v (HashSet v), LinearMap v n)
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' = (TrigEq v n -> Expr v n) -> [TrigEq v n] -> [Expr v n]
forall a b. (a -> b) -> [a] -> [b]
map TrigEq v n -> Expr v n
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' = (HashMap v (Expr v n) -> [Expr v n])
-> [HashMap v (Expr v n)] -> [Expr v n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HashMap v (Expr v n) -> [Expr v n]
forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr ([HashMap v (Expr v n)] -> [Expr v n])
-> [HashMap v (Expr v n)] -> [Expr v n]
forall a b. (a -> b) -> a -> b
$ TrigEq2 v n -> [HashMap v (Expr v n)]
forall k v. HashMap k v -> [v]
M.elems TrigEq2 v n
trig2
deps :: Dependencies v n
deps = HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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
forall k v. HashMap k v
M.empty []
e :: [Expr v n]
e = [LinExpr v n -> Expr v n
forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
lt2 Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
- v -> Expr v n
forall n v. Num n => v -> Expr v n
makeVariable v
v]
in case (Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n))
-> Dependencies v n
-> [Expr v n]
-> Either (DepError v n) (Dependencies v n)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((Dependencies v n
-> Expr v n
-> Expr v n
-> Either (DepError v n) (Dependencies v n))
-> Expr v n
-> Dependencies v n
-> Expr v n
-> Either (DepError v n) (Dependencies v n)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
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 Expr v n
forall n v. Num n => Expr v n
zeroExpr)
Dependencies v n
deps ([Expr v n] -> Either (DepError v n) (Dependencies v n))
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
forall a b. (a -> b) -> a -> b
$
(Expr v n -> Expr v n) -> [Expr v n] -> [Expr v n]
forall a b. (a -> b) -> [a] -> [b]
map ((v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
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)) -> Expr v n -> Expr v n)
-> (v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
forall a b. (a -> b) -> a -> b
$ v -> LinExpr v n -> v -> Maybe (LinExpr v n)
forall a b. Eq a => a -> b -> a -> Maybe b
simpleSubst v
v LinExpr v n
lt2)
([Expr v n]
trig'[Expr v n] -> [Expr v n] -> [Expr v n]
forall a. [a] -> [a] -> [a]
++[Expr v n]
trig2'[Expr v n] -> [Expr v n] -> [Expr v n]
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') =
([(v, n)]
-> HashMap v (Expr v n)
-> ([Expr v n], TrigEq2 v n)
-> ([Expr v n], TrigEq2 v n))
-> ([Expr v n], TrigEq2 v n)
-> TrigEq2 v n
-> ([Expr v n], TrigEq2 v n)
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
M.foldrWithKey [(v, n)]
-> HashMap v (Expr v n)
-> ([Expr v n], TrigEq2 v n)
-> ([Expr v n], TrigEq2 v n)
forall n.
(Floating n, Ord n, Hashable n) =>
[(v, n)]
-> HashMap v (Expr v n)
-> ([Expr v n], HashMap [(v, n)] (HashMap v (Expr v n)))
-> ([Expr v n], HashMap [(v, n)] (HashMap v (Expr v n)))
trigFold
([], TrigEq2 v n
forall k v. HashMap k v
M.empty) TrigEq2 v n
trig2
trigFold :: [(v, n)]
-> HashMap v (Expr v n)
-> ([Expr v n], HashMap [(v, n)] (HashMap v (Expr v n)))
-> ([Expr v n], HashMap [(v, n)] (HashMap v (Expr v n)))
trigFold [(v, n)]
p HashMap v (Expr v n)
t ([Expr v n]
l2, HashMap [(v, n)] (HashMap v (Expr v n))
m2) =
let ([Expr v n]
l3, HashMap v (Expr v n)
m1) = [(v, n)]
-> HashMap v (Expr v n) -> v -> ([Expr v n], HashMap v (Expr v n))
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 [(v, n)]
p HashMap v (Expr v n)
t v
v
mp :: HashMap [(v, n)] (HashMap v (Expr v n))
mp | HashMap v (Expr v n) -> Bool
forall k v. HashMap k v -> Bool
M.null HashMap v (Expr v n)
m1 = HashMap [(v, n)] (HashMap v (Expr v n))
m2
| Bool
otherwise = [(v, n)]
-> HashMap v (Expr v n)
-> HashMap [(v, n)] (HashMap v (Expr v n))
-> HashMap [(v, n)] (HashMap v (Expr v n))
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert [(v, n)]
p HashMap v (Expr v n)
m1 HashMap [(v, n)] (HashMap v (Expr v n))
m2
in ([Expr v n]
l3[Expr v n] -> [Expr v n] -> [Expr v n]
forall a. [a] -> [a] -> [a]
++[Expr v n]
l2, HashMap [(v, n)] (HashMap v (Expr v n))
mp)
([Expr v n]
nlWith, [Expr v n]
nlWithout) =
(Expr v n -> Bool) -> [Expr v n] -> ([Expr v n], [Expr v n])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (v -> Expr v n -> Bool
forall t v. (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar v
v) ([Expr v n] -> ([Expr v n], [Expr v n]))
-> [Expr v n] -> ([Expr v n], [Expr v n])
forall a b. (a -> b) -> a -> b
$
(TrigEq v n -> Expr v n) -> [TrigEq v n] -> [Expr v n]
forall a b. (a -> b) -> [a] -> [b]
map TrigEq v n -> Expr v n
forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig [Expr v n] -> [Expr v n] -> [Expr v n]
forall a. [a] -> [a] -> [a]
++ [Expr v n]
nonlin
deps :: Dependencies v n
deps = HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
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 (Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n))
-> Dependencies v n
-> [Expr v n]
-> Either (DepError v n) (Dependencies v n)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((Dependencies v n
-> Expr v n
-> Expr v n
-> Either (DepError v n) (Dependencies v n))
-> Expr v n
-> Dependencies v n
-> Expr v n
-> Either (DepError v n) (Dependencies v n)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
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 Expr v n
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]
nlWith[Expr v n] -> [Expr v n] -> [Expr v n]
forall a. [a] -> [a] -> [a]
++[Expr v n]
l)
Right Dependencies v n
d -> (Dependencies v n
d, [Expr v n]
nlWith[Expr v n] -> [Expr v n] -> [Expr v n]
forall 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 :: v -> LinExpr v n -> v -> (n, LinExpr v n)
reArrange v
v2 (LinExpr n
c [(v, n)]
vars) v
v =
case (((v, n), [(v, n)]) -> Bool)
-> [((v, n), [(v, n)])] -> Maybe ((v, n), [(v, n)])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((v -> v -> Bool
forall a. Eq a => a -> a -> Bool
==v
v)(v -> Bool)
-> (((v, n), [(v, n)]) -> v) -> ((v, n), [(v, n)]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> v
forall a b. (a, b) -> a
fst((v, n) -> v)
-> (((v, n), [(v, n)]) -> (v, n)) -> ((v, n), [(v, n)]) -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((v, n), [(v, n)]) -> (v, n)
forall a b. (a, b) -> a
fst) ([((v, n), [(v, n)])] -> Maybe ((v, n), [(v, n)]))
-> [((v, n), [(v, n)])] -> Maybe ((v, n), [(v, n)])
forall a b. (a -> b) -> a -> b
$ [(v, n)] -> [((v, n), [(v, n)])]
forall a. [a] -> [(a, [a])]
select [(v, n)]
vars of
Maybe ((v, n), [(v, n)])
Nothing ->
String -> (n, LinExpr v n)
forall a. HasCallStack => String -> a
error (String -> (n, LinExpr v n)) -> String -> (n, LinExpr v n)
forall a b. (a -> b) -> a -> b
$ String
"Internal error: variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> String
forall a. Show a => a -> String
show v
v String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" not in linear expression "
Just ((v
_,n
c2), [(v, n)]
r) ->
(n
c2,
n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
cn -> n -> n
forall a. Fractional a => a -> a -> a
/n -> n
forall a. Num a => a -> a
negate n
c2) [(v, n)]
r
LinExpr v n -> LinExpr v n -> LinExpr v n
forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
`addLin` n -> [(v, n)] -> LinExpr v n
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v
v2, n
1n -> n -> n
forall 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 :: 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) = v -> LinExpr v t1 -> v -> (t1, LinExpr v t1)
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 LinExpr v t1 -> Expr v t1
forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v t1
lt2 Expr v t1 -> Expr v t1 -> Expr v t1
forall a. Num a => a -> a -> a
- [TrigTerm v t1] -> Expr v t1
forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [TrigTerm v t1]
trig Expr v t1 -> Expr v t1 -> Expr v t1
forall a. Fractional a => a -> a -> a
/ t1 -> Expr v t1
forall v n. 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 :: 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
| ((v, n) -> Bool) -> Period v n -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((v -> v -> Bool
forall a. Eq a => a -> a -> Bool
==v
v)(v -> Bool) -> ((v, n) -> v) -> (v, n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> v
forall a b. (a, b) -> a
fst) Period v n
p =
(HashMap v (Expr v n) -> [Expr v n]
forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr HashMap v (Expr v n)
m, HashMap v (Expr v n)
forall k v. HashMap k v
M.empty)
| Just Expr v n
e <- v -> HashMap v (Expr v n) -> Maybe (Expr v n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v HashMap v (Expr v n)
m =
([v -> Expr v n
forall n v. Num n => v -> Expr v n
makeVariable v
v Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
- Expr v n
e],
v -> HashMap v (Expr v n) -> HashMap v (Expr v n)
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) <-
((v, Expr v n) -> Bool) -> [(v, Expr v n)] -> Maybe (v, Expr v n)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (v -> Expr v n -> Bool
forall t v. (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar v
v(Expr v n -> Bool)
-> ((v, Expr v n) -> Expr v n) -> (v, Expr v n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, Expr v n) -> Expr v n
forall a b. (a, b) -> b
snd) ([(v, Expr v n)] -> Maybe (v, Expr v n))
-> [(v, Expr v n)] -> Maybe (v, Expr v n)
forall a b. (a -> b) -> a -> b
$ HashMap v (Expr v n) -> [(v, Expr v n)]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap v (Expr v n)
m =
let e2 :: Expr v n
e2 = v -> Expr v n -> v -> Expr v n
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 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v3 = Expr v n
e2 Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
* n -> Expr v n
forall v n. n -> Expr v n
ConstE n
c
| Bool
otherwise = v -> Expr v n
forall n v. Num n => v -> Expr v n
makeVariable v
v3 Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
* n -> Expr v n
forall v n. 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]
_) =
((v, n) -> Expr v n -> Expr v n)
-> Expr v n -> Period v n -> Expr v n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
(+)(Expr v n -> Expr v n -> Expr v n)
-> ((v, n) -> Expr v n) -> (v, n) -> Expr v n -> Expr v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> Expr v n
substOne)
(n -> Expr v n
forall v n. n -> Expr v n
ConstE n
c Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
+ [TrigTerm v n] -> Expr v n
forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [TrigTerm v n]
trig) Period v n
lt
in ([v -> Expr v n
forall n v. Num n => v -> Expr v n
makeVariable v
v Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
- Expr v n
e],
(Expr v n -> Expr v n)
-> HashMap v (Expr v n) -> HashMap v (Expr v n)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map Expr v n -> Expr v n
doSubst (HashMap v (Expr v n) -> HashMap v (Expr v n))
-> HashMap v (Expr v n) -> HashMap v (Expr v n)
forall a b. (a -> b) -> a -> b
$ v -> HashMap v (Expr v n) -> HashMap v (Expr v n)
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 :: a -> a -> a
dmod a
a a
b = a -> a
forall a. Num a => a -> a
abs((a
aa -> a -> a
forall a. Fractional a => a -> a -> a
/a
b) a -> a -> a
forall a. Num a => a -> a -> a
- Integer -> a
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (a
aa -> a -> a
forall a. Fractional a => a -> a -> a
/a
b)) a -> a -> a
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 :: LinExpr v b -> (v, b, LinExpr v b)
splitMax (LinExpr b
c [(v, b)]
t) =
let ((v
v,b
c2),[(v, b)]
r) = (((v, b), [(v, b)]) -> ((v, b), [(v, b)]) -> Ordering)
-> [((v, b), [(v, b)])] -> ((v, b), [(v, b)])
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering)
-> (((v, b), [(v, b)]) -> b)
-> ((v, b), [(v, b)])
-> ((v, b), [(v, b)])
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (b -> b
forall a. Num a => a -> a
abs(b -> b) -> (((v, b), [(v, b)]) -> b) -> ((v, b), [(v, b)]) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, b) -> b
forall a b. (a, b) -> b
snd((v, b) -> b)
-> (((v, b), [(v, b)]) -> (v, b)) -> ((v, b), [(v, b)]) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((v, b), [(v, b)]) -> (v, b)
forall a b. (a, b) -> a
fst)) ([((v, b), [(v, b)])] -> ((v, b), [(v, b)]))
-> [((v, b), [(v, b)])] -> ((v, b), [(v, b)])
forall a b. (a -> b) -> a -> b
$
[(v, b)] -> [((v, b), [(v, b)])]
forall a. [a] -> [(a, [a])]
select [(v, b)]
t
in (v
v, b
c2,
b -> [(v, b)] -> LinExpr v b
forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (-b
cb -> b -> b
forall a. Fractional a => a -> a -> a
/b
c2) ([(v, b)] -> LinExpr v b) -> [(v, b)] -> LinExpr v b
forall a b. (a -> b) -> a -> b
$
((v, b) -> (v, b)) -> [(v, b)] -> [(v, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> b) -> (v, b) -> (v, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b
forall a. Num a => a -> a
negate(b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b -> b -> b
forall a. Fractional a => a -> a -> a
/b
c2))) [(v, b)]
r)
varDefined :: (Eq v, Hashable v) => v -> Dependencies v n -> Bool
varDefined :: 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 v -> LinearMap v n -> Maybe (LinExpr v n)
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 :: 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]
_) =
((v, LinExpr v n) -> Bool)
-> [(v, LinExpr v n)] -> [(v, LinExpr v n)]
forall a. (a -> Bool) -> [a] -> [a]
filter (LinExpr v n -> Bool
forall v n. LinExpr v n -> Bool
notConst(LinExpr v n -> Bool)
-> ((v, LinExpr v n) -> LinExpr v n) -> (v, LinExpr v n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, LinExpr v n) -> LinExpr v n
forall a b. (a, b) -> b
snd) (LinearMap v n -> [(v, LinExpr v n)]
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 :: Dependencies v n -> [(v, n)]
knownVars (Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
((v, LinExpr v n) -> Maybe (v, n))
-> [(v, LinExpr v n)] -> [(v, n)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (v, LinExpr v n) -> Maybe (v, n)
forall a v b. (a, LinExpr v b) -> Maybe (a, b)
knownVar ([(v, LinExpr v n)] -> [(v, n)]) -> [(v, LinExpr v n)] -> [(v, n)]
forall a b. (a -> b) -> a -> b
$ LinearMap v n -> [(v, LinExpr v n)]
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 []) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
v, b
n)
knownVar (a, LinExpr v b)
_ = Maybe (a, b)
forall a. Maybe a
Nothing
getKnown :: (Eq v, Hashable v) => v -> Dependencies v n -> Either [v] n
getKnown :: 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 v -> LinearMap v n -> Maybe (LinExpr v n)
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 -> [v] -> Either [v] n
forall a b. a -> Either a b
Left []
Just (LinExpr n
a []) ->
n -> Either [v] n
forall a b. b -> Either a b
Right n
a
Just (LinExpr n
_ [(v, n)]
v) ->
[v] -> Either [v] n
forall a b. a -> Either a b
Left ([v] -> Either [v] n) -> [v] -> Either [v] n
forall a b. (a -> b) -> a -> b
$ ((v, n) -> v) -> [(v, n)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, n) -> v
forall a b. (a, b) -> a
fst [(v, n)]
v
nonlinearEqs :: (Ord n, Ord v, Floating n) => Dependencies v n -> [Expr v n]
nonlinearEqs :: 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) =
(TrigEq v n -> Expr v n) -> [TrigEq v n] -> [Expr v n]
forall a b. (a -> b) -> [a] -> [b]
map TrigEq v n -> Expr v n
forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig [Expr v n] -> [Expr v n] -> [Expr v n]
forall a. [a] -> [a] -> [a]
++
((v, Expr v n) -> Expr v n) -> [(v, Expr v n)] -> [Expr v n]
forall a b. (a -> b) -> [a] -> [b]
map (\(v
v, Expr v n
e) -> v -> Expr v n
forall n v. Num n => v -> Expr v n
makeVariable v
v Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
- Expr v n
e)
((HashMap v (Expr v n) -> [(v, Expr v n)])
-> [HashMap v (Expr v n)] -> [(v, Expr v n)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HashMap v (Expr v n) -> [(v, Expr v n)]
forall k v. HashMap k v -> [(k, v)]
M.toList (TrigEq2 v n -> [HashMap v (Expr v n)]
forall k v. HashMap k v -> [v]
M.elems TrigEq2 v n
trig2)) [Expr v n] -> [Expr v n] -> [Expr v n]
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 :: Either (DepError v n) (Dependencies v n) -> IO ()
showVars (Left DepError v n
e) = DepError v n -> IO ()
forall a. Show a => a -> IO ()
print DepError v n
e
showVars (Right Dependencies v n
dep) = Dependencies v n -> IO ()
forall a. Show a => a -> IO ()
print Dependencies v n
dep
dependencies :: (MonadState (Dependencies v n) m) => m (Dependencies v n)
dependencies :: m (Dependencies v n)
dependencies = m (Dependencies v n)
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 :: v -> m n
getValue v
v = do
Either [v] n
v2 <- v -> m (Either [v] n)
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 -> n -> m n
forall (m :: * -> *) a. Monad m => a -> m a
return n
e
Left [v]
_ -> DepError v n -> m n
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DepError v n -> m n) -> DepError v n -> m n
forall a b. (a -> b) -> a -> b
$ v -> DepError v n
forall v n. v -> DepError v n
UndefinedVar v
v
varDefinedM :: (MonadState (Dependencies v n) m, Hashable v, Eq v) =>
v -> m Bool
varDefinedM :: v -> m Bool
varDefinedM v
v = v -> Dependencies v n -> Bool
forall v n. (Eq v, Hashable v) => v -> Dependencies v n -> Bool
varDefined v
v (Dependencies v n -> Bool) -> m (Dependencies v n) -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Dependencies v n)
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 :: v -> m (Either [v] n)
getKnownM v
v = v -> Dependencies v n -> Either [v] n
forall v n.
(Eq v, Hashable v) =>
v -> Dependencies v n -> Either [v] n
getKnown v
v (Dependencies v n -> Either [v] n)
-> m (Dependencies v n) -> m (Either [v] n)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Dependencies v n)
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 :: v -> m [Expr v n]
eliminateM v
v = do
Dependencies v n
dep <- m (Dependencies v n)
forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies
let (Dependencies v n
dep2, [Expr v n]
e) = Dependencies v n -> v -> (Dependencies v n, [Expr v n])
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
Dependencies v n -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Dependencies v n
dep2
[Expr v n] -> m [Expr v n]
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 ()
=== :: Expr v n -> Expr v n -> m ()
(===) Expr v n
lhs Expr v n
rhs = do
Dependencies v n
deps <- m (Dependencies v n)
forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies
case Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n)
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 Expr v n -> Expr v n -> Expr v n
forall a. Num a => a -> a -> a
- Expr v n
rhs) of
Left DepError v n
e -> DepError v n -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DepError v n
e
Right Dependencies v n
dep -> Dependencies v n -> m ()
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 ()
=&= :: (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 m () -> (DepError v n -> m ()) -> m ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (Expr v n
a 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
c) ((DepError v n -> m ()) -> m ()) -> (DepError v n -> m ()) -> m ()
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 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
d
DepError v n
_ -> DepError v n -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DepError v n
e
m () -> m ()
forall v n (m :: * -> *).
MonadError (DepError v n) m =>
m () -> m ()
ignore (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Expr v n
b 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
d
ignore :: MonadError (DepError v n) m => m () -> m ()
ignore :: m () -> m ()
ignore m ()
m =
m () -> (DepError v n -> m ()) -> m ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m ()
m ((DepError v n -> m ()) -> m ()) -> (DepError v n -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \DepError v n
e ->
case DepError v n
e of
RedundantEq Expr v n
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DepError v n
_ -> DepError v n -> m ()
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 :: MFSolver v n a
-> Dependencies v n -> Either (DepError v n) (a, Dependencies v n)
runSolver MFSolver v n a
s = Identity (Either (DepError v n) (a, Dependencies v n))
-> Either (DepError v n) (a, Dependencies v n)
forall a. Identity a -> a
runIdentity (Identity (Either (DepError v n) (a, Dependencies v n))
-> Either (DepError v n) (a, Dependencies v n))
-> (Dependencies v n
-> Identity (Either (DepError v n) (a, Dependencies v n)))
-> Dependencies v n
-> Either (DepError v n) (a, Dependencies v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MFSolver v n a
-> Dependencies v n
-> Identity (Either (DepError v n) (a, Dependencies v n))
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 :: 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 <- MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
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
_) -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
Left DepError v n
e -> DepError v n -> m a
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 :: 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 =
((b, Dependencies v n) -> b)
-> Either (DepError v n) (b, Dependencies v n)
-> Either (DepError v n) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, Dependencies v n) -> b
forall a b. (a, b) -> a
fst (Either (DepError v n) (b, Dependencies v n)
-> Either (DepError v n) b)
-> f (Either (DepError v n) (b, Dependencies v n))
-> f (Either (DepError v n) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MFSolverT v n f b
-> Dependencies v n
-> f (Either (DepError v n) (b, Dependencies v n))
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 :: 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 =
((a, Dependencies v n) -> Dependencies v n)
-> Either (DepError v n) (a, Dependencies v n)
-> Either (DepError v n) (Dependencies v n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Dependencies v n) -> Dependencies v n
forall a b. (a, b) -> b
snd (Either (DepError v n) (a, Dependencies v n)
-> Either (DepError v n) (Dependencies v n))
-> m (Either (DepError v n) (a, Dependencies v n))
-> m (Either (DepError v n) (Dependencies v n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
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 :: Dependencies v n -> MFSolver v n a -> a
unsafeSolve Dependencies v n
dep = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (MFSolver v n a -> Identity a) -> MFSolver v n a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies v n -> MFSolver v n a -> Identity a
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 :: MFSolver v n a -> Dependencies v n -> Either (DepError v n) a
evalSolver MFSolver v n a
s = Identity (Either (DepError v n) a) -> Either (DepError v n) a
forall a. Identity a -> a
runIdentity (Identity (Either (DepError v n) a) -> Either (DepError v n) a)
-> (Dependencies v n -> Identity (Either (DepError v n) a))
-> Dependencies v n
-> Either (DepError v n) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MFSolver v n a
-> Dependencies v n -> Identity (Either (DepError v n) a)
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 :: MFSolver v n a
-> Dependencies v n -> Either (DepError v n) (Dependencies v n)
execSolver MFSolver v n a
s = Identity (Either (DepError v n) (Dependencies v n))
-> Either (DepError v n) (Dependencies v n)
forall a. Identity a -> a
runIdentity (Identity (Either (DepError v n) (Dependencies v n))
-> Either (DepError v n) (Dependencies v n))
-> (Dependencies v n
-> Identity (Either (DepError v n) (Dependencies v n)))
-> Dependencies v n
-> Either (DepError v n) (Dependencies v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MFSolver v n a
-> Dependencies v n
-> Identity (Either (DepError v n) (Dependencies v n))
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