{-# LANGUAGE DeriveGeneric, PatternGuards, PatternSynonyms,
    MultiParamTypeClasses, FlexibleContexts, DeriveDataTypeable,
    GeneralizedNewtypeDeriving #-}

{-|
Module      : Math.MFSolve
Description : Equation solver and calculator à la metafont
Copyright   : (c) Kristof Bastiaensen, 2015
License     : BSD-3
Maintainer  : kristof@resonata.be
Stability   : unstable
Portability : ghc

This module implements an equation solver that solves and evaluates
expressions on the fly.  It is based on Prof. D.E.Knuth's
/metafont/.  The goal of mfsolve is to make the solver useful in an
interactive program, by enhancing the bidirectionality of the solver.
Like metafont, it can solve linear equations, and evaluate nonlinear
expressions.  In addition to metafont, it also solves for angles, and
makes the solution independend of the order of the equations.

The `Expr` datatype allows for calculations with constants and unknown
variables.  The `Dependencies` datatype contains all dependencies and known equations.

=== Examples:

Let's define some variables.  The `SimpleVar` type is a simple wrapper
around `String` to provide nice output, since the Show instance for
`String` outputs quotation marks.

> let [x, y, t, a] = map (makeVariable . SimpleVar) ["x", "y", "t", "a"]

Solve linear equations:

> showVars $ flip execSolver noDeps $ do
>   2*x + y === 5
>   x - y   === 1

> x = 2.0
> y = 1.0

Solve for angle (pi/4):

> showVars $ flip execSolver noDeps $ sin(t) === 1/sqrt(2)

> t = 0.7853981633974484

Solve for angle (pi/3) and amplitude:

> showVars $ flip execSolver noDeps $ do
>   a*sin(x) === sqrt 3
>   a*cos(x) === 1

> x = 1.0471975511965979
> a = 2.0

Allow nonlinear expression with unknown variables:

> showVars $ flip execSolver noDeps $ do
>   sin(sqrt(x)) === y
>   x === 2

>x = 2.0
>y = 0.9877659459927355

Find the angle and amplitude when using a rotation matrix:

> showVars $ flip execSolver noDeps $ do
>   a*cos t*x - a*sin t*y === 30
>   a*sin t*x + a*cos t*y === 40
>   x === 10
>   y === 10

> x = 10.0
> y = 10.0
> t = 0.14189705460416402
> a = 3.5355339059327373

-}

module Math.MFSolve
       (-- * Expressions
        SimpleExpr(..), Expr, LinExpr(..), UnaryOp(..), BinaryOp(..),
        SimpleVar(..),
        makeVariable,
        makeConstant, evalExpr, fromSimple, toSimple, evalSimple, hasVar,
        mapSimple, mapExpr,
        -- * Dependencies
        Dependencies, DepError(..), 
        noDeps, addEquation, eliminate,
        getKnown, knownVars, varDefined, nonlinearEqs, dependendVars,
        -- * Monadic Interface
        (===), (=&=), dependencies, getValue, getKnownM,
        varDefinedM, eliminateM, ignore,
        -- * MFSolver monad
        MFSolver, 
        runSolver, evalSolver, execSolver, unsafeSolve, showVars,
        -- * MFSolverT monad transformer
        MFSolverT, 
        runSolverT, evalSolverT, execSolverT, unsafeSolveT)
where
import qualified Data.HashMap.Strict as M
import qualified Data.HashSet as H
import GHC.Generics
import Control.Monad
import Control.Monad.Except
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Identity
import Control.Monad.Cont
import Control.Exception
import Data.Typeable
import Data.Hashable
import Data.Maybe
import Data.List
import Data.Function(on)

data BinaryOp =
  -- | Addition
  Add |
  -- | Multiplication
  Mul
  deriving BinaryOp -> BinaryOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryOp -> BinaryOp -> Bool
$c/= :: BinaryOp -> BinaryOp -> Bool
== :: BinaryOp -> BinaryOp -> Bool
$c== :: BinaryOp -> BinaryOp -> Bool
Eq

data UnaryOp =
  -- | sine
  Sin |
  -- | cosine
  Cos |
  -- | absolute value
  Abs |
  -- | reciprocal (1/x)
  Recip |
  -- | sign
  Signum |
  -- | natural exponential (e^x)
  Exp |
  -- | natural logarithm (log x)
  Log |
  -- | hyperbolic cosine
  Cosh |
  -- | inverse hyperbolic tangent
  Atanh |
  -- | tangent
  Tan |
  -- | hyperbolic tangent
  Tanh |
  -- | hyperbolic sine
  Sinh |
  -- | inverse sine
  Asin |
  -- | inverse cosine
  Acos |
  -- | inverse hyperbolic sine
  Asinh |
  -- | inverse hyperbolic cosine
  Acosh |
  -- | inverse tangent
  Atan
  deriving (UnaryOp -> UnaryOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnaryOp -> UnaryOp -> Bool
$c/= :: UnaryOp -> UnaryOp -> Bool
== :: UnaryOp -> UnaryOp -> Bool
$c== :: UnaryOp -> UnaryOp -> Bool
Eq, forall x. Rep UnaryOp x -> UnaryOp
forall x. UnaryOp -> Rep UnaryOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnaryOp x -> UnaryOp
$cfrom :: forall x. UnaryOp -> Rep UnaryOp x
Generic)

-- | A simplified datatype representing an expression.  This can be
-- used to inspect the structure of a `Expr`, which is hidden.
data SimpleExpr v n =
  SEBin BinaryOp (SimpleExpr v n) (SimpleExpr v n) |
  SEUn UnaryOp (SimpleExpr v n) |
  Var v |
  Const n

newtype SimpleVar = SimpleVar String
                  deriving (SimpleVar -> SimpleVar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleVar -> SimpleVar -> Bool
$c/= :: SimpleVar -> SimpleVar -> Bool
== :: SimpleVar -> SimpleVar -> Bool
$c== :: SimpleVar -> SimpleVar -> Bool
Eq, Eq SimpleVar
SimpleVar -> SimpleVar -> Bool
SimpleVar -> SimpleVar -> Ordering
SimpleVar -> SimpleVar -> SimpleVar
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SimpleVar -> SimpleVar -> SimpleVar
$cmin :: SimpleVar -> SimpleVar -> SimpleVar
max :: SimpleVar -> SimpleVar -> SimpleVar
$cmax :: SimpleVar -> SimpleVar -> SimpleVar
>= :: SimpleVar -> SimpleVar -> Bool
$c>= :: SimpleVar -> SimpleVar -> Bool
> :: SimpleVar -> SimpleVar -> Bool
$c> :: SimpleVar -> SimpleVar -> Bool
<= :: SimpleVar -> SimpleVar -> Bool
$c<= :: SimpleVar -> SimpleVar -> Bool
< :: SimpleVar -> SimpleVar -> Bool
$c< :: SimpleVar -> SimpleVar -> Bool
compare :: SimpleVar -> SimpleVar -> Ordering
$ccompare :: SimpleVar -> SimpleVar -> Ordering
Ord, forall x. Rep SimpleVar x -> SimpleVar
forall x. SimpleVar -> Rep SimpleVar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimpleVar x -> SimpleVar
$cfrom :: forall x. SimpleVar -> Rep SimpleVar x
Generic, Typeable)

-- | A mathematical expression of several variables. Several Numeric
-- instances (`Num`, `Floating` and `Fractional`) are provided, so
-- doing calculations over `Expr` is more convenient.
data Expr v n = Expr (LinExpr v n) [TrigTerm v n] [NonLinExpr v n]
                deriving (Expr v n -> Expr v n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v n. (Eq n, Eq v) => Expr v n -> Expr v n -> Bool
/= :: Expr v n -> Expr v n -> Bool
$c/= :: forall v n. (Eq n, Eq v) => Expr v n -> Expr v n -> Bool
== :: Expr v n -> Expr v n -> Bool
$c== :: forall v n. (Eq n, Eq v) => Expr v n -> Expr v n -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v n x. Rep (Expr v n) x -> Expr v n
forall v n x. Expr v n -> Rep (Expr v n) x
$cto :: forall v n x. Rep (Expr v n) x -> Expr v n
$cfrom :: forall v n x. Expr v n -> Rep (Expr v n) x
Generic)

-- | A linear expression of several variables.
-- For example: @2*a + 3*b + 2@ would be represented as
-- @LinExpr 2 [(a, 2), (b, 3)]@.
data LinExpr v n = LinExpr n [(v, n)]
                 deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v n x. Rep (LinExpr v n) x -> LinExpr v n
forall v n x. LinExpr v n -> Rep (LinExpr v n) x
$cto :: forall v n x. Rep (LinExpr v n) x -> LinExpr v n
$cfrom :: forall v n x. LinExpr v n -> Rep (LinExpr v n) x
Generic, LinExpr v n -> LinExpr v n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v n. (Eq n, Eq v) => LinExpr v n -> LinExpr v n -> Bool
/= :: LinExpr v n -> LinExpr v n -> Bool
$c/= :: forall v n. (Eq n, Eq v) => LinExpr v n -> LinExpr v n -> Bool
== :: LinExpr v n -> LinExpr v n -> Bool
$c== :: forall v n. (Eq n, Eq v) => LinExpr v n -> LinExpr v n -> Bool
Eq, Int -> LinExpr v n -> String -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall v n.
(Show n, Show v) =>
Int -> LinExpr v n -> String -> String
forall v n. (Show n, Show v) => [LinExpr v n] -> String -> String
forall v n. (Show n, Show v) => LinExpr v n -> String
showList :: [LinExpr v n] -> String -> String
$cshowList :: forall v n. (Show n, Show v) => [LinExpr v n] -> String -> String
show :: LinExpr v n -> String
$cshow :: forall v n. (Show n, Show v) => LinExpr v n -> String
showsPrec :: Int -> LinExpr v n -> String -> String
$cshowsPrec :: forall v n.
(Show n, Show v) =>
Int -> LinExpr v n -> String -> String
Show)
type Period v n = [(v, n)]
type Phase n = n
type Amplitude v n = LinExpr v n

-- A sum of sinewaves with the same period (a linear sum of several
-- variables), but possibly different (constant) phase.  For example
-- @(2*a+b) sin (x+y) + 2*b*sin(x+y+pi)@ would be represented by:
-- @TrigTerm [(x,1),(y,1)] [(0, LinExpr 0 [(a, 2), (b, 1)]),
-- (pi, LinExpr 0 [(b, 2)])@
type TrigTerm v n = (Period v n, [(Phase n, Amplitude v n)])

-- Any other term
data NonLinExpr v n = 
  UnaryApp UnaryOp (Expr v n) |
  MulExp (Expr v n) (Expr v n) |
  SinExp (Expr v n)
  deriving (NonLinExpr v n -> NonLinExpr v n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v n.
(Eq v, Eq n) =>
NonLinExpr v n -> NonLinExpr v n -> Bool
/= :: NonLinExpr v n -> NonLinExpr v n -> Bool
$c/= :: forall v n.
(Eq v, Eq n) =>
NonLinExpr v n -> NonLinExpr v n -> Bool
== :: NonLinExpr v n -> NonLinExpr v n -> Bool
$c== :: forall v n.
(Eq v, Eq n) =>
NonLinExpr v n -> NonLinExpr v n -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v n x. Rep (NonLinExpr v n) x -> NonLinExpr v n
forall v n x. NonLinExpr v n -> Rep (NonLinExpr v n) x
$cto :: forall v n x. Rep (NonLinExpr v n) x -> NonLinExpr v n
$cfrom :: forall v n x. NonLinExpr v n -> Rep (NonLinExpr v n) x
Generic)

-- | An angular function of the form @c + n*sin(theta + alpha)@
-- where @theta@, and @n@ are linear terms, @alpha@ and @c@ are constants.
type LinearMap v n = M.HashMap v (LinExpr v n)
type TrigEq v n = (Period v n, Amplitude v n, Phase n, n)
type TrigEq2 v n = M.HashMap (Period v n)
                   (M.HashMap v (Expr v n))

pattern LinearE :: LinExpr v n -> Expr v n
pattern $bLinearE :: forall v n. LinExpr v n -> Expr v n
$mLinearE :: forall {r} {v} {n}.
Expr v n -> (LinExpr v n -> r) -> ((# #) -> r) -> r
LinearE l = Expr l [] []

pattern ConstE :: n -> Expr v n
pattern $bConstE :: forall n v. n -> Expr v n
$mConstE :: forall {r} {n} {v}. Expr v n -> (n -> r) -> ((# #) -> r) -> r
ConstE c = Expr (LinExpr c []) [] []

pattern LConst :: n -> LinExpr v n
pattern $bLConst :: forall n v. n -> LinExpr v n
$mLConst :: forall {r} {n} {v}. LinExpr v n -> (n -> r) -> ((# #) -> r) -> r
LConst c = LinExpr c []

instance (Hashable v, Hashable n) => Hashable (LinExpr v n)
instance (Hashable v, Hashable n) => Hashable (NonLinExpr v n)
instance Hashable UnaryOp
instance (Hashable v, Hashable n) => Hashable (Expr v n)
instance Hashable SimpleVar

-- | A simple String wrapper, which will print formulas more cleanly.
instance Show SimpleVar where
  show :: SimpleVar -> String
show (SimpleVar String
s) = String
s

-- | This hidden datatype represents a system of equations.  It
-- contains linear dependencies on variables as well as nonlinear
-- equations. The following terminology is used from /metafont/:
-- 
--   * /known variable/: A variable who's dependency is just a number.
--   
--   * /dependend variable/: A variable which depends linearly on other variables.
--
--   * /independend variable/: any other variable.
--
-- A /dependend/ variable can only depend on other /independend/
-- variables.  Nonlinear equations will be simplified by substituting
-- and evaluating known variables, or by reducing some trigonometric
-- equations to linear equations.
data Dependencies v n = Dependencies
                        (M.HashMap v (H.HashSet v))
                        (LinearMap v n)
                        [TrigEq v n]
                        (TrigEq2 v n)
                        [Expr v n]
                        
-- | An error type for '===', '=&=' and 'addEquation':
data DepError v n =
  -- | The variable is not defined.
  UndefinedVar v |
  -- | The variable is defined but dependend an other variables.
  UnknownVar v n |
  -- | The equation was reduced to the
  -- impossible equation `a == 0` for nonzero a, which means the
  -- equation is inconsistent with previous equations.
  InconsistentEq n (Expr v n) |
  -- | The equation was reduced to the redundant equation `0 == 0`,
  -- which means it doesn't add any information.
  RedundantEq (Expr v n)
  deriving Typeable

instance (Ord n, Num n, Show v, Show n, Typeable v, Typeable n)
       => Exception (DepError v n)

instance (Ord n, Num n, Eq n, Show v, Show n) => Show (Expr v n) where
  show :: Expr v n -> String
show Expr v n
e = forall a. Show a => a -> String
show (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e)

-- | A monad transformer for solving equations.  Basicly just a state
-- and exception monad transformer over `Dependencies` and `DepError`.
newtype MFSolverT v n m a =
  MFSolverT (StateT (Dependencies v n) (ExceptT (DepError v n) m) a)
  deriving (forall a b. a -> MFSolverT v n m b -> MFSolverT v n m a
forall a b. (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
forall v n (m :: * -> *) a b.
Functor m =>
a -> MFSolverT v n m b -> MFSolverT v n m a
forall v n (m :: * -> *) a b.
Functor m =>
(a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MFSolverT v n m b -> MFSolverT v n m a
$c<$ :: forall v n (m :: * -> *) a b.
Functor m =>
a -> MFSolverT v n m b -> MFSolverT v n m a
fmap :: forall a b. (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
$cfmap :: forall v n (m :: * -> *) a b.
Functor m =>
(a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
Functor, forall a. a -> MFSolverT v n m a
forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m a
forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
forall a b.
MFSolverT v n m (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
forall a b c.
(a -> b -> c)
-> MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m c
forall {v} {n} {m :: * -> *}. Monad m => Functor (MFSolverT v n m)
forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m a
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
forall v n (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m a
$c<* :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m a
*> :: forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
$c*> :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
liftA2 :: forall a b c.
(a -> b -> c)
-> MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m c
$cliftA2 :: forall v n (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m c
<*> :: forall a b.
MFSolverT v n m (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
$c<*> :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m (a -> b) -> MFSolverT v n m a -> MFSolverT v n m b
pure :: forall a. a -> MFSolverT v n m a
$cpure :: forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
Applicative, forall a. a -> MFSolverT v n m a
forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
forall a b.
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b
forall v n (m :: * -> *). Monad m => Applicative (MFSolverT v n m)
forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> MFSolverT v n m a
$creturn :: forall v n (m :: * -> *) a. Monad m => a -> MFSolverT v n m a
>> :: forall a b.
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
$c>> :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> MFSolverT v n m b -> MFSolverT v n m b
>>= :: forall a b.
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b
$c>>= :: forall v n (m :: * -> *) a b.
Monad m =>
MFSolverT v n m a -> (a -> MFSolverT v n m b) -> MFSolverT v n m b
Monad, forall a. IO a -> MFSolverT v n m a
forall {v} {n} {m :: * -> *}. MonadIO m => Monad (MFSolverT v n m)
forall v n (m :: * -> *) a. MonadIO m => IO a -> MFSolverT v n m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> MFSolverT v n m a
$cliftIO :: forall v n (m :: * -> *) a. MonadIO m => IO a -> MFSolverT v n m a
MonadIO, MonadState (Dependencies v n),
             MonadError (DepError v n), MonadReader s, MonadWriter s,
             forall a b.
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a
forall {v} {n} {m :: * -> *}.
MonadCont m =>
Monad (MFSolverT v n m)
forall v n (m :: * -> *) a b.
MonadCont m =>
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
callCC :: forall a b.
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a
$ccallCC :: forall v n (m :: * -> *) a b.
MonadCont m =>
((a -> MFSolverT v n m b) -> MFSolverT v n m a)
-> MFSolverT v n m a
MonadCont)

instance MonadTrans (MFSolverT v n) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> MFSolverT v n m a
lift = forall v n (m :: * -> *) a.
StateT (Dependencies v n) (ExceptT (DepError v n) m) a
-> MFSolverT v n m a
MFSolverT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runSolverT :: MFSolverT v n m a -> Dependencies v n
           -> m (Either (DepError v n) (a, Dependencies v n))
runSolverT :: forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT (MFSolverT StateT (Dependencies v n) (ExceptT (DepError v n) m) a
s) = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT (Dependencies v n) (ExceptT (DepError v n) m) a
s 

-- | A monad for solving equations.  Basicly just a state and
-- exception monad over `Dependencies` and `DepError`.
type MFSolver v n a = MFSolverT v n Identity a

withParens :: (Show t1, Show t, Ord t1, Num t1, Eq t1) => SimpleExpr t t1
           -> [BinaryOp] -> String
withParens :: forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens e :: SimpleExpr t t1
e@(SEBin BinaryOp
op SimpleExpr t t1
_ SimpleExpr t t1
_) [BinaryOp]
ops
  | BinaryOp
op forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BinaryOp]
ops = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SimpleExpr t t1
e forall a. [a] -> [a] -> [a]
++ String
")"
withParens SimpleExpr t t1
e [BinaryOp]
_ = forall a. Show a => a -> String
show SimpleExpr t t1
e

instance (Show v, Ord n, Show n, Num n, Eq n) => Show (SimpleExpr v n) where
  show :: SimpleExpr v n -> String
show (Var v
v) = forall a. Show a => a -> String
show v
v
  show (Const n
n) = forall a. Show a => a -> String
show n
n
  show (SEBin BinaryOp
Add SimpleExpr v n
e1 (SEBin BinaryOp
Mul (Const n
e2) SimpleExpr v n
e3))
    | n
e2 forall a. Ord a => a -> a -> Bool
< n
0 =
      forall a. Show a => a -> String
show SimpleExpr v n
e1 forall a. [a] -> [a] -> [a]
++ String
" - " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (forall v n. n -> SimpleExpr v n
Const (forall a. Num a => a -> a
negate n
e2)) SimpleExpr v n
e3)
  show (SEBin BinaryOp
Add SimpleExpr v n
e1 SimpleExpr v n
e2) =
    forall a. Show a => a -> String
show SimpleExpr v n
e1 forall a. [a] -> [a] -> [a]
++ String
" + " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SimpleExpr v n
e2
  show (SEBin BinaryOp
Mul (Const n
1) SimpleExpr v n
e) = forall a. Show a => a -> String
show SimpleExpr v n
e
  show (SEBin BinaryOp
Mul SimpleExpr v n
e (Const n
1)) = forall a. Show a => a -> String
show SimpleExpr v n
e
  show (SEBin BinaryOp
Mul SimpleExpr v n
e1 (SEUn UnaryOp
Recip SimpleExpr v n
e2)) =
    forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e1 [BinaryOp
Add] forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e2 [BinaryOp
Add, BinaryOp
Mul]
  show (SEBin BinaryOp
Mul SimpleExpr v n
e1 SimpleExpr v n
e2) =
    forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e1 [BinaryOp
Add] forall a. [a] -> [a] -> [a]
++ String
"*" forall a. [a] -> [a] -> [a]
++ forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e2 [BinaryOp
Add]
  show (SEUn UnaryOp
Exp (SEBin BinaryOp
Mul (SEUn UnaryOp
Log SimpleExpr v n
e1) SimpleExpr v n
e2)) =
    forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e1 [BinaryOp
Add, BinaryOp
Mul] forall a. [a] -> [a] -> [a]
++ String
"**" forall a. [a] -> [a] -> [a]
++ forall t1 t.
(Show t1, Show t, Ord t1, Num t1, Eq t1) =>
SimpleExpr t t1 -> [BinaryOp] -> String
withParens SimpleExpr v n
e2 [BinaryOp
Add, BinaryOp
Mul]
  show (SEUn UnaryOp
op SimpleExpr v n
e) = forall a. Show a => a -> String
show UnaryOp
op forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SimpleExpr v n
e forall a. [a] -> [a] -> [a]
++ String
")"

instance Show BinaryOp where
  show :: BinaryOp -> String
show BinaryOp
Add = String
"+"
  show BinaryOp
Mul = String
"*"

instance Show UnaryOp where
  show :: UnaryOp -> String
show UnaryOp
Sin = String
"sin"
  show UnaryOp
Abs = String
"abs"
  show UnaryOp
Recip = String
"1/"
  show UnaryOp
Signum = String
"sign"
  show UnaryOp
Exp = String
"exp"
  show UnaryOp
Log = String
"log"
  show UnaryOp
Cos = String
"cos"
  show UnaryOp
Cosh = String
"cosh"
  show UnaryOp
Atanh = String
"atanh"
  show UnaryOp
Tan = String
"tan"
  show UnaryOp
Tanh = String
"tanh"
  show UnaryOp
Sinh = String
"sinh"
  show UnaryOp
Asin = String
"asin"
  show UnaryOp
Acos = String
"acos"
  show UnaryOp
Asinh = String
"asinh"
  show UnaryOp
Acosh = String
"acosh"
  show UnaryOp
Atan = String
"atan"

instance (Floating n, Ord n, Ord v) => Num (Expr v n) where
  + :: Expr v n -> Expr v n -> Expr v n
(+) = forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
addExpr
  * :: Expr v n -> Expr v n -> Expr v n
(*) = forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
mulExpr
  negate :: Expr v n -> Expr v n
negate = forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
mulExpr (forall n v. n -> Expr v n
ConstE (-n
1))
  abs :: Expr v n -> Expr v n
abs = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Abs
  signum :: Expr v n -> Expr v n
signum = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Signum
  fromInteger :: Integer -> Expr v n
fromInteger = forall n v. n -> Expr v n
ConstE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger

instance (Floating n, Ord n, Ord v) => Fractional (Expr v n) where
  recip :: Expr v n -> Expr v n
recip = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Recip
  fromRational :: Rational -> Expr v n
fromRational = forall n v. n -> Expr v n
ConstE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational

instance (Floating n, Ord n, Ord v) => Floating (Expr v n) where
  pi :: Expr v n
pi = forall n v. n -> Expr v n
ConstE forall a. Floating a => a
pi
  exp :: Expr v n -> Expr v n
exp = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Exp
  log :: Expr v n -> Expr v n
log = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Log
  sin :: Expr v n -> Expr v n
sin = forall n v. Floating n => Expr v n -> Expr v n
sinExpr
  cos :: Expr v n -> Expr v n
cos Expr v n
a = forall n v. Floating n => Expr v n -> Expr v n
sinExpr (Expr v n
a forall a. Num a => a -> a -> a
+ forall n v. n -> Expr v n
ConstE (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/n
2))
  cosh :: Expr v n -> Expr v n
cosh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Cosh
  atanh :: Expr v n -> Expr v n
atanh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Atanh
  tan :: Expr v n -> Expr v n
tan = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Tan
  tanh :: Expr v n -> Expr v n
tanh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Tanh
  sinh :: Expr v n -> Expr v n
sinh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Sinh
  asin :: Expr v n -> Expr v n
asin = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Asin
  acos :: Expr v n -> Expr v n
acos = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Acos
  asinh :: Expr v n -> Expr v n
asinh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Asinh
  acosh :: Expr v n -> Expr v n
acosh = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Acosh
  atan :: Expr v n -> Expr v n
atan = forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
Atan

instance (Show n, Floating n, Ord n, Ord v, Show v)
    => Show (Dependencies v n) where
  show :: Dependencies v n -> String
show dep :: Dependencies v n
dep@(Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) = 
    [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall {n} {a} {v}.
(Ord n, Num n, Show a, Show v, Show n) =>
(a, LinExpr v n) -> String
showLin (forall k v. HashMap k v -> [(k, v)]
M.toList LinearMap v n
lin) forall a. [a] -> [a] -> [a]
++
             forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
showNl (forall n v.
(Ord n, Ord v, Floating n) =>
Dependencies v n -> [Expr v n]
nonlinearEqs Dependencies v n
dep))
    where showLin :: (a, LinExpr v n) -> String
showLin (a
v, LinExpr v n
e) = forall a. Show a => a -> String
show a
v forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
e)
          showNl :: a -> String
showNl a
e = forall a. Show a => a -> String
show a
e forall a. [a] -> [a] -> [a]
++ String
" = 0"

instance (Num n, Ord n, Show n, Show v) => Show (DepError v n) where
  show :: DepError v n -> String
show (InconsistentEq n
a Expr v n
e) =
    String
"Inconsistent equations, off by " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show n
a forall a. [a] -> [a] -> [a]
++
    String
".  original expression: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Expr v n
e
  show (RedundantEq Expr v n
e) =
    String
"Redundant Equation: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Expr v n
e
  show (UndefinedVar v
v) =
    forall a. HasCallStack => String -> a
error (String
"Variable is undefined: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show v
v)
  show (UnknownVar v
v n
n) =
    forall a. HasCallStack => String -> a
error (String
"Value of variable not known: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show v
v forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show n
n)

addSimple :: (Num t1, Eq t1) => SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimple :: forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimple (Const t1
0) SimpleExpr t t1
e = SimpleExpr t t1
e
addSimple SimpleExpr t t1
e (Const t1
0) = SimpleExpr t t1
e
addSimple SimpleExpr t t1
e1 SimpleExpr t t1
e2 = forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Add SimpleExpr t t1
e1 SimpleExpr t t1
e2

seHasVar :: Eq v => v -> SimpleExpr v t -> Bool
seHasVar :: forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v1 (Var v
v2) = v
v1 forall a. Eq a => a -> a -> Bool
== v
v2
seHasVar v
_ (Const t
_) = Bool
False
seHasVar v
v (SEBin BinaryOp
_ SimpleExpr v t
e1 SimpleExpr v t
e2) =
  forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v SimpleExpr v t
e1 Bool -> Bool -> Bool
||
  forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v SimpleExpr v t
e2
seHasVar v
v (SEUn UnaryOp
_ SimpleExpr v t
e) = forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v SimpleExpr v t
e

-- | The expression contains the given variable.
hasVar :: (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar :: forall t v. (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar v
v = forall v t. Eq v => v -> SimpleExpr v t -> Bool
seHasVar v
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple

linToSimple :: (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple :: forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple (LinExpr n
v [(v, n)]
t) =
  forall v n. n -> SimpleExpr v n
Const n
v forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
`addSimple`
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimpleforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {n} {v}. (Eq n, Num n) => (v, n) -> SimpleExpr v n
mul) (forall v n. n -> SimpleExpr v n
Const n
0) [(v, n)]
t
  where
    mul :: (v, n) -> SimpleExpr v n
mul (v
v2, n
1) = forall v n. v -> SimpleExpr v n
Var v
v2
    mul (v
v2, n
c) = forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (forall v n. n -> SimpleExpr v n
Const n
c) (forall v n. v -> SimpleExpr v n
Var v
v2)

   
trigToSimple :: (Num n, Eq n) => TrigTerm v n -> SimpleExpr v n
trigToSimple :: forall n v. (Num n, Eq n) => TrigTerm v n -> SimpleExpr v n
trigToSimple (Period v n
theta, [(n, Amplitude v n)]
t) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimpleforall b c a. (b -> c) -> (a -> b) -> a -> c
.(n, Amplitude v n) -> SimpleExpr v n
makeSin) (forall v n. n -> SimpleExpr v n
Const n
0) [(n, Amplitude v n)]
t
  where
    makeSin :: (n, Amplitude v n) -> SimpleExpr v n
makeSin (n
alpha, Amplitude v n
n) =
      forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple Amplitude v n
n)
      (forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
Sin SimpleExpr v n
angle) where
        angle :: SimpleExpr v n
angle = forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple (forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
alpha Period v n
theta)

nonlinToSimple :: (Num n, Eq n) => NonLinExpr v n -> SimpleExpr v n
nonlinToSimple :: forall n v. (Num n, Eq n) => NonLinExpr v n -> SimpleExpr v n
nonlinToSimple (UnaryApp UnaryOp
o Expr v n
e) =
  forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
o (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e)
nonlinToSimple (MulExp Expr v n
e1 Expr v n
e2) =
  forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
Mul (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e1) (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e2)
nonlinToSimple (SinExp Expr v n
e) =
  forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
Sin (forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple Expr v n
e)

-- | Convert an `Expr` to a `SimpleExpr`.
toSimple :: (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple :: forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple (Expr LinExpr v n
lin [TrigTerm v n]
trig [NonLinExpr v n]
nonlin) =
  forall n v. (Num n, Eq n) => LinExpr v n -> SimpleExpr v n
linToSimple LinExpr v n
lin forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
`addSimple`
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimpleforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v. (Num n, Eq n) => TrigTerm v n -> SimpleExpr v n
trigToSimple)
  (forall v n. n -> SimpleExpr v n
Const n
0) [TrigTerm v n]
trig forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
`addSimple`
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall t1 t.
(Num t1, Eq t1) =>
SimpleExpr t t1 -> SimpleExpr t t1 -> SimpleExpr t t1
addSimpleforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v. (Num n, Eq n) => NonLinExpr v n -> SimpleExpr v n
nonlinToSimple)
  (forall v n. n -> SimpleExpr v n
Const n
0) [NonLinExpr v n]
nonlin

evalBin :: (Floating n) => BinaryOp -> n -> n -> n
evalBin :: forall n. Floating n => BinaryOp -> n -> n -> n
evalBin BinaryOp
Add = forall a. Num a => a -> a -> a
(+)
evalBin BinaryOp
Mul = forall a. Num a => a -> a -> a
(*)

evalUn :: (Floating n) => UnaryOp -> n -> n
evalUn :: forall n. Floating n => UnaryOp -> n -> n
evalUn UnaryOp
Sin = forall a. Floating a => a -> a
sin
evalUn UnaryOp
Abs = forall a. Num a => a -> a
abs
evalUn UnaryOp
Recip = forall a. Fractional a => a -> a
recip
evalUn UnaryOp
Signum = forall a. Num a => a -> a
signum
evalUn UnaryOp
Exp = forall a. Floating a => a -> a
exp
evalUn UnaryOp
Log = forall a. Floating a => a -> a
log
evalUn UnaryOp
Cos = forall a. Floating a => a -> a
cos
evalUn UnaryOp
Cosh = forall a. Floating a => a -> a
cosh
evalUn UnaryOp
Atanh = forall a. Floating a => a -> a
atanh
evalUn UnaryOp
Tan = forall a. Floating a => a -> a
tan
evalUn UnaryOp
Tanh = forall a. Floating a => a -> a
tanh
evalUn UnaryOp
Sinh = forall a. Floating a => a -> a
sinh
evalUn UnaryOp
Asin = forall a. Floating a => a -> a
asin
evalUn UnaryOp
Acos = forall a. Floating a => a -> a
acos
evalUn UnaryOp
Asinh = forall a. Floating a => a -> a
asinh
evalUn UnaryOp
Acosh = forall a. Floating a => a -> a
acosh
evalUn UnaryOp
Atan = forall a. Floating a => a -> a
atan

-- | evaluate a simple expression using the given substitution.
evalSimple :: Floating m => (n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple :: forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> m
_ v -> m
s (Var v
v) = v -> m
s v
v
evalSimple n -> m
g v -> m
_ (Const n
c) = n -> m
g n
c
evalSimple n -> m
g v -> m
s (SEBin BinaryOp
f SimpleExpr v n
e1 SimpleExpr v n
e2) =
  forall n. Floating n => BinaryOp -> n -> n -> n
evalBin BinaryOp
f (forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> m
g v -> m
s SimpleExpr v n
e1) (forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> m
g v -> m
s SimpleExpr v n
e2)
evalSimple n -> m
g v -> m
s (SEUn UnaryOp
f SimpleExpr v n
e) =
  forall n. Floating n => UnaryOp -> n -> n
evalUn UnaryOp
f (forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple n -> m
g v -> m
s SimpleExpr v n
e)

-- | map a simple expression using the given substitution.
mapSimple :: (Floating m, Floating n) => (n -> m) -> (v -> u) -> SimpleExpr v n
          -> SimpleExpr u m
mapSimple :: forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
_ v -> u
g (Var v
v) = forall v n. v -> SimpleExpr v n
Var (v -> u
g v
v)
mapSimple n -> m
f v -> u
_ (Const n
c) = forall v n. n -> SimpleExpr v n
Const (n -> m
f n
c)
mapSimple n -> m
f v -> u
g (SEBin BinaryOp
h SimpleExpr v n
e1 SimpleExpr v n
e2) =
  forall v n.
BinaryOp -> SimpleExpr v n -> SimpleExpr v n -> SimpleExpr v n
SEBin BinaryOp
h (forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
f v -> u
g SimpleExpr v n
e1) (forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
f v -> u
g SimpleExpr v n
e2)
mapSimple n -> m
f v -> u
g (SEUn UnaryOp
h SimpleExpr v n
e) =
  forall v n. UnaryOp -> SimpleExpr v n -> SimpleExpr v n
SEUn UnaryOp
h (forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
f v -> u
g SimpleExpr v n
e)

-- | map an expression using the given substitution.
mapExpr :: (Floating m, Floating n, Ord u, Ord v, Eq n, Ord m) =>
           (n -> m) -> (v -> u) -> Expr v n -> Expr u m
mapExpr :: forall m n u v.
(Floating m, Floating n, Ord u, Ord v, Eq n, Ord m) =>
(n -> m) -> (v -> u) -> Expr v n -> Expr u m
mapExpr n -> m
f v -> u
g = forall n v.
(Floating n, Ord n, Ord v) =>
SimpleExpr v n -> Expr v n
fromSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m n v u.
(Floating m, Floating n) =>
(n -> m) -> (v -> u) -> SimpleExpr v n -> SimpleExpr u m
mapSimple n -> m
f v -> u
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n v. (Num n, Eq n) => Expr v n -> SimpleExpr v n
toSimple

-- | Make a expression from a simple expression.
fromSimple :: (Floating n, Ord n, Ord v) => SimpleExpr v n -> Expr v n
fromSimple :: forall n v.
(Floating n, Ord n, Ord v) =>
SimpleExpr v n -> Expr v n
fromSimple = forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple forall n v. n -> Expr v n
makeConstant forall n v. Num n => v -> Expr v n
makeVariable

-- | Evaluate the expression given a variable substitution.
evalExpr :: (Floating n) => (v -> n) -> SimpleExpr v n -> n
evalExpr :: forall n v. Floating n => (v -> n) -> SimpleExpr v n -> n
evalExpr = forall m n v.
Floating m =>
(n -> m) -> (v -> m) -> SimpleExpr v n -> m
evalSimple forall a. a -> a
id

zeroTerm :: (Num n) => LinExpr v n
zeroTerm :: forall n v. Num n => LinExpr v n
zeroTerm = forall n v. n -> LinExpr v n
LConst n
0

zeroExpr :: (Num n) => Expr v n
zeroExpr :: forall n v. Num n => Expr v n
zeroExpr = forall n v. n -> Expr v n
makeConstant n
0

-- | Create an expression from a constant
makeConstant :: n -> Expr v n
makeConstant :: forall n v. n -> Expr v n
makeConstant = forall n v. n -> Expr v n
ConstE

-- | Create an expression from a variable
makeVariable :: Num n => v -> Expr v n
makeVariable :: forall n v. Num n => v -> Expr v n
makeVariable v
v = forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v
v, n
1)]

trigExpr :: (Num n) => [TrigTerm v n] -> Expr v n
trigExpr :: forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [TrigTerm v n]
t = forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr forall n v. Num n => LinExpr v n
zeroTerm [TrigTerm v n]
t []

nonlinExpr :: Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr :: forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr = forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr forall n v. Num n => LinExpr v n
zeroTerm []

isConst :: LinExpr v n -> Bool
isConst :: forall v n. LinExpr v n -> Bool
isConst (LConst n
_) = Bool
True
isConst LinExpr v n
_ = Bool
False

linVars :: LinExpr v n -> [v]
linVars :: forall v n. LinExpr v n -> [v]
linVars (LinExpr n
_ [(v, n)]
v) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(v, n)]
v

addLin :: (Ord v, Num n, Eq n) => LinExpr v n -> LinExpr v n -> LinExpr v n
addLin :: forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
addLin (LinExpr n
c1 [(v, n)]
terms1) (LinExpr n
c2 [(v, n)]
terms2) =
  forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
c1forall a. Num a => a -> a -> a
+n
c2) [(v, n)]
terms3 where
    terms3 :: [(v, n)]
terms3 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= n
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
             forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [(v, n)]
terms1 [(v, n)]
terms2 forall a. Num a => a -> a -> a
(+)

addExpr :: (Ord n, Ord v, Floating n) => Expr v n -> Expr v n -> Expr v n
addExpr :: forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
addExpr (Expr LinExpr v n
lt1 [TrigTerm v n]
trig1 [NonLinExpr v n]
nl1) (Expr LinExpr v n
lt2 [TrigTerm v n]
trig2 [NonLinExpr v n]
nl2) =
  forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr (forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
addLin LinExpr v n
lt1 LinExpr v n
lt2) [TrigTerm v n]
trig3 ([NonLinExpr v n]
nl1forall a. [a] -> [a] -> [a]
++[NonLinExpr v n]
nl2)
  where
    trig3 :: [TrigTerm v n]
trig3 = forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [TrigTerm v n]
trig1 [TrigTerm v n]
trig2 forall a t.
(Ord a, Ord t, Floating a) =>
[(a, LinExpr t a)] -> [(a, LinExpr t a)] -> [(a, LinExpr t a)]
addTrigTerms

-- merge two association lists, by combining equal keys with
-- the given function, and keeping keys sorted.
merge :: Ord k => [(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge :: forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [] [(k, v)]
l v -> v -> v
_ = [(k, v)]
l
merge [(k, v)]
l [] v -> v -> v
_ = [(k, v)]
l
merge (a :: (k, v)
a@(k
k,v
v):[(k, v)]
as) (b :: (k, v)
b@(k
k2,v
v2):[(k, v)]
bs) v -> v -> v
f = case forall a. Ord a => a -> a -> Ordering
compare k
k k
k2 of
  Ordering
LT -> (k, v)
aforall a. a -> [a] -> [a]
: forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [(k, v)]
as ((k, v)
bforall a. a -> [a] -> [a]
:[(k, v)]
bs) v -> v -> v
f
  Ordering
EQ -> (k
k, v -> v -> v
f v
v v
v2)forall a. a -> [a] -> [a]
: forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge [(k, v)]
as [(k, v)]
bs v -> v -> v
f
  Ordering
GT -> (k, v)
bforall a. a -> [a] -> [a]
: forall k v.
Ord k =>
[(k, v)] -> [(k, v)] -> (v -> v -> v) -> [(k, v)]
merge ((k, v)
aforall a. a -> [a] -> [a]
:[(k, v)]
as) [(k, v)]
bs v -> v -> v
f

-- add trigonometric terms with the same period
addTrigTerms :: (Ord a, Ord t, Floating a)
             => [(a, LinExpr t a)] -> [(a, LinExpr t a)]
             -> [(a, LinExpr t a)]
addTrigTerms :: forall a t.
(Ord a, Ord t, Floating a) =>
[(a, LinExpr t a)] -> [(a, LinExpr t a)] -> [(a, LinExpr t a)]
addTrigTerms [] [(a, LinExpr t a)]
p = [(a, LinExpr t a)]
p
addTrigTerms [(a, LinExpr t a)]
terms [(a, LinExpr t a)]
terms2 =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {v}.
(Ord a, Ord v, Floating a) =>
(a, LinExpr v a) -> [(a, LinExpr v a)] -> [(a, LinExpr v a)]
mergeTerms [(a, LinExpr t a)]
terms [(a, LinExpr t a)]
terms2
  where
    mergeTerms :: (a, LinExpr v a) -> [(a, LinExpr v a)] -> [(a, LinExpr v a)]
mergeTerms (a
alpha, LinExpr v a
n) ((a
beta, LinExpr v a
m):[(a, LinExpr v a)]
rest) =
      case forall a t.
(Ord a, Ord t, Floating a) =>
a -> LinExpr t a -> a -> LinExpr t a -> Maybe (a, LinExpr t a)
addTrigTerm a
alpha LinExpr v a
n a
beta LinExpr v a
m of
       Just (a
_, LConst a
0) -> [(a, LinExpr v a)]
rest
       Just (a
gamma, LinExpr v a
o) ->
         (a, LinExpr v a) -> [(a, LinExpr v a)] -> [(a, LinExpr v a)]
mergeTerms (a
gamma, LinExpr v a
o) [(a, LinExpr v a)]
rest
       Maybe (a, LinExpr v a)
Nothing ->
         (a
beta, LinExpr v a
m) forall a. a -> [a] -> [a]
: (a, LinExpr v a) -> [(a, LinExpr v a)] -> [(a, LinExpr v a)]
mergeTerms (a
alpha, LinExpr v a
n) [(a, LinExpr v a)]
rest
    mergeTerms (a, LinExpr v a)
a [] = [(a, LinExpr v a)
a]

addTrigTerm :: (Ord a, Ord t, Floating a)
            => a -> LinExpr t a -> a -> LinExpr t a -> Maybe (a, LinExpr t a)
addTrigTerm :: forall a t.
(Ord a, Ord t, Floating a) =>
a -> LinExpr t a -> a -> LinExpr t a -> Maybe (a, LinExpr t a)
addTrigTerm a
alpha LinExpr t a
n a
beta LinExpr t a
m
  | a
alpha forall a. Eq a => a -> a -> Bool
== a
beta =
    forall a. a -> Maybe a
Just (a
alpha, forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
addLin LinExpr t a
n LinExpr t a
m)
  | Just a
r <- forall a t.
(Ord a, Fractional a, Eq t) =>
LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple LinExpr t a
n LinExpr t a
m =
      let gamma :: a
gamma = forall a. Floating a => a -> a
atan (a
dividentforall a. Fractional a => a -> a -> a
/a
divisor) forall a. Num a => a -> a -> a
+
                  (if a
divisor forall a. Ord a => a -> a -> Bool
< a
0 then forall a. Floating a => a
pi else a
0)
          divident :: a
divident = a
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
sin a
alpha forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
sin a
beta
          divisor :: a
divisor = a
rforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos a
alpha forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
cos a
beta
          o :: a
o = forall a. Floating a => a -> a
sqrt(a
dividentforall a. Num a => a -> a -> a
*a
divident forall a. Num a => a -> a -> a
+ a
divisorforall a. Num a => a -> a -> a
*a
divisor)
      in forall a. a -> Maybe a
Just (a
gamma, forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
o LinExpr t a
m)
  | Bool
otherwise = forall a. Maybe a
Nothing

-- compare if the linear term is a multiple of the other, within roundoff                
termIsMultiple :: (Ord a, Fractional a, Eq t)
               => LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple :: forall a t.
(Ord a, Fractional a, Eq t) =>
LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple (LinExpr a
_ [(t, a)]
_) (LinExpr a
0 []) = forall a. Maybe a
Nothing
termIsMultiple (LinExpr a
0 []) (LinExpr a
_ [(t, a)]
_) = forall a. Maybe a
Nothing
termIsMultiple (LinExpr a
0 r1 :: [(t, a)]
r1@((t
_, a
d1):[(t, a)]
_)) (LinExpr a
0 r2 :: [(t, a)]
r2@((t
_, a
d2):[(t, a)]
_))
  | forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [(t, a)]
r1 [(t, a)]
r2 (forall a1 a.
(Ord a1, Fractional a1, Eq a) =>
a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm (a
d1forall a. Fractional a => a -> a -> a
/a
d2)) =
      forall a. a -> Maybe a
Just (a
d1forall a. Fractional a => a -> a -> a
/a
d2)
termIsMultiple (LinExpr a
c1 [(t, a)]
r1) (LinExpr a
c2 [(t, a)]
r2)
  | forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [(t, a)]
r1 [(t, a)]
r2 (forall a1 a.
(Ord a1, Fractional a1, Eq a) =>
a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm (a
c1forall a. Fractional a => a -> a -> a
/a
c2)) =
      forall a. a -> Maybe a
Just (a
c1forall a. Fractional a => a -> a -> a
/a
c2)
  | Bool
otherwise = forall a. Maybe a
Nothing

compareTerm :: (Ord a1, Fractional a1, Eq a) => a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm :: forall a1 a.
(Ord a1, Fractional a1, Eq a) =>
a1 -> (a, a1) -> (a, a1) -> Bool
compareTerm a1
ratio (a
v3,a1
c3) (a
v4, a1
c4) = 
  a
v3 forall a. Eq a => a -> a -> Bool
== a
v4 Bool -> Bool -> Bool
&& (forall a. Num a => a -> a
abs(a1
c3 forall a. Num a => a -> a -> a
- (a1
c4 forall a. Num a => a -> a -> a
* a1
ratio)) forall a. Ord a => a -> a -> Bool
<= forall a. Num a => a -> a
abs a1
c3forall a. Num a => a -> a -> a
*a1
2e-50)

compareBy :: [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy :: forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [] [] a -> b -> Bool
_ = Bool
True
compareBy (a
e:[a]
l) (b
e2:[b]
l2) a -> b -> Bool
f =
  a -> b -> Bool
f a
e b
e2 Bool -> Bool -> Bool
&& forall a b. [a] -> [b] -> (a -> b -> Bool) -> Bool
compareBy [a]
l [b]
l2 a -> b -> Bool
f
compareBy [a]
_ [b]
_ a -> b -> Bool
_ = Bool
False
        
-- multiply a linear term by a constant.
mulLinExpr :: Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr :: forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr n
x (LinExpr n
e [(v, n)]
terms) =
  forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
eforall a. Num a => a -> a -> a
*n
x) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
*n
x)) [(v, n)]
terms

-- multiply all sines with the constant
-- constant multiplier
mulConstTrig :: (Ord n, Num n) => n -> TrigTerm v n -> TrigTerm v n
mulConstTrig :: forall n v. (Ord n, Num n) => n -> TrigTerm v n -> TrigTerm v n
mulConstTrig n
c (Period v n
theta, [(n, Amplitude v n)]
terms) =  (Period v n
theta, [(n, Amplitude v n)]
tt) where
  tt :: [(n, Amplitude v n)]
tt = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr n
c)) [(n, Amplitude v n)]
terms

mulLinTrig :: (Ord n, Ord v, Floating n)
           => LinExpr v n -> TrigTerm v n -> Expr v n
mulLinTrig :: forall n v.
(Ord n, Ord v, Floating n) =>
LinExpr v n -> TrigTerm v n -> Expr v n
mulLinTrig LinExpr v n
lt (Period v n
theta, [(n, LinExpr v n)]
terms) =
  -- linear multiplier
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(n, LinExpr v n) -> Expr v n
mul1) Expr v n
0 [(n, LinExpr v n)]
terms
  where
    -- constant amplitude
    mul1 :: (n, LinExpr v n) -> Expr v n
mul1 (n
alpha, LinExpr n
c []) =
      forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [(Period v n
theta, [(n
alpha, forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr n
c LinExpr v n
lt)])]
    -- linear amplitude
    mul1 (n, LinExpr v n)
t =
      forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [forall v n. Expr v n -> Expr v n -> NonLinExpr v n
MulExp (forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [(Period v n
theta, [(n, LinExpr v n)
t])])
                  (forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr LinExpr v n
lt [] [])]

-- constant * (linear + trig)
mulExpr :: (Ord a, Ord t, Floating a) => Expr t a -> Expr t a -> Expr t a
mulExpr :: forall n v.
(Ord n, Ord v, Floating n) =>
Expr v n -> Expr v n -> Expr v n
mulExpr (ConstE a
c) (Expr LinExpr t a
lt2 [TrigTerm t a]
trig []) =
  forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt2)
  (forall a b. (a -> b) -> [a] -> [b]
map (forall n v. (Ord n, Num n) => n -> TrigTerm v n -> TrigTerm v n
mulConstTrig a
c) [TrigTerm t a]
trig) []

mulExpr (Expr LinExpr t a
lt2 [TrigTerm t a]
trig []) (ConstE a
c) =
  forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt2)
  (forall a b. (a -> b) -> [a] -> [b]
map (forall n v. (Ord n, Num n) => n -> TrigTerm v n -> TrigTerm v n
mulConstTrig a
c) [TrigTerm t a]
trig) []

-- linear * (constant + trig)
mulExpr (LinearE LinExpr t a
lt) (Expr (LConst a
c) [TrigTerm t a]
trig []) =
  forall v n. LinExpr v n -> Expr v n
LinearE (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt) forall a. Num a => a -> a -> a
+
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v.
(Ord n, Ord v, Floating n) =>
LinExpr v n -> TrigTerm v n -> Expr v n
mulLinTrig LinExpr t a
lt) Expr t a
0 [TrigTerm t a]
trig

mulExpr (Expr (LConst a
c) [TrigTerm t a]
trig []) (LinearE LinExpr t a
lt) =
  forall v n. LinExpr v n -> Expr v n
LinearE (forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr a
c LinExpr t a
lt) forall a. Num a => a -> a -> a
+
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v.
(Ord n, Ord v, Floating n) =>
LinExpr v n -> TrigTerm v n -> Expr v n
mulLinTrig LinExpr t a
lt) Expr t a
0 [TrigTerm t a]
trig

-- anything else
mulExpr Expr t a
e1 Expr t a
e2 = forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [forall v n. Expr v n -> Expr v n -> NonLinExpr v n
MulExp Expr t a
e1 Expr t a
e2]
      
sinExpr :: Floating n => Expr v n -> Expr v n
sinExpr :: forall n v. Floating n => Expr v n -> Expr v n
sinExpr (Expr (LinExpr n
c [(v, n)]
t) [] [])
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(v, n)]
t = forall n v. n -> Expr v n
ConstE (forall a. Floating a => a -> a
sin n
c)
  | Bool
otherwise = forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [([(v, n)]
t, [(n
c, forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
1 [])])]
sinExpr Expr v n
e = forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [forall v n. Expr v n -> NonLinExpr v n
SinExp Expr v n
e]

unExpr :: Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr :: forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
f (ConstE n
c) = forall n v. n -> Expr v n
ConstE (forall n. Floating n => UnaryOp -> n -> n
evalUn UnaryOp
f n
c)
unExpr UnaryOp
f Expr v n
e = forall n v. Num n => [NonLinExpr v n] -> Expr v n
nonlinExpr [forall v n. UnaryOp -> Expr v n -> NonLinExpr v n
UnaryApp UnaryOp
f Expr v n
e]

substVarLin :: (Ord v, Num n, Eq n)
            => (v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin :: forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin v -> Maybe (LinExpr v n)
s (LinExpr n
a [(v, n)]
terms) =
  let substOne :: (v, n) -> LinExpr v n
substOne (v
v, n
c) =
        case v -> Maybe (LinExpr v n)
s v
v of
         Maybe (LinExpr v n)
Nothing -> forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v
v, n
c)]
         Just LinExpr v n
expr -> forall n v. Num n => n -> LinExpr v n -> LinExpr v n
mulLinExpr n
c LinExpr v n
expr
  in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
addLinforall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> LinExpr v n
substOne) (forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
a []) [(v, n)]
terms

substVarNonLin :: (Ord n, Ord v, Floating n)
               => (v -> Maybe (LinExpr v n)) -> NonLinExpr v n -> Expr v n
substVarNonLin :: forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> NonLinExpr v n -> Expr v n
substVarNonLin v -> Maybe (LinExpr v n)
s (UnaryApp UnaryOp
f Expr v n
e1) =
  forall n v. Floating n => UnaryOp -> Expr v n -> Expr v n
unExpr UnaryOp
f (forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s Expr v n
e1)
substVarNonLin v -> Maybe (LinExpr v n)
s (MulExp Expr v n
e1 Expr v n
e2) =
  forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s Expr v n
e1 forall a. Num a => a -> a -> a
* forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s Expr v n
e2
substVarNonLin v -> Maybe (LinExpr v n)
s (SinExp Expr v n
e1) =
  forall a. Floating a => a -> a
sin (forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s Expr v n
e1)

substVarTrig :: (Ord v, Ord n, Floating n)
             => (v -> Maybe (LinExpr v n)) -> ([(v, n)], [(n, LinExpr v n)]) -> Expr v n
substVarTrig :: forall v n.
(Ord v, Ord n, Floating n) =>
(v -> Maybe (LinExpr v n))
-> ([(v, n)], [(n, LinExpr v n)]) -> Expr v n
substVarTrig v -> Maybe (LinExpr v n)
s ([(v, n)]
period, [(n, LinExpr v n)]
terms) =
  let period2 :: Expr v n
period2 = forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin v -> Maybe (LinExpr v n)
s (forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v, n)]
period)
      terms2 :: [(n, Expr v n)]
terms2 = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall v n. LinExpr v n -> Expr v n
LinearE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin v -> Maybe (LinExpr v n)
s) [(n, LinExpr v n)]
terms
  in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(n
p,Expr v n
a) -> (forall a. Num a => a -> a -> a
+ (Expr v n
a forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (forall n v. n -> Expr v n
ConstE n
p forall a. Num a => a -> a -> a
+ Expr v n
period2))))
     Expr v n
0 [(n, Expr v n)]
terms2

subst :: (Ord n, Ord v, Floating n)
      => (v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst :: forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst v -> Maybe (LinExpr v n)
s (Expr LinExpr v n
lt [TrigTerm v n]
trig [NonLinExpr v n]
nl) =
  forall v n. LinExpr v n -> Expr v n
LinearE (forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin v -> Maybe (LinExpr v n)
s LinExpr v n
lt) forall a. Num a => a -> a -> a
+
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall v n.
(Ord v, Ord n, Floating n) =>
(v -> Maybe (LinExpr v n))
-> ([(v, n)], [(n, LinExpr v n)]) -> Expr v n
substVarTrig v -> Maybe (LinExpr v n)
s) Expr v n
0 [TrigTerm v n]
trig forall a. Num a => a -> a -> a
+
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> NonLinExpr v n -> Expr v n
substVarNonLin v -> Maybe (LinExpr v n)
s) Expr v n
0 [NonLinExpr v n]
nl

-- | An empty system of equations.
noDeps :: Dependencies v n
noDeps :: forall v n. Dependencies v n
noDeps = forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies forall k v. HashMap k v
M.empty forall k v. HashMap k v
M.empty [] forall k v. HashMap k v
M.empty []

simpleSubst :: Eq a => a -> b -> a -> Maybe b
simpleSubst :: forall a b. Eq a => a -> b -> a -> Maybe b
simpleSubst a
x b
y a
z
  | a
x forall a. Eq a => a -> a -> Bool
== a
z = forall a. a -> Maybe a
Just b
y
  | Bool
otherwise = forall a. Maybe a
Nothing

trigToExpr :: (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr :: forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr (Period v n
p, Amplitude v n
a, n
ph, n
c) =
  forall v n. LinExpr v n -> Expr v n
LinearE Amplitude v n
a forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin(forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
ph Period v n
p) forall a. Num a => a -> a -> a
+
  forall n v. n -> Expr v n
ConstE n
c

trig2ToExpr :: (Ord v, Floating n, Ord n) => M.HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr :: forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr =
  forall a b. (a -> b) -> [a] -> [b]
map (\(v
v,Expr v n
e)-> forall n v. Num n => v -> Expr v n
makeVariable v
vforall a. Num a => a -> a -> a
-Expr v n
e)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
M.toList

addEqs :: (Hashable v, Hashable n, RealFrac (Phase n), Ord v, Floating n)
       => Dependencies v n -> [Expr v n]
       -> Either (DepError v n) (Dependencies v n)
addEqs :: forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
addEqs = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall n v.
(Hashable n, Hashable v, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n)
addEquation

-- | @addEquation d e@: Add the equation @e = 0@ to the system d.
addEquation :: (Hashable n, Hashable v, RealFrac (Phase n), Ord v,
          Floating n) =>
         Dependencies v n
         -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEquation :: forall n v.
(Hashable n, Hashable v, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n)
addEquation deps :: Dependencies v n
deps@(Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) Expr v n
expr =
  forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 Dependencies v n
deps Expr v n
expr forall a b. (a -> b) -> a -> b
$
  -- substitute known and dependend variables
  forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup LinearMap v n
lin) Expr v n
expr
  
-- the following alternative would continue after a redundant error.
-- However a redundant expression is supposed to be an error in metafont.
-- 
-- addEqs dep [] = Right dep
-- addEqs dep (e:r) =
--   case addEq0 dep e of
--    Left (InconsistentEq c) ->
--      Left $ InconsistentEq c
--    Left RedundantEq ->
--      addEqs dep r
--    Right newdep ->
--      case addEqs newdep r of
--       Left (InconsistentEq c) ->
--         Left $ InconsistentEq c
--       Left RedundantEq -> Right newdep
--       Right newerdep -> Right newerdep

-- This one is by Cale Gibbard: 

select :: [a] -> [(a, [a])]
select :: forall a. [a] -> [(a, [a])]
select [] = []
select (a
x:[a]
xs) =
  (a
x,[a]
xs) forall a. a -> [a] -> [a]
: [(a
y,a
xforall a. a -> [a] -> [a]
:[a]
ys) | (a
y,[a]
ys) <- forall a. [a] -> [(a, [a])]
select [a]
xs]

-- substitute v for lt in all linear equations
-- if insertp is true, then add v = tl to equations
substDep :: (Hashable v, Ord v, Num n, Eq n) =>
             M.HashMap v (H.HashSet v) -> M.HashMap v (LinExpr v n)
             -> v -> LinExpr v n -> Bool 
             -> (M.HashMap v (H.HashSet v), LinearMap v n)
substDep :: forall v n.
(Hashable v, Ord v, Num n, Eq n) =>
HashMap v (HashSet v)
-> HashMap v (LinExpr v n)
-> v
-> LinExpr v n
-> Bool
-> (HashMap v (HashSet v), HashMap v (LinExpr v n))
substDep HashMap v (HashSet v)
vdep HashMap v (LinExpr v n)
lin v
v LinExpr v n
lt Bool
insertp =
       -- variables that depend on v
  let depVars :: HashSet v
depVars = forall a. a -> Maybe a -> a
fromMaybe forall a. HashSet a
H.empty (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v HashMap v (HashSet v)
vdep)
      -- substitute v in all dependend variables and (optionally) add
      -- v as dependend variable
      lin' :: HashMap v (LinExpr v n)
lin' = (if Bool
insertp then forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert v
v LinExpr v n
lt
              else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
             forall a b. (a -> b -> a) -> a -> HashSet b -> a
H.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
M.adjust forall a b. (a -> b) -> a -> b
$
                       forall v n.
(Ord v, Num n, Eq n) =>
(v -> Maybe (LinExpr v n)) -> LinExpr v n -> LinExpr v n
substVarLin forall a b. (a -> b) -> a -> b
$
                       forall a b. Eq a => a -> b -> a -> Maybe b
simpleSubst v
v LinExpr v n
lt)
             HashMap v (LinExpr v n)
lin HashSet v
depVars
      -- add dependency link from independend variables to the
      -- substituted equations and (optionally) v, and remove v (since
      -- it has become dependend, so no variable can depend on it).
      depVars2 :: HashSet v
depVars2 | Bool
insertp = forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
H.insert v
v HashSet v
depVars
               | Bool
otherwise = HashSet v
depVars
      -- exclude dependend variable v if k has been canceled
      tryUnion :: v -> HashSet v -> HashSet v -> HashSet v
tryUnion v
k HashSet v
m1 HashSet v
m2 =
        let xs :: HashSet v
xs = forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
H.intersection HashSet v
m1 HashSet v
m2
            hasvar :: v -> Bool
hasvar v
v2 = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v2 HashMap v (LinExpr v n)
lin' of
              Maybe (LinExpr v n)
Nothing -> Bool
False
              Just (LinExpr n
_ [(v, n)]
vs) ->
                forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
==v
k)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [(v, n)]
vs
        in forall a. (a -> Bool) -> HashSet a -> HashSet a
H.filter v -> Bool
hasvar HashSet v
xs
           forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`H.union` forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
H.difference HashSet v
m1 HashSet v
xs
           forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`H.union` forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
H.difference HashSet v
m2 HashSet v
xs
      vdep' :: HashMap v (HashSet v)
vdep' = forall a b. (a -> b -> a) -> a -> HashSet b -> a
H.foldl'
              (\HashMap v (HashSet v)
mp v
k -> forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
M.insertWith (v -> HashSet v -> HashSet v -> HashSet v
tryUnion v
k) v
k HashSet v
depVars2 HashMap v (HashSet v)
mp)
              (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete v
v HashMap v (HashSet v)
vdep)
              (forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList forall a b. (a -> b) -> a -> b
$ forall v n. LinExpr v n -> [v]
linVars LinExpr v n
lt)
  in (HashMap v (HashSet v)
vdep', HashMap v (LinExpr v n)
lin')

addEq0 :: (Hashable v, Hashable n, RealFrac (Phase n), Ord v, Floating n)
       => Dependencies v n -> Expr v n -> Expr v n
       -> Either (DepError v n) (Dependencies v n)
-- adding a constant equation
addEq0 :: forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 Dependencies v n
_ Expr v n
e (ConstE n
c) =
  forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ if forall a. Num a => a -> a
abs n
c forall a. Ord a => a -> a -> Bool
< n
eps
         then forall v n. Expr v n -> DepError v n
RedundantEq Expr v n
e
         else forall v n. n -> Expr v n -> DepError v n
InconsistentEq n
c Expr v n
e
  where eps :: n
eps = n
0.0001

-- adding a linear equation
addEq0 (Dependencies HashMap v (HashSet v)
vdep LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nonlin) Expr v n
_ (Expr LinExpr v n
lt [] []) =
  let (v
v, n
_, LinExpr v n
lt2) = forall b v.
(Ord b, Fractional b, Eq v) =>
LinExpr v b -> (v, b, LinExpr v b)
splitMax LinExpr v n
lt
      (HashMap v (HashSet v)
vdep', LinearMap v n
lin') = forall v n.
(Hashable v, Ord v, Num n, Eq n) =>
HashMap v (HashSet v)
-> HashMap v (LinExpr v n)
-> v
-> LinExpr v n
-> Bool
-> (HashMap v (HashSet v), HashMap v (LinExpr v n))
substDep HashMap v (HashSet v)
vdep LinearMap v n
lin v
v LinExpr v n
lt2 Bool
True
      
      -- Add nonlinear equations again to the system.
      trig' :: [Expr v n]
trig' = forall a b. (a -> b) -> [a] -> [b]
map forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig
      trig2' :: [Expr v n]
trig2' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [v]
M.elems TrigEq2 v n
trig2
  in forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
addEqs (forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
vdep' LinearMap v n
lin' [] forall k v. HashMap k v
M.empty []) ([Expr v n]
trig'forall a. [a] -> [a] -> [a]
++[Expr v n]
trig2'forall a. [a] -> [a] -> [a]
++[Expr v n]
nonlin)

-- adding a sine equation
addEq0 deps :: Dependencies v n
deps@(Dependencies HashMap v (HashSet v)
vdep LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nl) Expr v n
orig
  (Expr (LinExpr n
c Period v n
lt) [(Period v n
theta, [(n
alpha, LConst n
n)])] []) =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Period v n
lt then
    -- reduce a sine to linear equation
    forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 Dependencies v n
deps Expr v n
orig (forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
alpha forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
asin (-n
cforall a. Fractional a => a -> a -> a
/n
n)) Period v n
theta)
  else
    -- add a variable dependency on the sine equation
    case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Period v n
theta TrigEq2 v n
trig2 of
     -- no sine with same period
     Maybe (HashMap v (Expr v n))
Nothing -> forall {a}. LinExpr v n -> n -> n -> Either a (Dependencies v n)
addSin (forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
c Period v n
lt) n
alpha n
n
     Just HashMap v (Expr v n)
map2 ->
       case forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> Expr v n
doSubst)
            (forall n v. n -> Expr v n
ConstE n
c forall a. Num a => a -> a -> a
+
             forall n v. n -> Expr v n
ConstE n
n forall a. Num a => a -> a -> a
*
             forall a. Floating a => a -> a
sin (forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
alpha Period v n
theta))
            Period v n
lt of
        Expr LinExpr v n
lt2 [(Period v n
_, [(n
alpha2, LConst n
n2)])] []
          | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall v n. LinExpr v n -> Bool
isConst LinExpr v n
lt2
          -> forall {a}. LinExpr v n -> n -> n -> Either a (Dependencies v n)
addSin LinExpr v n
lt2 n
alpha2 n
n2
        Expr v n
e2 -> forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 Dependencies v n
deps Expr v n
orig Expr v n
e2
       where
         doSubst :: (v, n) -> Expr v n
doSubst (v
v,n
c2) = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v HashMap v (Expr v n)
map2 of
           Maybe (Expr v n)
Nothing -> forall n v. Num n => v -> Expr v n
makeVariable v
v forall a. Num a => a -> a -> a
* forall n v. n -> Expr v n
ConstE n
c2
           Just Expr v n
e2 -> Expr v n
e2 forall a. Num a => a -> a -> a
* forall n v. n -> Expr v n
ConstE n
c2
  where
    addSin :: LinExpr v n -> n -> n -> Either a (Dependencies v n)
addSin LinExpr v n
l' n
a' n
n' =
      let (v
v, n
c', LinExpr v n
r) = forall b v.
(Ord b, Fractional b, Eq v) =>
LinExpr v b -> (v, b, LinExpr v b)
splitMax LinExpr v n
l'
          trig2' :: TrigEq2 v n
trig2' = forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
M.insertWith forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
M.union Period v n
theta
                   (forall k v. Hashable k => k -> v -> HashMap k v
M.singleton v
v forall a b. (a -> b) -> a -> b
$
                    forall v n.
LinExpr v n -> [TrigTerm v n] -> [NonLinExpr v n] -> Expr v n
Expr LinExpr v n
r [(Period v n
theta, [(n
a', forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
n'forall a. Fractional a => a -> a -> a
/forall a. Num a => a -> a
negate n
c') [])])] [])
                   TrigEq2 v n
trig2
      in forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies  HashMap v (HashSet v)
vdep LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2' [Expr v n]
nl

--  adding the first sine equation
addEq0 (Dependencies HashMap v (HashSet v)
d LinearMap v n
lin [] TrigEq2 v n
trig2 [Expr v n]
nl) Expr v n
_
  (Expr (LConst n
c) [(Period v n
theta, [(n
alpha, LinExpr v n
n)])] []) =
  forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
d LinearMap v n
lin [(Period v n
theta, LinExpr v n
n, n
alpha, n
c)] TrigEq2 v n
trig2 [Expr v n]
nl

-- try reducing this equation with another sine equation
addEq0 (Dependencies HashMap v (HashSet v)
deps LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nl) Expr v n
_
  (Expr (LConst n
x) [(Period v n
theta, [(n
a, LinExpr v n
n)])] []) =
  case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. (TrigEq v n, b) -> Maybe ((n, n), b)
similarTrig forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(a, [a])]
select [TrigEq v n]
trig of
   -- no matching equation found
   [] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
deps LinearMap v n
lin ((Period v n
theta, LinExpr v n
n, n
a, n
x)forall a. a -> [a] -> [a]
:[TrigEq v n]
trig) TrigEq2 v n
trig2 [Expr v n]
nl
   -- solve for angle and amplitude, and add resulting linear
   -- equations
   [((n, n), [TrigEq v n])]
l -> forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> [Expr v n] -> Either (DepError v n) (Dependencies v n)
addEqs (forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
deps LinearMap v n
lin [TrigEq v n]
rest TrigEq2 v n
trig2 [Expr v n]
nl) [Expr v n
lin1, Expr v n
lin2]
     where
       ((n
b,n
y), [TrigEq v n]
rest) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall {b} {b}. (n, b) -> (n, b) -> Ordering
maxTrig forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) [((n, n), [TrigEq v n])]
l
       maxTrig :: (n, b) -> (n, b) -> Ordering
maxTrig (n
t1,b
_) (n
t2,b
_) = 
         forall a. Ord a => a -> a -> Ordering
compare ((n
t1forall a. Num a => a -> a -> a
-n
a)forall a. RealFrac a => a -> a -> a
`dmod`forall a. Floating a => a
pi) ((n
t2forall a. Num a => a -> a -> a
-n
a)forall a. RealFrac a => a -> a -> a
`dmod`forall a. Floating a => a
pi)
       d :: n
d      = forall a. Floating a => a -> a
sin(n
aforall a. Num a => a -> a -> a
-n
b)
       e :: n
e      = n
yforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos(n
aforall a. Num a => a -> a -> a
-n
b)forall a. Num a => a -> a -> a
-n
x
       theta2 :: n
theta2 = forall a. Floating a => a -> a
atan (-n
yforall a. Num a => a -> a -> a
*n
dforall a. Fractional a => a -> a -> a
/n
e)forall a. Num a => a -> a -> a
-n
b forall a. Num a => a -> a -> a
+
                (if (n
dforall a. Num a => a -> a -> a
*n
e) forall a. Ord a => a -> a -> Bool
< n
0 then forall a. Floating a => a
pi else n
0)
       n2 :: n
n2     = forall a. Floating a => a -> a
sqrt(n
yforall a. Num a => a -> a -> a
*n
y forall a. Num a => a -> a -> a
+ n
eforall a. Num a => a -> a -> a
*n
eforall a. Fractional a => a -> a -> a
/(n
dforall a. Num a => a -> a -> a
*n
d))
       lin1 :: Expr v n
lin1   = forall v n. LinExpr v n -> Expr v n
LinearE forall a b. (a -> b) -> a -> b
$ forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (-n
theta2) Period v n
theta
       lin2 :: Expr v n
lin2   = forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
n forall a. Num a => a -> a -> a
- forall n v. n -> Expr v n
ConstE n
n2
  where
    similarTrig :: (TrigEq v n, b) -> Maybe ((n, n), b)
similarTrig ((Period v n
t,LinExpr v n
m,n
b,n
y),b
rest)
      | Just n
r <- forall a t.
(Ord a, Fractional a, Eq t) =>
LinExpr t a -> LinExpr t a -> Maybe a
termIsMultiple LinExpr v n
m LinExpr v n
n,
        Period v n
t forall a. Eq a => a -> a -> Bool
== Period v n
theta Bool -> Bool -> Bool
&&
        (n
bforall a. Num a => a -> a -> a
-n
a) forall a. RealFrac a => a -> a -> a
`dmod` forall a. Floating a => a
pi forall a. Ord a => a -> a -> Bool
> forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/n
8 =
          forall a. a -> Maybe a
Just ((n
b,n
yforall a. Fractional a => a -> a -> a
/n
r),b
rest)
      | Bool
otherwise = forall a. Maybe a
Nothing

-- just add any other equation to the list of nonlinear equations
addEq0 (Dependencies HashMap v (HashSet v)
d LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nonlin) Expr v n
_ Expr v n
e =
  forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
d LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 (Expr v n
eforall a. a -> [a] -> [a]
:[Expr v n]
nonlin)

deleteDep :: (Hashable k, Hashable b, Eq k, Eq b) =>
             M.HashMap b (H.HashSet k)
          -> M.HashMap k (LinExpr b n) -> k
          -> Maybe (M.HashMap b (H.HashSet k), M.HashMap k (LinExpr b n),
                    LinExpr b n)
deleteDep :: forall k b n.
(Hashable k, Hashable b, Eq k, Eq b) =>
HashMap b (HashSet k)
-> HashMap k (LinExpr b n)
-> k
-> Maybe
     (HashMap b (HashSet k), HashMap k (LinExpr b n), LinExpr b n)
deleteDep HashMap b (HashSet k)
vdep HashMap k (LinExpr b n)
lin k
v =
  case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup k
v HashMap k (LinExpr b n)
lin of
   Maybe (LinExpr b n)
Nothing -> forall a. Maybe a
Nothing
   Just LinExpr b n
lt -> forall a. a -> Maybe a
Just (HashMap b (HashSet k)
vdep', HashMap k (LinExpr b n)
lin', LinExpr b n
lt)
     where
       -- delete equation of v
       lin' :: HashMap k (LinExpr b n)
lin' = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete k
v HashMap k (LinExpr b n)
lin
       -- delete v from dependencies
       vdep' :: HashMap b (HashSet k)
vdep' = forall a b. (a -> b -> a) -> a -> HashSet b -> a
H.foldl'
               (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
M.adjust forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
H.delete k
v)
               HashMap b (HashSet k)
vdep (forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList forall a b. (a -> b) -> a -> b
$ forall v n. LinExpr v n -> [v]
linVars LinExpr b n
lt)

-- | Eliminate an variable from the equations.  Returns the eliminated
-- equations.  Before elimination it performs substitution to minimize
-- the number of eliminated equations.
-- 
--__Important__: this function is
-- still experimental and mostly untested.
eliminate :: (Hashable n, Show n, Hashable v, RealFrac (Phase n), Ord v, Show v,
              Floating n)
          => Dependencies v n -> v -> (Dependencies v n, [Expr v n])
eliminate :: forall n v.
(Hashable n, Show n, Hashable v, RealFrac n, Ord v, Show v,
 Floating n) =>
Dependencies v n -> v -> (Dependencies v n, [Expr v n])
eliminate (Dependencies HashMap v (HashSet v)
vdep LinearMap v n
lin [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nonlin) v
v
  | Just (HashMap v (HashSet v)
vdep', LinearMap v n
lin', LinExpr v n
lt) <- forall k b n.
(Hashable k, Hashable b, Eq k, Eq b) =>
HashMap b (HashSet k)
-> HashMap k (LinExpr b n)
-> k
-> Maybe
     (HashMap b (HashSet k), HashMap k (LinExpr b n), LinExpr b n)
deleteDep HashMap v (HashSet v)
vdep LinearMap v n
lin v
v =
    -- v is dependend, so doesn't appear in other equations
    (forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
vdep' LinearMap v n
lin' [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nonlin,
     [forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
lt forall a. Num a => a -> a -> a
- forall n v. Num n => v -> Expr v n
makeVariable v
v])
  | Just HashSet v
vars <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v HashMap v (HashSet v)
vdep,
    (v
v2:[v]
_) <- forall a. HashSet a -> [a]
H.toList HashSet v
vars =
      -- v is independend, and appears in a linear equation
      case forall k b n.
(Hashable k, Hashable b, Eq k, Eq b) =>
HashMap b (HashSet k)
-> HashMap k (LinExpr b n)
-> k
-> Maybe
     (HashMap b (HashSet k), HashMap k (LinExpr b n), LinExpr b n)
deleteDep HashMap v (HashSet v)
vdep LinearMap v n
lin v
v2 of
       Maybe (HashMap v (HashSet v), LinearMap v n, LinExpr v n)
Nothing ->
         forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Internal error: found empty dependency on " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show v
v2
       Just (HashMap v (HashSet v)
vdep', LinearMap v n
lin', LinExpr v n
lt) ->
         -- rearrange the deleted equation in terms of v
         let lt2 :: LinExpr v n
lt2 = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall v n.
(Show v, Ord v, Fractional n, Eq n) =>
v -> LinExpr v n -> v -> (n, LinExpr v n)
reArrange v
v2 LinExpr v n
lt v
v
             -- substitute v in all equations
             (HashMap v (HashSet v)
vdep'', LinearMap v n
lin'') = forall v n.
(Hashable v, Ord v, Num n, Eq n) =>
HashMap v (HashSet v)
-> HashMap v (LinExpr v n)
-> v
-> LinExpr v n
-> Bool
-> (HashMap v (HashSet v), HashMap v (LinExpr v n))
substDep HashMap v (HashSet v)
vdep' LinearMap v n
lin' v
v LinExpr v n
lt2 Bool
False
             trig' :: [Expr v n]
trig' = forall a b. (a -> b) -> [a] -> [b]
map forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig
             trig2' :: [Expr v n]
trig2' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [v]
M.elems TrigEq2 v n
trig2
             deps :: Dependencies v n
deps = forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
vdep'' LinearMap v n
lin'' [] forall k v. HashMap k v
M.empty []
             e :: [Expr v n]
e = [forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v n
lt2 forall a. Num a => a -> a -> a
- forall n v. Num n => v -> Expr v n
makeVariable v
v]
          -- use addEq0 since substitution is unnecessary
         in case forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 forall n v. Num n => Expr v n
zeroExpr)
                 Dependencies v n
deps forall a b. (a -> b) -> a -> b
$
                 forall a b. (a -> b) -> [a] -> [b]
map (forall n v.
(Ord n, Ord v, Floating n) =>
(v -> Maybe (LinExpr v n)) -> Expr v n -> Expr v n
subst forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> b -> a -> Maybe b
simpleSubst v
v LinExpr v n
lt2)
                 ([Expr v n]
trig'forall a. [a] -> [a] -> [a]
++[Expr v n]
trig2'forall a. [a] -> [a] -> [a]
++[Expr v n]
nonlin) of
             Left DepError v n
_ -> (Dependencies v n
deps, [Expr v n]
e) --shouldn't happen
             Right Dependencies v n
d -> (Dependencies v n
d, [Expr v n]
e)
  | Bool
otherwise =
      let ([Expr v n]
l, TrigEq2 v n
trig2') =
            forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
M.foldrWithKey forall {n}.
(Floating n, Ord n, Hashable n) =>
Period v n
-> HashMap v (Expr v n)
-> ([Expr v n], HashMap (Period v n) (HashMap v (Expr v n)))
-> ([Expr v n], HashMap (Period v n) (HashMap v (Expr v n)))
trigFold
            ([], forall k v. HashMap k v
M.empty) TrigEq2 v n
trig2
          trigFold :: Period v n
-> HashMap v (Expr v n)
-> ([Expr v n], HashMap (Period v n) (HashMap v (Expr v n)))
-> ([Expr v n], HashMap (Period v n) (HashMap v (Expr v n)))
trigFold Period v n
p HashMap v (Expr v n)
t ([Expr v n]
l2, HashMap (Period v n) (HashMap v (Expr v n))
m2) =
            let ([Expr v n]
l3, HashMap v (Expr v n)
m1) = forall v n.
(Show v, Ord v, Hashable v, Floating n, Ord n) =>
Period v n
-> HashMap v (Expr v n) -> v -> ([Expr v n], HashMap v (Expr v n))
elimTrig Period v n
p HashMap v (Expr v n)
t v
v
                mp :: HashMap (Period v n) (HashMap v (Expr v n))
mp | forall k v. HashMap k v -> Bool
M.null HashMap v (Expr v n)
m1 = HashMap (Period v n) (HashMap v (Expr v n))
m2
                   | Bool
otherwise = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Period v n
p HashMap v (Expr v n)
m1 HashMap (Period v n) (HashMap v (Expr v n))
m2
            in ([Expr v n]
l3forall a. [a] -> [a] -> [a]
++[Expr v n]
l2, HashMap (Period v n) (HashMap v (Expr v n))
mp)
            
          ([Expr v n]
nlWith, [Expr v n]
nlWithout) =
            forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall t v. (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar v
v) forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig forall a. [a] -> [a] -> [a]
++ [Expr v n]
nonlin
          deps :: Dependencies v n
deps = forall v n.
HashMap v (HashSet v)
-> LinearMap v n
-> [TrigEq v n]
-> TrigEq2 v n
-> [Expr v n]
-> Dependencies v n
Dependencies HashMap v (HashSet v)
vdep LinearMap v n
lin [] TrigEq2 v n
trig2' []
      in case forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall v n.
(Hashable v, Hashable n, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Expr v n -> Either (DepError v n) (Dependencies v n)
addEq0 forall n v. Num n => Expr v n
zeroExpr) Dependencies v n
deps
              [Expr v n]
nlWithout of
             Left DepError v n
_ -> (Dependencies v n
deps, [Expr v n]
nlWithforall a. [a] -> [a] -> [a]
++[Expr v n]
l) --shouldn't happen
             Right Dependencies v n
d -> (Dependencies v n
d, [Expr v n]
nlWithforall a. [a] -> [a] -> [a]
++[Expr v n]
l)

-- v2 = c2*v + b + c
reArrange :: (Show v, Ord v, Fractional n, Eq n) =>
             v -> LinExpr v n -> v -> (n, LinExpr v n)
reArrange :: forall v n.
(Show v, Ord v, Fractional n, Eq n) =>
v -> LinExpr v n -> v -> (n, LinExpr v n)
reArrange v
v2 (LinExpr n
c [(v, n)]
vars) v
v =
  case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==v
v)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fstforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(a, [a])]
select [(v, n)]
vars of
   Maybe ((v, n), [(v, n)])
Nothing ->
     forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Internal error: variable " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show v
v forall a. [a] -> [a] -> [a]
++
     String
" not in linear expression "
   Just ((v
_,n
c2), [(v, n)]
r) ->
     (n
c2,
      forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (n
cforall a. Fractional a => a -> a -> a
/forall a. Num a => a -> a
negate n
c2) [(v, n)]
r
      forall v n.
(Ord v, Num n, Eq n) =>
LinExpr v n -> LinExpr v n -> LinExpr v n
`addLin` forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr n
0 [(v
v2, n
1forall a. Fractional a => a -> a -> a
/n
c2)])

reArrangeTrig :: (Show v, Ord t1, Ord v, Floating t1)
              => v -> Expr v t1 -> v -> Expr v t1
reArrangeTrig :: forall v t1.
(Show v, Ord t1, Ord v, Floating t1) =>
v -> Expr v t1 -> v -> Expr v t1
reArrangeTrig v
v2 (Expr LinExpr v t1
lt [TrigTerm v t1]
trig [NonLinExpr v t1]
_) v
v =
  let (t1
c2, LinExpr v t1
lt2) = forall v n.
(Show v, Ord v, Fractional n, Eq n) =>
v -> LinExpr v n -> v -> (n, LinExpr v n)
reArrange v
v2 LinExpr v t1
lt v
v
  in forall v n. LinExpr v n -> Expr v n
LinearE LinExpr v t1
lt2 forall a. Num a => a -> a -> a
- forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [TrigTerm v t1]
trig forall a. Fractional a => a -> a -> a
/ forall n v. n -> Expr v n
ConstE t1
c2
  
elimTrig :: (Show v, Ord v, Hashable v, Floating n, Ord n) =>
            Period v n -> M.HashMap v (Expr v n) -> v
         -> ([Expr v n], M.HashMap v (Expr v n))
elimTrig :: forall v n.
(Show v, Ord v, Hashable v, Floating n, Ord n) =>
Period v n
-> HashMap v (Expr v n) -> v -> ([Expr v n], HashMap v (Expr v n))
elimTrig Period v n
p HashMap v (Expr v n)
m v
v
  -- period contains the variable, remove all eqs
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
==v
v)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) Period v n
p =
      (forall v n.
(Ord v, Floating n, Ord n) =>
HashMap v (Expr v n) -> [Expr v n]
trig2ToExpr HashMap v (Expr v n)
m, forall k v. HashMap k v
M.empty)
  -- the variable is dependend in:
  -- v = e (== sin(p+const) + linear)
  -- remove the eq
  | Just Expr v n
e <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v HashMap v (Expr v n)
m =
      ([forall n v. Num n => v -> Expr v n
makeVariable v
v forall a. Num a => a -> a -> a
- Expr v n
e],
       forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete v
v HashMap v (Expr v n)
m)
  -- the variable is independent in:
  -- v2 = e (== sin(p+const) + const*v + linear)
  -- rearrange, and substitute
  | Just (v
v2, Expr v n
e) <-
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall t v. (Num t, Eq v, Eq t) => v -> Expr v t -> Bool
hasVar v
vforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
M.toList HashMap v (Expr v n)
m =
      let e2 :: Expr v n
e2 = forall v t1.
(Show v, Ord t1, Ord v, Floating t1) =>
v -> Expr v t1 -> v -> Expr v t1
reArrangeTrig v
v2 Expr v n
e v
v
          substOne :: (v, n) -> Expr v n
substOne (v
v3, n
c)
            | v
v forall a. Eq a => a -> a -> Bool
== v
v3 = Expr v n
e2 forall a. Num a => a -> a -> a
* forall n v. n -> Expr v n
ConstE n
c
            | Bool
otherwise = forall n v. Num n => v -> Expr v n
makeVariable v
v3 forall a. Num a => a -> a -> a
* forall n v. n -> Expr v n
ConstE n
c
          doSubst :: Expr v n -> Expr v n
doSubst (Expr (LinExpr n
c Period v n
lt) [TrigTerm v n]
trig [NonLinExpr v n]
_) =
            forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(v, n) -> Expr v n
substOne) 
            (forall n v. n -> Expr v n
ConstE n
c forall a. Num a => a -> a -> a
+ forall n v. Num n => [TrigTerm v n] -> Expr v n
trigExpr [TrigTerm v n]
trig) Period v n
lt
      in ([forall n v. Num n => v -> Expr v n
makeVariable v
v forall a. Num a => a -> a -> a
- Expr v n
e],
          forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map Expr v n -> Expr v n
doSubst forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete v
v2 HashMap v (Expr v n)
m)
  -- variable not found
  | Bool
otherwise =
    ([], HashMap v (Expr v n)
m)

dmod :: RealFrac a => a -> a -> a
dmod :: forall a. RealFrac a => a -> a -> a
dmod a
a a
b = forall a. Num a => a -> a
abs((a
aforall a. Fractional a => a -> a -> a
/a
b) forall a. Num a => a -> a -> a
- forall a. Num a => Integer -> a
fromInteger (forall a b. (RealFrac a, Integral b) => a -> b
round (a
aforall a. Fractional a => a -> a -> a
/a
b)) forall a. Num a => a -> a -> a
* a
b)

-- put the variable with the maximum coefficient on the lhs of the
-- equation
splitMax :: (Ord b, Fractional b, Eq v) => LinExpr v b -> (v, b, LinExpr v b)
splitMax :: forall b v.
(Ord b, Fractional b, Eq v) =>
LinExpr v b -> (v, b, LinExpr v b)
splitMax (LinExpr b
c [(v, b)]
t) =
  let ((v
v,b
c2),[(v, b)]
r) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a. Num a => a -> a
absforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
sndforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst)) forall a b. (a -> b) -> a -> b
$
                   forall a. [a] -> [(a, [a])]
select [(v, b)]
t
  in (v
v, b
c2,
      forall v n. n -> [(v, n)] -> LinExpr v n
LinExpr (-b
cforall a. Fractional a => a -> a -> a
/b
c2) forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a
negateforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. Fractional a => a -> a -> a
/b
c2))) [(v, b)]
r)
      
-- | Return True if the variable is known or dependend.
varDefined :: (Eq v, Hashable v) => v -> Dependencies v n -> Bool
varDefined :: forall v n. (Eq v, Hashable v) => v -> Dependencies v n -> Bool
varDefined v
v (Dependencies HashMap v (HashSet v)
_ LinearMap v n
dep [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
  case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
v LinearMap v n
dep of
    Maybe (LinExpr v n)
Nothing -> Bool
False
    Maybe (LinExpr v n)
_ -> Bool
True

-- | Return all dependend variables with their dependencies.
dependendVars :: (Eq n) => Dependencies v n -> [(v, LinExpr v n)]
dependendVars :: forall n v. Eq n => Dependencies v n -> [(v, LinExpr v n)]
dependendVars (Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
  forall a. (a -> Bool) -> [a] -> [a]
filter (forall v n. LinExpr v n -> Bool
notConstforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) (forall k v. HashMap k v -> [(k, v)]
M.toList LinearMap v n
lin)
  where
    notConst :: LinExpr v n -> Bool
notConst (LinExpr n
_ []) = Bool
False
    notConst LinExpr v n
_ = Bool
True
  

-- | Return all known variables.
knownVars :: Dependencies v n -> [(v, n)]
knownVars :: forall v n. Dependencies v n -> [(v, n)]
knownVars (Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {v} {b}. (a, LinExpr v b) -> Maybe (a, b)
knownVar forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
M.toList LinearMap v n
lin
  where
    knownVar :: (a, LinExpr v b) -> Maybe (a, b)
knownVar (a
v, LinExpr b
n []) = forall a. a -> Maybe a
Just (a
v, b
n)
    knownVar (a, LinExpr v b)
_ = forall a. Maybe a
Nothing

-- -- | Return all independend variables.
-- freeVars :: (Eq v, Hashable v) => Dependencies n v -> [v]
-- freeVars (Dependencies dep) =
--   HS.toList $ M.foldl' addVars HS.empty dep
--   where addVars s (LinExpr _ a) =
--           HS.union s $ HS.fromList $ map fst a

-- | Return the value of the variable, or a list of variables
-- it depends on.  Only linear dependencies are shown.
getKnown :: (Eq v, Hashable v) => v -> Dependencies v n -> Either [v] n
getKnown :: forall v n.
(Eq v, Hashable v) =>
v -> Dependencies v n -> Either [v] n
getKnown v
var (Dependencies HashMap v (HashSet v)
_ LinearMap v n
lin [TrigEq v n]
_ TrigEq2 v n
_ [Expr v n]
_) =
  case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup v
var LinearMap v n
lin of
    Maybe (LinExpr v n)
Nothing -> forall a b. a -> Either a b
Left  []
    Just (LinExpr n
a []) ->
      forall a b. b -> Either a b
Right n
a
    Just (LinExpr n
_ [(v, n)]
v) ->
      forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(v, n)]
v

-- | Return all nonlinear equations @e_i@, where @e_i = 0@.
nonlinearEqs :: (Ord n, Ord v, Floating n) => Dependencies v n -> [Expr v n]
nonlinearEqs :: forall n v.
(Ord n, Ord v, Floating n) =>
Dependencies v n -> [Expr v n]
nonlinearEqs  (Dependencies HashMap v (HashSet v)
_ LinearMap v n
_ [TrigEq v n]
trig TrigEq2 v n
trig2 [Expr v n]
nl) =
  forall a b. (a -> b) -> [a] -> [b]
map forall n v. (Ord n, Ord v, Floating n) => TrigEq v n -> Expr v n
trigToExpr [TrigEq v n]
trig forall a. [a] -> [a] -> [a]
++
  forall a b. (a -> b) -> [a] -> [b]
map (\(v
v, Expr v n
e) -> forall n v. Num n => v -> Expr v n
makeVariable v
v forall a. Num a => a -> a -> a
- Expr v n
e) 
  (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall k v. HashMap k v -> [(k, v)]
M.toList (forall k v. HashMap k v -> [v]
M.elems TrigEq2 v n
trig2)) forall a. [a] -> [a] -> [a]
++
  [Expr v n]
nl
  
-- | Show all variables and equations.  Useful in combination with `execSolver`.
showVars :: (Show n, Show v, Ord n, Ord v, Floating n)
         => Either (DepError v n) (Dependencies v n) -> IO ()
showVars :: forall n v.
(Show n, Show v, Ord n, Ord v, Floating n) =>
Either (DepError v n) (Dependencies v n) -> IO ()
showVars (Left DepError v n
e) = forall a. Show a => a -> IO ()
print DepError v n
e
showVars (Right Dependencies v n
dep) = forall a. Show a => a -> IO ()
print Dependencies v n
dep

-- | Get the dependencies from a state monad.  Specialized version of `get`.
dependencies :: (MonadState (Dependencies v n) m) => m (Dependencies v n)
dependencies :: forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies = forall s (m :: * -> *). MonadState s m => m s
get

-- | Return the value of the variable or throw an error.
getValue :: (MonadState (Dependencies v n) m,
             MonadError (DepError v n) m,
             Eq v, Hashable v) =>
            v -> m n
getValue :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
 Eq v, Hashable v) =>
v -> m n
getValue v
v = do
  Either [v] n
v2 <- forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, Hashable v, Eq v) =>
v -> m (Either [v] n)
getKnownM v
v
  case Either [v] n
v2 of
   Right n
e -> forall (m :: * -> *) a. Monad m => a -> m a
return n
e
   Left [v]
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall v n. v -> DepError v n
UndefinedVar v
v

-- | Monadic version of `varDefined`.
varDefinedM :: (MonadState (Dependencies v n) m, Hashable v, Eq v) =>
               v -> m Bool
varDefinedM :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, Hashable v, Eq v) =>
v -> m Bool
varDefinedM v
v = forall v n. (Eq v, Hashable v) => v -> Dependencies v n -> Bool
varDefined v
v forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies

-- | Monadic version of `getKnown`.
getKnownM :: (MonadState (Dependencies v n) m, Hashable v, Eq v) =>
             v -> m (Either [v] n)
getKnownM :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, Hashable v, Eq v) =>
v -> m (Either [v] n)
getKnownM v
v = forall v n.
(Eq v, Hashable v) =>
v -> Dependencies v n -> Either [v] n
getKnown v
v forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies

-- | Monadic version of `eliminate`.
eliminateM :: (MonadState (Dependencies v n) m, Hashable n, Hashable v,
               Show n, Show v, RealFrac n, Ord v, Floating n) =>
              v -> m [Expr v n]
eliminateM :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, Hashable n, Hashable v, Show n,
 Show v, RealFrac n, Ord v, Floating n) =>
v -> m [Expr v n]
eliminateM v
v = do
  Dependencies v n
dep <- forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies
  let (Dependencies v n
dep2, [Expr v n]
e) = forall n v.
(Hashable n, Show n, Hashable v, RealFrac n, Ord v, Show v,
 Floating n) =>
Dependencies v n -> v -> (Dependencies v n, [Expr v n])
eliminate Dependencies v n
dep v
v
  forall s (m :: * -> *). MonadState s m => s -> m ()
put Dependencies v n
dep2
  forall (m :: * -> *) a. Monad m => a -> m a
return [Expr v n]
e

infixr 1 === , =&=

-- | Make the expressions on both sides equal
(===) :: (MonadState (Dependencies v n) m,
          MonadError (DepError v n) m,
          Eq v, Hashable v, Hashable n,
          RealFrac n, Floating n, Ord v) =>
         Expr v n -> Expr v n -> m ()
=== :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
 Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
Expr v n -> Expr v n -> m ()
(===) Expr v n
lhs Expr v n
rhs = do
  Dependencies v n
deps <- forall v n (m :: * -> *).
MonadState (Dependencies v n) m =>
m (Dependencies v n)
dependencies
  case forall n v.
(Hashable n, Hashable v, RealFrac n, Ord v, Floating n) =>
Dependencies v n
-> Expr v n -> Either (DepError v n) (Dependencies v n)
addEquation Dependencies v n
deps (Expr v n
lhs forall a. Num a => a -> a -> a
- Expr v n
rhs) of
   Left DepError v n
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DepError v n
e
   Right Dependencies v n
dep -> forall s (m :: * -> *). MonadState s m => s -> m ()
put Dependencies v n
dep

-- | Make the pairs of expressions on both sides equal. No error is
-- signaled if the equation for one of the sides is `Redundant` for
-- example in (x, 0) == (y, 0).
(=&=) :: (MonadState (Dependencies v n) m,
          MonadError (DepError v n) m,
          Eq v, Hashable v, Hashable n,
          RealFrac n, Floating n, Ord v) =>
         (Expr v n, Expr v n) -> (Expr v n, Expr v n) -> m ()
=&= :: forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
 Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
(Expr v n, Expr v n) -> (Expr v n, Expr v n) -> m ()
(=&=) (Expr v n
a, Expr v n
b) (Expr v n
c, Expr v n
d) =
  do forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (Expr v n
a forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
 Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
Expr v n -> Expr v n -> m ()
=== Expr v n
c) forall a b. (a -> b) -> a -> b
$ \DepError v n
e ->
       case DepError v n
e of
        RedundantEq Expr v n
_ ->
          Expr v n
b forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
 Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
Expr v n -> Expr v n -> m ()
=== Expr v n
d
        DepError v n
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DepError v n
e
     forall v n (m :: * -> *).
MonadError (DepError v n) m =>
m () -> m ()
ignore forall a b. (a -> b) -> a -> b
$ Expr v n
b forall v n (m :: * -> *).
(MonadState (Dependencies v n) m, MonadError (DepError v n) m,
 Eq v, Hashable v, Hashable n, RealFrac n, Floating n, Ord v) =>
Expr v n -> Expr v n -> m ()
=== Expr v n
d

-- | Succeed even when trowing a `RedundantEq` error.
ignore :: MonadError (DepError v n) m => m () -> m ()
ignore :: forall v n (m :: * -> *).
MonadError (DepError v n) m =>
m () -> m ()
ignore m ()
m =
  forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m ()
m forall a b. (a -> b) -> a -> b
$ \DepError v n
e ->
  case DepError v n
e of
   RedundantEq Expr v n
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
   DepError v n
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DepError v n
e

-- | run the solver.
runSolver :: MFSolver v n a -> Dependencies v n -> Either (DepError v n) (a, Dependencies v n)
runSolver :: forall v n a.
MFSolver v n a
-> Dependencies v n -> Either (DepError v n) (a, Dependencies v n)
runSolver MFSolver v n a
s = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT MFSolver v n a
s
           
-- | Return the result of solving the equations, or throw the error as an exception.  Monadic version.
unsafeSolveT :: (Num n, Ord n, Show n, Show v, Typeable n, Typeable v, Monad m) =>
                Dependencies v n -> MFSolverT v n m a -> m a
unsafeSolveT :: forall n v (m :: * -> *) a.
(Num n, Ord n, Show n, Show v, Typeable n, Typeable v, Monad m) =>
Dependencies v n -> MFSolverT v n m a -> m a
unsafeSolveT Dependencies v n
dep MFSolverT v n m a
s = do
  Either (DepError v n) (a, Dependencies v n)
res <- forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT MFSolverT v n m a
s Dependencies v n
dep
  case Either (DepError v n) (a, Dependencies v n)
res of
   Right (a
v, Dependencies v n
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return a
v
   Left DepError v n
e -> forall a e. Exception e => e -> a
throw DepError v n
e

-- | Return the result of solving the equations or an error.  Monadic version.
evalSolverT :: Functor f =>
               MFSolverT v n f b
            -> Dependencies v n -> f (Either (DepError v n) b)
evalSolverT :: forall (f :: * -> *) v n b.
Functor f =>
MFSolverT v n f b
-> Dependencies v n -> f (Either (DepError v n) b)
evalSolverT MFSolverT v n f b
s Dependencies v n
dep =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT MFSolverT v n f b
s Dependencies v n
dep 

-- | Run the solver and return the dependencies or an error.  Monadic version.
execSolverT :: Functor m =>
               MFSolverT v n m a
            -> Dependencies v n -> m (Either (DepError v n) (Dependencies v n))
execSolverT :: forall (m :: * -> *) v n a.
Functor m =>
MFSolverT v n m a
-> Dependencies v n -> m (Either (DepError v n) (Dependencies v n))
execSolverT MFSolverT v n m a
s Dependencies v n
dep =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v n (m :: * -> *) a.
MFSolverT v n m a
-> Dependencies v n
-> m (Either (DepError v n) (a, Dependencies v n))
runSolverT MFSolverT v n m a
s Dependencies v n
dep

-- | Return the result of solving the equations, or throw the error as an exception.
unsafeSolve :: (Typeable n, Typeable v, Show n, Show v, Ord n, Num n) =>
               Dependencies v n -> MFSolver v n a -> a
unsafeSolve :: forall n v a.
(Typeable n, Typeable v, Show n, Show v, Ord n, Num n) =>
Dependencies v n -> MFSolver v n a -> a
unsafeSolve Dependencies v n
dep = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n v (m :: * -> *) a.
(Num n, Ord n, Show n, Show v, Typeable n, Typeable v, Monad m) =>
Dependencies v n -> MFSolverT v n m a -> m a
unsafeSolveT Dependencies v n
dep

-- | Return the result of solving the equations or an error.
evalSolver :: MFSolver v n a
           -> Dependencies v n -> Either (DepError v n) a
evalSolver :: forall v n a.
MFSolver v n a -> Dependencies v n -> Either (DepError v n) a
evalSolver MFSolver v n a
s = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) v n b.
Functor f =>
MFSolverT v n f b
-> Dependencies v n -> f (Either (DepError v n) b)
evalSolverT MFSolver v n a
s

-- | Run the solver and return the dependencies or an error.
execSolver :: MFSolver v n a
           -> Dependencies v n -> Either (DepError v n) (Dependencies v n)
execSolver :: forall v n a.
MFSolver v n a
-> Dependencies v n -> Either (DepError v n) (Dependencies v n)
execSolver MFSolver v n a
s = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) v n a.
Functor m =>
MFSolverT v n m a
-> Dependencies v n -> m (Either (DepError v n) (Dependencies v n))
execSolverT MFSolver v n a
s