-- | Define and collect information about ODEs and ODE solvers from various libraries.
module Data.Drasil.ExternalLibraries.ODELibraries (
  -- * SciPy Library (Python)
  scipyODEPckg, scipyODESymbols, scipyODELSodaPkg,
  -- * Oslo Library (C#)
  osloPckg, osloSymbols, arrayVecDepVar,
  -- * Apache Commons (Java)
  apacheODEPckg, apacheODESymbols, 
  -- * Odeint (C++)
  odeintPckg, odeintSymbols
) where

import Language.Drasil (HasSymbol(symbol), HasUID(uid), MayHaveUnit(getUnit),
  QuantityDict, HasSpace(typ), Space(..), implVar, implVarUID, implVarUID', qw,
  compoundPhrase, nounPhrase, nounPhraseSP, label, sub,
  Idea(getA), NamedIdea(term), Stage(..), (+++))
import Language.Drasil.Display (Symbol(Label, Concat))

import Language.Drasil.Code (Lang(..), ExternalLibrary, Step, Argument,
  externalLib, mandatoryStep, mandatorySteps, choiceSteps, choiceStep,
  callStep, libFunction, libMethod, libFunctionWithResult, libMethodWithResult,
  libConstructor, libConstructorMultiReqs, constructAndReturn, lockedArg,
  lockedNamedArg, inlineArg, inlineNamedArg, preDefinedArg, functionArg,
  customObjArg, recordArg, lockedParam, unnamedParam, customClass,
  implementation, constructorInfo, methodInfo, methodInfoNoReturn,
  appendCurrSol, populateSolList, assignArrayIndex, assignSolFromObj,
  initSolListFromArray, initSolListWithVal, solveAndPopulateWhile,
  returnExprList, fixedReturn, initSolWithVal,
  ExternalLibraryCall, externalLibCall, choiceStepsFill, choiceStepFill,
  mandatoryStepFill, mandatoryStepsFill, callStepFill, libCallFill,
  userDefinedArgFill, basicArgFill, functionArgFill, customObjArgFill,
  recordArgFill, unnamedParamFill, unnamedParamPBVFill, userDefinedParamFill,
  customClassFill, implementationFill, constructorInfoFill, methodInfoFill,
  appendCurrSolFill, populateSolListFill, assignArrayIndexFill,
  assignSolFromObjFill, initSolListFromArrayFill, initSolListWithValFill,
  solveAndPopulateWhileFill, returnExprListFill, fixedStatementFill,
  CodeVarChunk, CodeFuncChunk, quantvar, quantfunc, listToArray,
  ODEInfo(..), ODEOptions(..), ODEMethod(..), ODELibPckg, mkODELib,
  mkODELibNoPath, pubStateVar, privStateVar, initSolWithValFill,
  NamedArgument, narg)
import Language.Drasil.CodeExpr
import Language.Drasil.Code.Expr.Development

import Control.Lens ((^.), _1, _2, over)

-- SciPy Library (Python)

-- | [SciPy](https://www.scipy.org/) ODE library package.
scipyODEPckg :: ODELibPckg
scipyODEPckg :: ODELibPckg
scipyODEPckg = Name
-> Name
-> ExternalLibrary
-> (ODEInfo -> ExternalLibraryCall)
-> [Lang]
-> ODELibPckg
mkODELibNoPath "SciPy" "1.4.1" ExternalLibrary
scipyODE ODEInfo -> ExternalLibraryCall
scipyCall [Lang
Python]

scipyODE :: ExternalLibrary
scipyODE :: ExternalLibrary
scipyODE = ExternalLibrary -> ExternalLibrary
externalLib [
  Step -> StepGroup
mandatoryStep (Step -> StepGroup) -> Step -> StepGroup
forall a b. (a -> b) -> a -> b
$ FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libFunctionWithResult Name
scipyImport
    CodeFuncChunk
odefunc [
      CodeFuncChunk -> [Parameter] -> Step -> Argument
functionArg CodeFuncChunk
f ((Space -> Parameter) -> [Space] -> [Parameter]
forall a b. (a -> b) -> [a] -> [b]
map Space -> Parameter
unnamedParam [Space
Real, Space -> Space
Array Space
Real])
      Step
returnExprList] CodeVarChunk
r,
  [Step] -> StepGroup
choiceStep [
    [Argument] -> Step
setIntegratorMethod [Argument
vode, Name -> Argument
methodArg "adams", Argument
atol, Argument
rtol],
    [Argument] -> Step
setIntegratorMethod [Argument
vode, Name -> Argument
methodArg "bdf", Argument
atol, Argument
rtol],
    [Argument] -> Step
setIntegratorMethod [CodeExpr -> Argument
lockedArg (Name -> CodeExpr
forall r. LiteralC r => Name -> r
str "dopri5"), Argument
atol, Argument
rtol]],
  [Step] -> StepGroup
mandatorySteps [FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeVarChunk -> CodeFuncChunk -> [Argument] -> FunctionInterface
libMethod Name
scipyImport CodeVarChunk
r
      CodeFuncChunk
setInitVal [Space -> Argument
inlineArg Space
Real, Space -> Argument
inlineArg Space
Real],
    Step
initSolListWithVal,
    FunctionInterface
-> CodeVarChunk
-> CodeVarChunk
-> FunctionInterface
-> CodeVarChunk
-> Step
solveAndPopulateWhile (Name
-> CodeVarChunk -> CodeFuncChunk -> [Argument] -> FunctionInterface
libMethod Name
scipyImport CodeVarChunk
r CodeFuncChunk
successful []) CodeVarChunk
r CodeVarChunk
t
      (Name
-> CodeVarChunk -> CodeFuncChunk -> [Argument] -> FunctionInterface
libMethod Name
scipyImport CodeVarChunk
r CodeFuncChunk
integrateStep [Space -> Argument
inlineArg Space
Real]) CodeVarChunk
y]]

scipyCall :: ODEInfo -> ExternalLibraryCall
scipyCall :: ODEInfo -> ExternalLibraryCall
scipyCall info :: ODEInfo
info = ExternalLibraryCall -> ExternalLibraryCall
externalLibCall [
  StepFill -> StepGroupFill
mandatoryStepFill (StepFill -> StepGroupFill) -> StepFill -> StepGroupFill
forall a b. (a -> b) -> a -> b
$ FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill [[ParameterFill] -> StepFill -> ArgumentFill
functionArgFill
    ((CodeVarChunk -> ParameterFill)
-> [CodeVarChunk] -> [ParameterFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterFill
unnamedParamFill [ODEInfo -> CodeVarChunk
indepVar ODEInfo
info, ODEInfo -> CodeVarChunk
depVar ODEInfo
info])
    ([CodeExpr] -> StepFill
returnExprListFill ([CodeExpr] -> StepFill) -> [CodeExpr] -> StepFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> [CodeExpr]
odeSyst ODEInfo
info)],
  (Int -> StepFill -> StepGroupFill)
-> (Int, StepFill) -> StepGroupFill
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> StepFill -> StepGroupFill
choiceStepFill (ODEMethod -> (Int, StepFill)
forall a. Num a => ODEMethod -> (a, StepFill)
chooseMethod (ODEMethod -> (Int, StepFill)) -> ODEMethod -> (Int, StepFill)
forall a b. (a -> b) -> a -> b
$ ODEOptions -> ODEMethod
solveMethod (ODEOptions -> ODEMethod) -> ODEOptions -> ODEMethod
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info),
  [StepFill] -> StepGroupFill
mandatoryStepsFill [FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill ([ArgumentFill] -> FunctionIntFill)
-> [ArgumentFill] -> FunctionIntFill
forall a b. (a -> b) -> a -> b
$ (CodeExpr -> ArgumentFill) -> [CodeExpr] -> [ArgumentFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> ArgumentFill
basicArgFill
      [ODEInfo -> CodeExpr
initVal ODEInfo
info, ODEInfo -> CodeExpr
tInit ODEInfo
info],
    CodeVarChunk -> CodeExpr -> StepFill
initSolListWithValFill (ODEInfo -> CodeVarChunk
depVar ODEInfo
info) (ODEInfo -> CodeExpr
initVal ODEInfo
info),
    FunctionIntFill
-> CodeExpr -> FunctionIntFill -> CodeVarChunk -> StepFill
solveAndPopulateWhileFill ([ArgumentFill] -> FunctionIntFill
libCallFill []) (ODEInfo -> CodeExpr
tFinal ODEInfo
info)
      ([ArgumentFill] -> FunctionIntFill
libCallFill [CodeExpr -> ArgumentFill
basicArgFill (CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
addI (CodeVarChunk -> CodeVarChunk -> CodeExpr
forall r. CodeExprC r => CodeVarChunk -> CodeVarChunk -> r
field CodeVarChunk
r CodeVarChunk
t) (ODEOptions -> CodeExpr
stepSize (ODEInfo -> ODEOptions
odeOpts ODEInfo
info)))])
      (ODEInfo -> CodeVarChunk
depVar ODEInfo
info)]]
  where chooseMethod :: ODEMethod -> (a, StepFill)
chooseMethod Adams = (0, StepFill
solveMethodFill)
        chooseMethod BDF = (1, StepFill
solveMethodFill)
        chooseMethod RK45 = (2, StepFill
solveMethodFill)
        solveMethodFill :: StepFill
solveMethodFill = FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill ([ArgumentFill] -> FunctionIntFill)
-> [ArgumentFill] -> FunctionIntFill
forall a b. (a -> b) -> a -> b
$ (CodeExpr -> ArgumentFill) -> [CodeExpr] -> [ArgumentFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> ArgumentFill
basicArgFill
          [ODEOptions -> CodeExpr
absTol (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info, ODEOptions -> CodeExpr
relTol (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info]

-- | This package solves a system of ODEs using the scipy odeint method.
-- The odeint method solves the ode using the LSoda solver.
scipyODELSodaPkg :: ODELibPckg
scipyODELSodaPkg :: ODELibPckg
scipyODELSodaPkg = Name
-> Name
-> ExternalLibrary
-> (ODEInfo -> ExternalLibraryCall)
-> [Lang]
-> ODELibPckg
mkODELibNoPath "SciPy" "1.4.1" ExternalLibrary
scipyLSodaODE ODEInfo -> ExternalLibraryCall
scipyLSodaCall [Lang
Python]

scipyLSodaODE :: ExternalLibrary
scipyLSodaODE :: ExternalLibrary
scipyLSodaODE = ExternalLibrary -> ExternalLibrary
externalLib [
  Step -> StepGroup
mandatoryStep (Step -> StepGroup) -> Step -> StepGroup
forall a b. (a -> b) -> a -> b
$ FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libFunctionWithResult Name
numpyImport
    CodeFuncChunk
arange [Space -> Argument
inlineArg Space
Real, Space -> Argument
inlineArg Space
Real, Space -> Argument
inlineArg Space
Real] CodeVarChunk
xAxis,
  Step -> StepGroup
mandatoryStep (Step -> StepGroup) -> Step -> StepGroup
forall a b. (a -> b) -> a -> b
$ FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libFunctionWithResult Name
scipyImport
    CodeFuncChunk
odeintFunc [
      CodeFuncChunk -> [Parameter] -> Step -> Argument
functionArg CodeFuncChunk
f ((Space -> Parameter) -> [Space] -> [Parameter]
forall a b. (a -> b) -> [a] -> [b]
map Space -> Parameter
unnamedParam [Space -> Space
Array Space
Real, Space
Real])
      Step
returnExprList, Space -> Argument
inlineArg (Space -> Space
Array Space
Real), Space -> Argument
inlineArg (Space -> Space
Array Space
Real)] CodeVarChunk
ut,
  Step -> StepGroup
mandatoryStep Step
initSolWithVal
    ]

scipyLSodaCall :: ODEInfo -> ExternalLibraryCall
scipyLSodaCall :: ODEInfo -> ExternalLibraryCall
scipyLSodaCall info :: ODEInfo
info = ExternalLibraryCall -> ExternalLibraryCall
externalLibCall [
  [StepFill] -> StepGroupFill
mandatoryStepsFill [FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill ([ArgumentFill] -> FunctionIntFill)
-> [ArgumentFill] -> FunctionIntFill
forall a b. (a -> b) -> a -> b
$ (CodeExpr -> ArgumentFill) -> [CodeExpr] -> [ArgumentFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> ArgumentFill
basicArgFill
      [ODEInfo -> CodeExpr
tInit ODEInfo
info, ODEInfo -> CodeExpr
tFinal ODEInfo
info, ODEOptions -> CodeExpr
stepSize (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info]],
  StepFill -> StepGroupFill
mandatoryStepFill (StepFill -> StepGroupFill) -> StepFill -> StepGroupFill
forall a b. (a -> b) -> a -> b
$ FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill [[ParameterFill] -> StepFill -> ArgumentFill
functionArgFill
      ((CodeVarChunk -> ParameterFill)
-> [CodeVarChunk] -> [ParameterFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterFill
unnamedParamFill [ODEInfo -> CodeVarChunk
depVar ODEInfo
info, ODEInfo -> CodeVarChunk
indepVar ODEInfo
info])
      ([CodeExpr] -> StepFill
returnExprListFill ([CodeExpr] -> StepFill) -> [CodeExpr] -> StepFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> [CodeExpr]
odeSyst ODEInfo
info),
      CodeExpr -> ArgumentFill
basicArgFill ([[CodeExpr]] -> CodeExpr
forall r. ExprC r => [[r]] -> r
matrix [[ODEInfo -> CodeExpr
initVal ODEInfo
info, ODEOptions -> CodeExpr
initValFstOrd (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info]]),
      CodeExpr -> ArgumentFill
basicArgFill (CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
xAxis)],
  StepFill -> StepGroupFill
mandatoryStepFill (StepFill -> StepGroupFill) -> StepFill -> StepGroupFill
forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> CodeExpr -> StepFill
initSolWithValFill (ODEInfo -> CodeVarChunk
depVar ODEInfo
info)
      (CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
idx (CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
transpose) (Integer -> CodeExpr
forall r. LiteralC r => Integer -> r
int 0))
    ]

scipyImport :: String
scipyImport :: Name
scipyImport = "scipy.integrate"

numpyImport :: String
numpyImport :: Name
numpyImport = "numpy"

atol, rtol, vode :: Argument
vode :: Argument
vode = CodeExpr -> Argument
lockedArg (Name -> CodeExpr
forall r. LiteralC r => Name -> r
str "vode")
atol :: Argument
atol = NamedArgument -> Space -> Argument
inlineNamedArg NamedArgument
atolArg Space
Real
rtol :: Argument
rtol = NamedArgument -> Space -> Argument
inlineNamedArg NamedArgument
rtolArg Space
Real

methodArg :: String -> Argument
methodArg :: Name -> Argument
methodArg = NamedArgument -> CodeExpr -> Argument
lockedNamedArg NamedArgument
mthdArg (CodeExpr -> Argument) -> (Name -> CodeExpr) -> Name -> Argument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CodeExpr
forall r. LiteralC r => Name -> r
str

setIntegratorMethod :: [Argument] -> Step
setIntegratorMethod :: [Argument] -> Step
setIntegratorMethod = FunctionInterface -> Step
callStep (FunctionInterface -> Step)
-> ([Argument] -> FunctionInterface) -> [Argument] -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> CodeVarChunk -> CodeFuncChunk -> [Argument] -> FunctionInterface
libMethod Name
scipyImport CodeVarChunk
r CodeFuncChunk
setIntegrator

odeT, numpyArrayT :: Space
odeT :: Space
odeT = Name -> Space
Actor "ode"
numpyArrayT :: Space
numpyArrayT = Name -> Space
Actor "numpyArray"

-- | Collects variables needed for SciPy's ODEs as 'QuantityDict's.
scipyODESymbols :: [QuantityDict]
scipyODESymbols :: [QuantityDict]
scipyODESymbols = (NamedArgument -> QuantityDict)
-> [NamedArgument] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map NamedArgument -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [NamedArgument
mthdArg, NamedArgument
atolArg, NamedArgument
rtolArg]
  [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ (CodeVarChunk -> QuantityDict) -> [CodeVarChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [CodeVarChunk
r, CodeVarChunk
t, CodeVarChunk
y, CodeVarChunk
xAxis, CodeVarChunk
ut, CodeVarChunk
transpose]
  [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ (CodeFuncChunk -> QuantityDict)
-> [CodeFuncChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map CodeFuncChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [CodeFuncChunk
f, CodeFuncChunk
odefunc, CodeFuncChunk
setIntegrator, CodeFuncChunk
setInitVal, CodeFuncChunk
successful, CodeFuncChunk
integrateStep,
  CodeFuncChunk
arange, CodeFuncChunk
odeintFunc]

mthdArg, atolArg, rtolArg :: NamedArgument
mthdArg :: NamedArgument
mthdArg = QuantityDict -> NamedArgument
forall q. (Quantity q, MayHaveUnit q) => q -> NamedArgument
narg (QuantityDict -> NamedArgument) -> QuantityDict -> NamedArgument
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "method_scipy" (Name -> Name -> NP
nounPhrase
  "chosen method for solving ODE" "chosen methods for solving ODE")
  Space
String (Name -> Symbol
label "method")
atolArg :: NamedArgument
atolArg = QuantityDict -> NamedArgument
forall q. (Quantity q, MayHaveUnit q) => q -> NamedArgument
narg (QuantityDict -> NamedArgument) -> QuantityDict -> NamedArgument
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "atol_scipy" (Name -> Name -> NP
nounPhrase
  "absolute tolerance for ODE solution" "absolute tolerances for ODE solution")
  Space
Real (Name -> Symbol
label "atol")
rtolArg :: NamedArgument
rtolArg = QuantityDict -> NamedArgument
forall q. (Quantity q, MayHaveUnit q) => q -> NamedArgument
narg (QuantityDict -> NamedArgument) -> QuantityDict -> NamedArgument
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "rtol_scipy" (Name -> Name -> NP
nounPhrase
  "relative tolerance for ODE solution" "relative tolerances for ODE solution")
  Space
Real (Name -> Symbol
label "rtol")


r, xAxis, ut, transpose :: CodeVarChunk
r :: CodeVarChunk
r = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "r_scipy" (Name -> Name -> NP
nounPhrase "ODE object" "ODE objects")
  Space
odeT (Name -> Symbol
label "r")
xAxis :: CodeVarChunk
xAxis = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "x_numpy" (Name -> Name -> NP
nounPhrase "Numpy value" "Numpy value")
  (Space -> Space
Array Space
Real) (Name -> Symbol
label "x_axis")
ut :: CodeVarChunk
ut = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "ut_scipy"
  (Name -> Name -> NP
nounPhrase "Scipy integrated value" "Scipy integrated value")
  Space
numpyArrayT (Name -> Symbol
label "u_t")
transpose :: CodeVarChunk
transpose = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "transpose_numpy"
  (Name -> Name -> NP
nounPhrase "Numpy Array Transpose" "Numpy Array Transpose")
  (Space -> Space
Array Space
Real) (Name -> Symbol
label "u_t.T") -- (ccObjVar ut transpose) does not seem to work. 


f, odefunc, setIntegrator, setInitVal, successful,
  integrateStep, arange, odeintFunc :: CodeFuncChunk
f :: CodeFuncChunk
f = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "f_scipy" (Name -> Name -> NP
nounPhrase "function representing ODE system"
  "functions representing ODE system") (Space -> Space
Array Space
Real) (Name -> Symbol
label "f")
odefunc :: CodeFuncChunk
odefunc = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "ode_scipy" (Name -> Name -> NP
nounPhrase
  "function for defining an ODE for SciPy"
  "functions for defining an ODE for SciPy") Space
odeT (Name -> Symbol
label "ode")
setIntegrator :: CodeFuncChunk
setIntegrator = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "set_integrator_scipy" (Name -> Name -> NP
nounPhrase
  "method for setting SciPy integrator" "methods for setting SciPy integrator")
  Space
Void (Name -> Symbol
label "set_integrator")
setInitVal :: CodeFuncChunk
setInitVal = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "set_initial_value_scipy" (Name -> Name -> NP
nounPhrase
  "method for setting initial value for ODE for SciPy"
  "methods for setting initial value for ODE for SciPy")
  Space
Void (Name -> Symbol
label "set_initial_value")
successful :: CodeFuncChunk
successful = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "successful_scipy" (Name -> Name -> NP
nounPhrase
  "method returning True if integration is current successful"
  "methods returning True if integration is current successful")
  Space
Boolean (Name -> Symbol
label "successful")
integrateStep :: CodeFuncChunk
integrateStep = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "integrate_scipy" (Name -> Name -> NP
nounPhrase
  "method that performs one integration step on an ODE"
  "methods that perform one integration step on an ODE")
  Space
Void (Name -> Symbol
label "integrate")
arange :: CodeFuncChunk
arange = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "arrange_numpy" (Name -> Name -> NP
nounPhrase
  "method that returns evenly spaced numbers over a specified interval."
  "method that returns evenly spaced numbers over a specified interval.")
  (Space -> Space
Array Space
Real) (Name -> Symbol
label "arange")
odeintFunc :: CodeFuncChunk
odeintFunc = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "odeint_scipy" (Name -> Name -> NP
nounPhrase
  "method that solves a system of ODE using lsoda from the FORTRAN library odepack."
  "method that solves a system of ODE using lsoda from the FORTRAN library odepack.")
  (Space -> Space
Array Space
Real) (Name -> Symbol
label "odeint")

-- Oslo Library (C#)

-- | [Oslo](https://www.microsoft.com/en-us/research/project/open-solving-library-for-odes/) ODE library package.
osloPckg :: ODELibPckg
osloPckg :: ODELibPckg
osloPckg = Name
-> Name
-> ExternalLibrary
-> (ODEInfo -> ExternalLibraryCall)
-> Name
-> [Lang]
-> ODELibPckg
mkODELib "OSLO" "1.2" ExternalLibrary
oslo ODEInfo -> ExternalLibraryCall
osloCall "Microsoft.Research.Oslo.dll" [Lang
CSharp]

oslo :: ExternalLibrary
oslo :: ExternalLibrary
oslo = ExternalLibrary -> ExternalLibrary
externalLib [
  Step -> StepGroup
mandatoryStep (Step -> StepGroup) -> Step -> StepGroup
forall a b. (a -> b) -> a -> b
$ FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libConstructor Name
osloImport
    CodeFuncChunk
vector [Space -> Argument
inlineArg Space
Real] CodeVarChunk
initv,
  [Step] -> StepGroup
choiceStep ([Step] -> StepGroup) -> [Step] -> StepGroup
forall a b. (a -> b) -> a -> b
$ (CodeFuncChunk -> Step) -> [CodeFuncChunk] -> [Step]
forall a b. (a -> b) -> [a] -> [b]
map (\s :: CodeFuncChunk
s -> FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libFunctionWithResult Name
osloImport CodeFuncChunk
s [Argument]
odeArgs
    CodeVarChunk
sol) [CodeFuncChunk
rk547m, CodeFuncChunk
gearBDF],
  [Step] -> StepGroup
mandatorySteps (FunctionInterface -> Step
callStep (Name
-> CodeVarChunk
-> CodeFuncChunk
-> [Argument]
-> CodeVarChunk
-> FunctionInterface
libMethodWithResult Name
osloImport CodeVarChunk
sol
      CodeFuncChunk
solveFromToStep ((Space -> Argument) -> [Space] -> [Argument]
forall a b. (a -> b) -> [a] -> [b]
map Space -> Argument
inlineArg [Space
Real, Space
Real, Space
Real]) CodeVarChunk
points) Step -> [Step] -> [Step]
forall a. a -> [a] -> [a]
:
    CodeVarChunk -> CodeVarChunk -> CodeVarChunk -> [Step]
populateSolList CodeVarChunk
points CodeVarChunk
sp CodeVarChunk
x)]

osloCall :: ODEInfo -> ExternalLibraryCall
osloCall :: ODEInfo -> ExternalLibraryCall
osloCall info :: ODEInfo
info = ExternalLibraryCall -> ExternalLibraryCall
externalLibCall [
  StepFill -> StepGroupFill
mandatoryStepFill (StepFill -> StepGroupFill) -> StepFill -> StepGroupFill
forall a b. (a -> b) -> a -> b
$ FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill [CodeExpr -> ArgumentFill
basicArgFill (CodeExpr -> ArgumentFill) -> CodeExpr -> ArgumentFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeExpr
initVal ODEInfo
info],
  Int -> StepFill -> StepGroupFill
choiceStepFill (ODEMethod -> Int
forall p. Num p => ODEMethod -> p
chooseMethod (ODEMethod -> Int) -> ODEMethod -> Int
forall a b. (a -> b) -> a -> b
$ ODEOptions -> ODEMethod
solveMethod (ODEOptions -> ODEMethod) -> ODEOptions -> ODEMethod
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info) (StepFill -> StepGroupFill) -> StepFill -> StepGroupFill
forall a b. (a -> b) -> a -> b
$ FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$
    [ArgumentFill] -> FunctionIntFill
libCallFill [CodeExpr -> ArgumentFill
basicArgFill (CodeExpr -> ArgumentFill) -> CodeExpr -> ArgumentFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeExpr
tInit ODEInfo
info,
      [ParameterFill] -> StepFill -> ArgumentFill
functionArgFill ((CodeVarChunk -> ParameterFill)
-> [CodeVarChunk] -> [ParameterFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterFill
unnamedParamFill [ODEInfo -> CodeVarChunk
indepVar ODEInfo
info, ODEInfo -> CodeVarChunk
vecDepVar ODEInfo
info]) (StepFill -> ArgumentFill) -> StepFill -> ArgumentFill
forall a b. (a -> b) -> a -> b
$
        FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill ([ArgumentFill] -> FunctionIntFill)
-> [ArgumentFill] -> FunctionIntFill
forall a b. (a -> b) -> a -> b
$ (CodeExpr -> ArgumentFill) -> [CodeExpr] -> [ArgumentFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> ArgumentFill
userDefinedArgFill (Name -> ODEInfo -> [CodeExpr]
modifiedODESyst "arrayvec" ODEInfo
info),
      [CodeExpr] -> ArgumentFill
recordArgFill [ODEOptions -> CodeExpr
absTol (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info, ODEOptions -> CodeExpr
relTol (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info]],
  [StepFill] -> StepGroupFill
mandatoryStepsFill (FunctionIntFill -> StepFill
callStepFill ([ArgumentFill] -> FunctionIntFill
libCallFill ([ArgumentFill] -> FunctionIntFill)
-> [ArgumentFill] -> FunctionIntFill
forall a b. (a -> b) -> a -> b
$ (CodeExpr -> ArgumentFill) -> [CodeExpr] -> [ArgumentFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> ArgumentFill
basicArgFill
      [ODEInfo -> CodeExpr
tInit ODEInfo
info, ODEInfo -> CodeExpr
tFinal ODEInfo
info, ODEOptions -> CodeExpr
stepSize (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info]) StepFill -> [StepFill] -> [StepFill]
forall a. a -> [a] -> [a]
:
    CodeVarChunk -> [StepFill]
populateSolListFill (ODEInfo -> CodeVarChunk
depVar ODEInfo
info))]
  where chooseMethod :: ODEMethod -> p
chooseMethod RK45 = 0
        chooseMethod BDF = 1
        chooseMethod _ = Name -> p
forall a. HasCallStack => Name -> a
error Name
odeMethodUnavailable

odeArgs :: [Argument]
odeArgs :: [Argument]
odeArgs = [Space -> Argument
inlineArg Space
Real, CodeExpr -> Argument
lockedArg (CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
initv),
  CodeFuncChunk -> [Parameter] -> Step -> Argument
functionArg CodeFuncChunk
fOslo ((Space -> Parameter) -> [Space] -> [Parameter]
forall a b. (a -> b) -> [a] -> [b]
map Space -> Parameter
unnamedParam [Space
Real, Space
vecT])
    (FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name -> CodeFuncChunk -> [Argument] -> FunctionInterface
constructAndReturn Name
osloImport CodeFuncChunk
vector []),
  Name -> CodeFuncChunk -> CodeVarChunk -> [CodeVarChunk] -> Argument
recordArg Name
osloImport CodeFuncChunk
options CodeVarChunk
opts [CodeVarChunk
aTol, CodeVarChunk
rTol]]

solT, vecT, optT :: Space
solT :: Space
solT = Name -> Space
Actor "IEnumerable<SolPoint>"
vecT :: Space
vecT = Name -> Space
Actor "Vector"
optT :: Space
optT = Name -> Space
Actor "Options"

osloImport :: String
osloImport :: Name
osloImport = "Microsoft.Research.Oslo"

-- | Collects variables needed for Oslo's ODEs as 'QuantityDict's.
osloSymbols :: [QuantityDict]
osloSymbols :: [QuantityDict]
osloSymbols = (CodeVarChunk -> QuantityDict) -> [CodeVarChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [CodeVarChunk
initv, CodeVarChunk
opts, CodeVarChunk
aTol, CodeVarChunk
rTol, CodeVarChunk
sol, CodeVarChunk
points, CodeVarChunk
sp, CodeVarChunk
x] [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++
  (CodeFuncChunk -> QuantityDict)
-> [CodeFuncChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map CodeFuncChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [CodeFuncChunk
fOslo, CodeFuncChunk
options, CodeFuncChunk
vector, CodeFuncChunk
rk547m, CodeFuncChunk
gearBDF, CodeFuncChunk
solveFromToStep]

initv, opts, aTol, rTol, sol, points, sp, x :: CodeVarChunk
initv :: CodeVarChunk
initv = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "initv_oslo" (Name -> Name -> NP
nounPhrase
  "vector containing the initial values of the dependent variables"
  "vectors containing the initial values of the dependent variables")
  Space
vecT (Name -> Symbol
label "initv")
opts :: CodeVarChunk
opts = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "opts_oslo" (Name -> Name -> NP
nounPhrase
  "record containing options for ODE solving"
  "records containing options for ODE solving") Space
optT (Name -> Symbol
label "opts")
aTol :: CodeVarChunk
aTol = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "aTol_oslo" (Name -> Name -> NP
nounPhrase
  "absolute tolerance for ODE solution" "absolute tolerances for ODE solution")
  Space
Real (Name -> Symbol
label "AbsoluteTolerance")
rTol :: CodeVarChunk
rTol = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "rTol_oslo" (Name -> Name -> NP
nounPhrase
  "relative tolerance for ODE solution" "relative tolerances for ODE solution")
  Space
Real (Name -> Symbol
label "RelativeTolerance")
sol :: CodeVarChunk
sol = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "sol_oslo" (Name -> Name -> NP
nounPhrase "container for ODE information"
  "containers for ODE information") Space
solT (Name -> Symbol
label "sol")
points :: CodeVarChunk
points = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "points_oslo" (Name -> Name -> NP
nounPhrase
  "container holding ODE solution" "containers holding ODE solution")
  Space
solT (Name -> Symbol
label "points")
sp :: CodeVarChunk
sp = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "sp_oslo" (Name -> Name -> NP
nounPhrase "ODE solution point"
  "ODE solution points") (Name -> Space
Actor "SolPoint") (Name -> Symbol
label "sp")
x :: CodeVarChunk
x = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "X_oslo" (Name -> Name -> NP
nounPhrase "dependent variable"
  "dependent variables") (Space -> Space
Array Space
Real) (Name -> Symbol
label "X")

fOslo, options, vector, rk547m, gearBDF, solveFromToStep :: CodeFuncChunk
fOslo :: CodeFuncChunk
fOslo = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "f_oslo" (Name -> Name -> NP
nounPhrase
  "function representing ODE system" "functions representing ODE system")
  Space
vecT (Name -> Symbol
label "f")
options :: CodeFuncChunk
options = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "Options_oslo" (Name -> Name -> NP
nounPhrase
  "constructor for Options record" "constructors for Options record")
  Space
optT (Name -> Symbol
label "Options")
vector :: CodeFuncChunk
vector = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "Vector_oslo" (Name -> Name -> NP
nounPhrase
  "constructor for an OSLO Vector" "constructors for an OSLO Vector")
  Space
vecT (Name -> Symbol
label "Vector")
rk547m :: CodeFuncChunk
rk547m = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "RK547M_oslo" (Name -> Name -> NP
nounPhrase
  "function for initiating an ODE to be solved by Runge-Kutta method"
  "functions for initiating an ODE to be solved by Runge-Kutta method")
  Space
solT (Name -> Symbol
label "Ode.RK547M")
gearBDF :: CodeFuncChunk
gearBDF = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "GearBDF_oslo" (Name -> Name -> NP
nounPhrase
  "function for initiating an ODE to be solved by Gear's BDF method"
  "functions for initiating an ODE to be solved by Gear's BDF method")
  Space
solT (Name -> Symbol
label "Ode.GearBDF")
solveFromToStep :: CodeFuncChunk
solveFromToStep = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "SolveFromToStep_oslo" (Name -> Name -> NP
nounPhrase
  "method for solving an ODE given a time range"
  "methods for solving an ODE given a time range")
  Space
solT (Name -> Symbol
label "SolveFromToStep")

vecDepVar :: ODEInfo -> CodeVarChunk
vecDepVar :: ODEInfo -> CodeVarChunk
vecDepVar info :: ODEInfo
info = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ UID -> NP -> Space -> Symbol -> QuantityDict
implVarUID (CodeVarChunk
dv CodeVarChunk -> Getting UID CodeVarChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeVarChunk UID
forall c. HasUID c => Lens' c UID
uid) (CodeVarChunk
dv CodeVarChunk -> Getting NP CodeVarChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP CodeVarChunk NP
forall c. NamedIdea c => Lens' c NP
term) Space
vecT
  (Symbol -> Symbol -> Symbol
sub (CodeVarChunk -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol CodeVarChunk
dv Stage
Implementation) (Name -> Symbol
label "vec"))
  where dv :: CodeVarChunk
dv = ODEInfo -> CodeVarChunk
depVar ODEInfo
info

-- Hack required because 
-- | Oslo's Vector type behaves like an array, so needs to
-- be represented as one or else will hit type errors in GOOL.
arrayVecDepVar :: ODEInfo -> CodeVarChunk
arrayVecDepVar :: ODEInfo -> CodeVarChunk
arrayVecDepVar info :: ODEInfo
info = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ UID -> NP -> Space -> Symbol -> QuantityDict
implVarUID (CodeVarChunk
dv CodeVarChunk -> Name -> UID
forall a. HasUID a => a -> Name -> UID
+++ "vec") (CodeVarChunk
dv CodeVarChunk -> Getting NP CodeVarChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP CodeVarChunk NP
forall c. NamedIdea c => Lens' c NP
term)
  (CodeVarChunk
dv CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Lens' c Space
typ) (Symbol -> Symbol -> Symbol
sub (CodeVarChunk -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol CodeVarChunk
dv Stage
Implementation) (Name -> Symbol
label "vec"))
  where dv :: CodeVarChunk
dv = CodeVarChunk -> CodeVarChunk
listToArray (CodeVarChunk -> CodeVarChunk) -> CodeVarChunk -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info

-- Apache Commons (Java)

-- | [Apache Commons](https://commons.apache.org/) ODE library package.
apacheODEPckg :: ODELibPckg
apacheODEPckg :: ODELibPckg
apacheODEPckg = Name
-> Name
-> ExternalLibrary
-> (ODEInfo -> ExternalLibraryCall)
-> Name
-> [Lang]
-> ODELibPckg
mkODELib "Apache" "3.6.1" ExternalLibrary
apacheODE ODEInfo -> ExternalLibraryCall
apacheODECall
  "lib/commons-math3-3.6.1.jar" [Lang
Java]

apacheODE :: ExternalLibrary
apacheODE :: ExternalLibrary
apacheODE = ExternalLibrary -> ExternalLibrary
externalLib [
  [Step] -> StepGroup
choiceStep [
    FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ [Name]
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libConstructorMultiReqs [Name
apacheImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "nonstiff." Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
adams,
      Name
foiImp] CodeFuncChunk
adamsC (CodeExpr -> Argument
lockedArg (Integer -> CodeExpr
forall r. LiteralC r => Integer -> r
int 3) Argument -> [Argument] -> [Argument]
forall a. a -> [a] -> [a]
: [Argument]
itArgs) CodeVarChunk
it,
    FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ [Name]
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libConstructorMultiReqs [Name
apacheImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "nonstiff." Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
dp54,
      Name
foiImp] CodeFuncChunk
dp54C [Argument]
itArgs CodeVarChunk
it],
  [Step] -> StepGroup
mandatorySteps [FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeVarChunk -> CodeFuncChunk -> [Argument] -> FunctionInterface
libMethod Name
foiImp CodeVarChunk
it CodeFuncChunk
addStepHandler [
      [Name]
-> Name -> CodeVarChunk -> CodeFuncChunk -> ClassInfo -> Argument
customObjArg [Name
shImp, Name
siImp]
        "Class defining additional behaviour for each step of an ODE solution"
        CodeVarChunk
stepHandler CodeFuncChunk
stepHandlerCtor (Name -> [MethodInfo] -> ClassInfo
implementation Name
sh [
          CodeFuncChunk -> Name -> [Parameter] -> [Step] -> MethodInfo
methodInfoNoReturn CodeFuncChunk
initMethod
            "initializes step handler with initial conditions"
            ((CodeVarChunk -> Parameter) -> [CodeVarChunk] -> [Parameter]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> Parameter
lockedParam [CodeVarChunk
t0, CodeVarChunk
y0, CodeVarChunk
t]) [CodeVarChunk -> Step
initSolListFromArray CodeVarChunk
y0],
          CodeFuncChunk -> Name -> [Parameter] -> [Step] -> MethodInfo
methodInfoNoReturn CodeFuncChunk
handleStep
            "appends solution point at each ODE solution step"
            ((CodeVarChunk -> Parameter) -> [CodeVarChunk] -> [Parameter]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> Parameter
lockedParam [CodeVarChunk
interpolator, CodeVarChunk
isLast])
            [FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeVarChunk
-> CodeFuncChunk
-> [Argument]
-> CodeVarChunk
-> FunctionInterface
libMethodWithResult Name
siImp CodeVarChunk
interpolator CodeFuncChunk
getInterpState
              [] CodeVarChunk
curr,
            CodeExpr -> Step
appendCurrSol (CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
curr)]])],
    FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeVarChunk -> CodeFuncChunk -> [Argument] -> FunctionInterface
libMethod Name
foiImp CodeVarChunk
it CodeFuncChunk
integrate ([Name]
-> Name -> CodeVarChunk -> CodeFuncChunk -> ClassInfo -> Argument
customObjArg [Name
apacheImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
      Name
fode] "Class representing an ODE system" CodeVarChunk
ode CodeFuncChunk
odeCtor (Name -> [MethodInfo] -> ClassInfo
implementation Name
fode
        [CodeFuncChunk -> [Parameter] -> [Step] -> MethodInfo
constructorInfo CodeFuncChunk
odeCtor [] [],
        CodeFuncChunk
-> Name -> [Parameter] -> Name -> [Step] -> MethodInfo
methodInfo CodeFuncChunk
getDimension "returns the ODE system dimension"
          [] "dimension of the ODE system" [CodeExpr -> Step
fixedReturn (Integer -> CodeExpr
forall r. LiteralC r => Integer -> r
int 1)],
        CodeFuncChunk -> Name -> [Parameter] -> [Step] -> MethodInfo
methodInfoNoReturn CodeFuncChunk
computeDerivatives
          "function representation of an ODE system"
          [CodeVarChunk -> Parameter
lockedParam CodeVarChunk
t, Space -> Parameter
unnamedParam (Space -> Space
Array Space
Real), Space -> Parameter
unnamedParam (Space -> Space
Array Space
Real)]
          [Step
assignArrayIndex]]) Argument -> [Argument] -> [Argument]
forall a. a -> [a] -> [a]
:
      [Space -> Argument
inlineArg Space
Real, CodeVarChunk -> Argument
preDefinedArg CodeVarChunk
currVals, Space -> Argument
inlineArg Space
Real,
        CodeVarChunk -> Argument
preDefinedArg CodeVarChunk
currVals]),
    CodeVarChunk -> Step
assignSolFromObj CodeVarChunk
stepHandler]]

apacheODECall :: ODEInfo -> ExternalLibraryCall
apacheODECall :: ODEInfo -> ExternalLibraryCall
apacheODECall info :: ODEInfo
info = ExternalLibraryCall -> ExternalLibraryCall
externalLibCall [
  Int -> StepFill -> StepGroupFill
choiceStepFill (ODEMethod -> Int
forall p. Num p => ODEMethod -> p
chooseMethod (ODEMethod -> Int) -> ODEMethod -> Int
forall a b. (a -> b) -> a -> b
$ ODEOptions -> ODEMethod
solveMethod (ODEOptions -> ODEMethod) -> ODEOptions -> ODEMethod
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info) (StepFill -> StepGroupFill) -> StepFill -> StepGroupFill
forall a b. (a -> b) -> a -> b
$ FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$
    [ArgumentFill] -> FunctionIntFill
libCallFill (((ODEOptions -> CodeExpr) -> ArgumentFill)
-> [ODEOptions -> CodeExpr] -> [ArgumentFill]
forall a b. (a -> b) -> [a] -> [b]
map (CodeExpr -> ArgumentFill
basicArgFill (CodeExpr -> ArgumentFill)
-> ((ODEOptions -> CodeExpr) -> CodeExpr)
-> (ODEOptions -> CodeExpr)
-> ArgumentFill
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info)) [ODEOptions -> CodeExpr
stepSize, ODEOptions -> CodeExpr
stepSize, ODEOptions -> CodeExpr
absTol, ODEOptions -> CodeExpr
relTol]),
  [StepFill] -> StepGroupFill
mandatoryStepsFill [FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill [
      [StateVariable] -> ClassInfoFill -> ArgumentFill
customObjArgFill [CodeVarChunk -> StateVariable
pubStateVar (CodeVarChunk -> StateVariable) -> CodeVarChunk -> StateVariable
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info] ([MethodInfoFill] -> ClassInfoFill
implementationFill [
        [ParameterFill] -> [StepFill] -> MethodInfoFill
methodInfoFill [] [CodeVarChunk -> StepFill
initSolListFromArrayFill (CodeVarChunk -> StepFill) -> CodeVarChunk -> StepFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info], [ParameterFill] -> [StepFill] -> MethodInfoFill
methodInfoFill []
          [FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill [], CodeVarChunk -> StepFill
appendCurrSolFill (CodeVarChunk -> StepFill) -> CodeVarChunk -> StepFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info]])],
    FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill ([ArgumentFill] -> FunctionIntFill)
-> [ArgumentFill] -> FunctionIntFill
forall a b. (a -> b) -> a -> b
$ [StateVariable] -> ClassInfoFill -> ArgumentFill
customObjArgFill
      ((CodeVarChunk -> StateVariable)
-> [CodeVarChunk] -> [StateVariable]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> StateVariable
privStateVar ([CodeVarChunk] -> [StateVariable])
-> [CodeVarChunk] -> [StateVariable]
forall a b. (a -> b) -> a -> b
$ ODEInfo -> [CodeVarChunk]
otherVars ODEInfo
info)
      ([MethodInfoFill] -> ClassInfoFill
implementationFill [
        [ParameterFill] -> [Initializer] -> [StepFill] -> MethodInfoFill
constructorInfoFill ((CodeVarChunk -> ParameterFill)
-> [CodeVarChunk] -> [ParameterFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterFill
userDefinedParamFill ([CodeVarChunk] -> [ParameterFill])
-> [CodeVarChunk] -> [ParameterFill]
forall a b. (a -> b) -> a -> b
$ ODEInfo -> [CodeVarChunk]
otherVars ODEInfo
info)
          ([CodeVarChunk] -> [CodeExpr] -> [Initializer]
forall a b. [a] -> [b] -> [(a, b)]
zip (ODEInfo -> [CodeVarChunk]
otherVars ODEInfo
info) ((CodeVarChunk -> CodeExpr) -> [CodeVarChunk] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ([CodeVarChunk] -> [CodeExpr]) -> [CodeVarChunk] -> [CodeExpr]
forall a b. (a -> b) -> a -> b
$ ODEInfo -> [CodeVarChunk]
otherVars ODEInfo
info)) [],
        [ParameterFill] -> [StepFill] -> MethodInfoFill
methodInfoFill [] [StepFill
fixedStatementFill],
        [ParameterFill] -> [StepFill] -> MethodInfoFill
methodInfoFill ((CodeVarChunk -> ParameterFill)
-> [CodeVarChunk] -> [ParameterFill]
forall a b. (a -> b) -> [a] -> [b]
map (CodeVarChunk -> ParameterFill
unnamedParamFill (CodeVarChunk -> ParameterFill)
-> (CodeVarChunk -> CodeVarChunk) -> CodeVarChunk -> ParameterFill
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> CodeVarChunk
listToArray) [ODEInfo -> CodeVarChunk
depVar ODEInfo
info, CodeVarChunk
ddep])
          [CodeVarChunk -> [CodeExpr] -> StepFill
assignArrayIndexFill (CodeVarChunk -> CodeVarChunk
listToArray CodeVarChunk
ddep) (Name -> ODEInfo -> [CodeExpr]
modifiedODESyst "array" ODEInfo
info)]])
      ArgumentFill -> [ArgumentFill] -> [ArgumentFill]
forall a. a -> [a] -> [a]
: (CodeExpr -> ArgumentFill) -> [CodeExpr] -> [ArgumentFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> ArgumentFill
basicArgFill [ODEInfo -> CodeExpr
tInit ODEInfo
info, [[CodeExpr]] -> CodeExpr
forall r. ExprC r => [[r]] -> r
matrix [[ODEInfo -> CodeExpr
initVal ODEInfo
info]], ODEInfo -> CodeExpr
tFinal ODEInfo
info,
        [[CodeExpr]] -> CodeExpr
forall r. ExprC r => [[r]] -> r
matrix [[ODEInfo -> CodeExpr
initVal ODEInfo
info]]],
    CodeVarChunk -> StepFill
assignSolFromObjFill (CodeVarChunk -> StepFill) -> CodeVarChunk -> StepFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info]]
  where chooseMethod :: ODEMethod -> p
chooseMethod Adams = 0
        chooseMethod RK45 = 1
        chooseMethod _ = Name -> p
forall a. HasCallStack => Name -> a
error Name
odeMethodUnavailable
        ddep :: CodeVarChunk
ddep = CodeVarChunk -> CodeVarChunk
diffCodeChunk (CodeVarChunk -> CodeVarChunk) -> CodeVarChunk -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info

itArgs :: [Argument]
itArgs :: [Argument]
itArgs = (Space -> Argument) -> [Space] -> [Argument]
forall a b. (a -> b) -> [a] -> [b]
map Space -> Argument
inlineArg [Space
Real, Space
Real, Space
Real, Space
Real]

apacheImport, adams, dp54, foi, foiImp, sampling, sh, shImp, si, siImp, fode :: String
apacheImport :: Name
apacheImport = "org.apache.commons.math3.ode."
adams :: Name
adams = "AdamsBashforthIntegrator"
dp54 :: Name
dp54 = "DormandPrince54Integrator"
foi :: Name
foi = "FirstOrderIntegrator"
foiImp :: Name
foiImp = Name
apacheImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
foi
sampling :: Name
sampling = "sampling"
sh :: Name
sh = "StepHandler"
shImp :: Name
shImp = Name
apacheImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sampling Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "." Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sh
si :: Name
si = "StepInterpolator"
siImp :: Name
siImp = Name
apacheImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sampling Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "." Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
si
fode :: Name
fode = "FirstOrderDifferentialEquations"

-- | Collects variables needed for Apache's ODEs as 'QuantityDict's.
apacheODESymbols :: [QuantityDict]
apacheODESymbols :: [QuantityDict]
apacheODESymbols = (CodeVarChunk -> QuantityDict) -> [CodeVarChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [CodeVarChunk
it, CodeVarChunk
currVals, CodeVarChunk
stepHandler, CodeVarChunk
t0, CodeVarChunk
y0, CodeVarChunk
t, CodeVarChunk
interpolator,
  CodeVarChunk
isLast, CodeVarChunk
curr, CodeVarChunk
ode] [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ (CodeFuncChunk -> QuantityDict)
-> [CodeFuncChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map CodeFuncChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [CodeFuncChunk
adamsC, CodeFuncChunk
dp54C, CodeFuncChunk
stepHandlerCtor, CodeFuncChunk
addStepHandler,
  CodeFuncChunk
initMethod, CodeFuncChunk
handleStep, CodeFuncChunk
getInterpState, CodeFuncChunk
integrate, CodeFuncChunk
odeCtor, CodeFuncChunk
getDimension,
  CodeFuncChunk
computeDerivatives]

it, currVals, stepHandler, t0, y0, interpolator, isLast, curr :: CodeVarChunk
it :: CodeVarChunk
it = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "it_apache" (Name -> Name -> NP
nounPhrase "integrator for solving ODEs"
  "integrators for solving ODEs") (Name -> Space
Actor Name
foi) (Name -> Symbol
label "it")
currVals :: CodeVarChunk
currVals = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "curr_vals_apache" (Name -> Name -> NP
nounPhrase
  "array holding ODE solution values for the current step"
  "arrays holding ODE solution values for the current step")
  (Space -> Space
Array Space
Real) (Name -> Symbol
label "curr_vals")
stepHandler :: CodeVarChunk
stepHandler = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "stepHandler_apache" (Name -> Name -> NP
nounPhrase
  "ODE step handler" "ODE step handlers") (Name -> Space
Actor (Name -> Space) -> Name -> Space
forall a b. (a -> b) -> a -> b
$ "ODE" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sh)
  (Name -> Symbol
label "stepHandler")
t0 :: CodeVarChunk
t0 = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "t0_apache" (Name -> Name -> NP
nounPhrase "initial time for ODE solving"
  "intial times for ODE solving") Space
Real (Name -> Symbol
label "t0")
y0 :: CodeVarChunk
y0 = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "y0_apache" (Name -> Name -> NP
nounPhrase
  "array of initial values for ODE solving"
  "arrays of initial values for ODE solving") (Space -> Space
Array Space
Real) (Name -> Symbol
label "y0")
interpolator :: CodeVarChunk
interpolator = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "interpolator_apache" (Name -> Name -> NP
nounPhrase
  "step interpolator for ODE solving" "step interpolator for ODE solving")
  (Name -> Space
Actor Name
si) (Name -> Symbol
label "interpolator")
isLast :: CodeVarChunk
isLast = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "isLast_apache" (Name -> Name -> NP
nounPhrase
  "boolean for whether the current step is the last step"
  "booleans for whether the current step is the last step")
  Space
Boolean (Name -> Symbol
label "isLast")
curr :: CodeVarChunk
curr = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "curr_apache" (Name -> Name -> NP
nounPhrase
  "ODE solution array for current step" "ODE solution arrays for current step")
  (Space -> Space
Array Space
Real) (Name -> Symbol
label "curr")

adamsC, dp54C, stepHandlerCtor, addStepHandler, initMethod, handleStep,
  getInterpState, integrate, getDimension, computeDerivatives :: CodeFuncChunk
adamsC :: CodeFuncChunk
adamsC = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "adams_ctor_apache" (Name -> Name -> NP
nounPhrase
  "constructor for an Adams-Bashforth integrator"
  "constructors for an Adams-Bashforth integrator") (Name -> Space
Actor Name
adams) (Name -> Symbol
Label Name
adams)
dp54C :: CodeFuncChunk
dp54C = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "dp54_ctor_apache" (Name -> Name -> NP
nounPhrase
  "constructor for a Dormand-Prince 5-4 integrator"
  "constructors for a Dormand-Prince 5-4 integrator")
  (Name -> Space
Actor Name
dp54) (Name -> Symbol
Label Name
dp54)
stepHandlerCtor :: CodeFuncChunk
stepHandlerCtor = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "StepHandler_ctor_apache" (Name -> Name -> NP
nounPhrase
  "constructor for StepHandler" "constructors for StepHandler")
  (Name -> Space
Actor (Name -> Space) -> Name -> Space
forall a b. (a -> b) -> a -> b
$ "ODE" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sh) (Name -> Symbol
Label (Name -> Symbol) -> Name -> Symbol
forall a b. (a -> b) -> a -> b
$ "ODE" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sh)
addStepHandler :: CodeFuncChunk
addStepHandler = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "addStepHandler_apache" (Name -> Name -> NP
nounPhrase
  "method for adding a step handler to an integrator"
  "methods for adding a step handler to an integrator")
  Space
Void (Name -> Symbol
label "addStepHandler")
initMethod :: CodeFuncChunk
initMethod = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "init_apache" (Name -> Name -> NP
nounPhrase
  "method to initialize step handler" "methods to initialize step handler")
  Space
Void (Name -> Symbol
label "init")
handleStep :: CodeFuncChunk
handleStep = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "handleStep_apache" (Name -> Name -> NP
nounPhrase
  "method to call at each ODE step" "methods to call at each ODE step")
  Space
Void (Name -> Symbol
label "handleStep")
getInterpState :: CodeFuncChunk
getInterpState = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "getInterpolatedState_apache" (Name -> Name -> NP
nounPhrase
  "method for getting current state during ODE solving"
  "methods for getting current state during ODE solving")
  (Space -> Space
Array Space
Real) (Name -> Symbol
label "getInterpolatedState")
integrate :: CodeFuncChunk
integrate = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "integrate_apache" (Name -> Name -> NP
nounPhrase
  "method for integrating an ODE" "methods for integrating an ODE")
  Space
Void (Name -> Symbol
label "integrate")
getDimension :: CodeFuncChunk
getDimension = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "getDimension_apache" (Name -> Name -> NP
nounPhrase
  "method returning the dimension of an ODE system"
  "methods returning the dimension of an ODE system")
  Space
Natural (Name -> Symbol
label "getDimension")
computeDerivatives :: CodeFuncChunk
computeDerivatives = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "computeDerivatives_apache" (Name -> Name -> NP
nounPhrase
  "method encoding an ODE system" "methods encoding an ODE system")
  Space
Void (Name -> Symbol
label "computeDerivatives")

-- odeint (C++)

-- | [odeint](https://headmyshoulder.github.io/odeint-v2/) ODE library package.
odeintPckg :: ODELibPckg
odeintPckg :: ODELibPckg
odeintPckg = Name
-> Name
-> ExternalLibrary
-> (ODEInfo -> ExternalLibraryCall)
-> Name
-> [Lang]
-> ODELibPckg
mkODELib "odeint" "v2" ExternalLibrary
odeint ODEInfo -> ExternalLibraryCall
odeintCall "." [Lang
Cpp]

odeint :: ExternalLibrary
odeint :: ExternalLibrary
odeint = ExternalLibrary -> ExternalLibrary
externalLib [
  [[Step]] -> StepGroup
choiceSteps [
    [FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libConstructor (Name
odeintImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "/stepper/runge_kutta_dopri5") CodeFuncChunk
rkdp5C [] CodeVarChunk
rk,
    FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libFunctionWithResult (Name
odeintImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "/stepper/generation") CodeFuncChunk
makeControlled
      [Space -> Argument
inlineArg Space
Real, Space -> Argument
inlineArg Space
Real, CodeExpr -> Argument
lockedArg (CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
rk)] CodeVarChunk
stepper],
    [FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libConstructor (Name
odeintImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "/stepper/adams_bashforth") CodeFuncChunk
adamsBashC [] CodeVarChunk
stepper]],
  Step -> StepGroup
mandatoryStep (Step -> StepGroup) -> Step -> StepGroup
forall a b. (a -> b) -> a -> b
$ FunctionInterface -> Step
callStep (FunctionInterface -> Step) -> FunctionInterface -> Step
forall a b. (a -> b) -> a -> b
$ Name -> CodeFuncChunk -> [Argument] -> FunctionInterface
libFunction (Name
odeintImport Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "/integrate/integrate_const")
    CodeFuncChunk
integrateConst [
      CodeExpr -> Argument
lockedArg (CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
stepper),
      [Name]
-> Name -> CodeVarChunk -> CodeFuncChunk -> ClassInfo -> Argument
customObjArg [] "Class representing an ODE system" CodeVarChunk
ode CodeFuncChunk
odeCtor
        ([MethodInfo] -> ClassInfo
customClass [CodeFuncChunk -> [Parameter] -> [Step] -> MethodInfo
constructorInfo CodeFuncChunk
odeCtor [] [],
          CodeFuncChunk -> Name -> [Parameter] -> [Step] -> MethodInfo
methodInfoNoReturn CodeFuncChunk
odeOp "function representation of ODE system"
            [Space -> Parameter
unnamedParam (Space -> Space
Vect Space
Real), Space -> Parameter
unnamedParam (Space -> Space
Vect Space
Real), CodeVarChunk -> Parameter
lockedParam CodeVarChunk
t]
            [Step
assignArrayIndex]]),
      -- Need to declare variable holding initial value because odeint will update this variable at each step
      CodeVarChunk -> Argument
preDefinedArg CodeVarChunk
odeintCurrVals,
      Space -> Argument
inlineArg Space
Real, Space -> Argument
inlineArg Space
Real, Space -> Argument
inlineArg Space
Real,
      [Name]
-> Name -> CodeVarChunk -> CodeFuncChunk -> ClassInfo -> Argument
customObjArg []
        "Class for populating a list during an ODE solution process"
        CodeVarChunk
pop CodeFuncChunk
popCtor ([MethodInfo] -> ClassInfo
customClass [
          CodeFuncChunk -> [Parameter] -> [Step] -> MethodInfo
constructorInfo CodeFuncChunk
popCtor [Space -> Parameter
unnamedParam (Space -> Space
Vect Space
Real)] [],
          CodeFuncChunk -> Name -> [Parameter] -> [Step] -> MethodInfo
methodInfoNoReturn CodeFuncChunk
popOp
            "appends solution point for current ODE solution step"
            [CodeVarChunk -> Parameter
lockedParam CodeVarChunk
y, CodeVarChunk -> Parameter
lockedParam CodeVarChunk
t] [CodeExpr -> Step
appendCurrSol (CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
y)]])]]

odeintCall :: ODEInfo -> ExternalLibraryCall
odeintCall :: ODEInfo -> ExternalLibraryCall
odeintCall info :: ODEInfo
info = ExternalLibraryCall -> ExternalLibraryCall
externalLibCall [
  (Int -> [StepFill] -> StepGroupFill)
-> (Int, [StepFill]) -> StepGroupFill
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> [StepFill] -> StepGroupFill
choiceStepsFill (ODEMethod -> (Int, [StepFill])
forall a. Num a => ODEMethod -> (a, [StepFill])
chooseMethod (ODEMethod -> (Int, [StepFill])) -> ODEMethod -> (Int, [StepFill])
forall a b. (a -> b) -> a -> b
$ ODEOptions -> ODEMethod
solveMethod (ODEOptions -> ODEMethod) -> ODEOptions -> ODEMethod
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info),
  StepFill -> StepGroupFill
mandatoryStepFill (StepFill -> StepGroupFill) -> StepFill -> StepGroupFill
forall a b. (a -> b) -> a -> b
$ FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill ([ArgumentFill] -> FunctionIntFill)
-> [ArgumentFill] -> FunctionIntFill
forall a b. (a -> b) -> a -> b
$
    [StateVariable] -> ClassInfoFill -> ArgumentFill
customObjArgFill ((CodeVarChunk -> StateVariable)
-> [CodeVarChunk] -> [StateVariable]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> StateVariable
privStateVar ([CodeVarChunk] -> [StateVariable])
-> [CodeVarChunk] -> [StateVariable]
forall a b. (a -> b) -> a -> b
$ ODEInfo -> [CodeVarChunk]
otherVars ODEInfo
info) ([MethodInfoFill] -> ClassInfoFill
customClassFill [
      [ParameterFill] -> [Initializer] -> [StepFill] -> MethodInfoFill
constructorInfoFill ((CodeVarChunk -> ParameterFill)
-> [CodeVarChunk] -> [ParameterFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterFill
userDefinedParamFill ([CodeVarChunk] -> [ParameterFill])
-> [CodeVarChunk] -> [ParameterFill]
forall a b. (a -> b) -> a -> b
$ ODEInfo -> [CodeVarChunk]
otherVars ODEInfo
info)
        ([CodeVarChunk] -> [CodeExpr] -> [Initializer]
forall a b. [a] -> [b] -> [(a, b)]
zip (ODEInfo -> [CodeVarChunk]
otherVars ODEInfo
info) ((CodeVarChunk -> CodeExpr) -> [CodeVarChunk] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy ([CodeVarChunk] -> [CodeExpr]) -> [CodeVarChunk] -> [CodeExpr]
forall a b. (a -> b) -> a -> b
$ ODEInfo -> [CodeVarChunk]
otherVars ODEInfo
info)) [],
      [ParameterFill] -> [StepFill] -> MethodInfoFill
methodInfoFill [CodeVarChunk -> ParameterFill
unnamedParamPBVFill (CodeVarChunk -> ParameterFill) -> CodeVarChunk -> ParameterFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info, CodeVarChunk -> ParameterFill
unnamedParamFill CodeVarChunk
ddep]
        [CodeVarChunk -> [CodeExpr] -> StepFill
assignArrayIndexFill CodeVarChunk
ddep (ODEInfo -> [CodeExpr]
odeSyst ODEInfo
info)]]) ArgumentFill -> [ArgumentFill] -> [ArgumentFill]
forall a. a -> [a] -> [a]
:
    (CodeExpr -> ArgumentFill) -> [CodeExpr] -> [ArgumentFill]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> ArgumentFill
basicArgFill [[[CodeExpr]] -> CodeExpr
forall r. ExprC r => [[r]] -> r
matrix [[ODEInfo -> CodeExpr
initVal ODEInfo
info]], ODEInfo -> CodeExpr
tInit ODEInfo
info, ODEInfo -> CodeExpr
tFinal ODEInfo
info,
      ODEOptions -> CodeExpr
stepSize (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info] [ArgumentFill] -> [ArgumentFill] -> [ArgumentFill]
forall a. [a] -> [a] -> [a]
++ [
    [StateVariable] -> ClassInfoFill -> ArgumentFill
customObjArgFill [CodeVarChunk -> StateVariable
privStateVar (CodeVarChunk -> StateVariable) -> CodeVarChunk -> StateVariable
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info] ([MethodInfoFill] -> ClassInfoFill
customClassFill [
      [ParameterFill] -> [Initializer] -> [StepFill] -> MethodInfoFill
constructorInfoFill [CodeVarChunk -> ParameterFill
unnamedParamFill (CodeVarChunk -> ParameterFill) -> CodeVarChunk -> ParameterFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info]
        [(ODEInfo -> CodeVarChunk
depVar ODEInfo
info, CodeVarChunk -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy (CodeVarChunk -> CodeExpr) -> CodeVarChunk -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info)] [],
      [ParameterFill] -> [StepFill] -> MethodInfoFill
methodInfoFill [] [CodeVarChunk -> StepFill
appendCurrSolFill (CodeVarChunk -> StepFill) -> CodeVarChunk -> StepFill
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info]])]]
  where chooseMethod :: ODEMethod -> (a, [StepFill])
chooseMethod RK45 = (0, ([CodeExpr] -> StepFill) -> [[CodeExpr]] -> [StepFill]
forall a b. (a -> b) -> [a] -> [b]
map (FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill)
-> ([CodeExpr] -> FunctionIntFill) -> [CodeExpr] -> StepFill
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ArgumentFill] -> FunctionIntFill
libCallFill ([ArgumentFill] -> FunctionIntFill)
-> ([CodeExpr] -> [ArgumentFill]) -> [CodeExpr] -> FunctionIntFill
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeExpr -> ArgumentFill) -> [CodeExpr] -> [ArgumentFill]
forall a b. (a -> b) -> [a] -> [b]
map
          CodeExpr -> ArgumentFill
basicArgFill) [[], [ODEOptions -> CodeExpr
absTol (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info, ODEOptions -> CodeExpr
relTol (ODEOptions -> CodeExpr) -> ODEOptions -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> ODEOptions
odeOpts ODEInfo
info]])
        chooseMethod Adams = (1, [FunctionIntFill -> StepFill
callStepFill (FunctionIntFill -> StepFill) -> FunctionIntFill -> StepFill
forall a b. (a -> b) -> a -> b
$ [ArgumentFill] -> FunctionIntFill
libCallFill []])
        chooseMethod _ = Name -> (a, [StepFill])
forall a. HasCallStack => Name -> a
error Name
odeMethodUnavailable
        ddep :: CodeVarChunk
ddep = CodeVarChunk -> CodeVarChunk
diffCodeChunk (CodeVarChunk -> CodeVarChunk) -> CodeVarChunk -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info

odeintImport, odeNameSpace, rkdp5, adamsBash :: String
odeintImport :: Name
odeintImport = "boost/numeric/odeint"
odeNameSpace :: Name
odeNameSpace = "boost::numeric::odeint::"
rkdp5 :: Name
rkdp5 = Name
odeNameSpace Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "runge_kutta_dopri5<vector<double>>"
adamsBash :: Name
adamsBash = Name
odeNameSpace Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "adams_bashforth<3,vector<double>>"

popT :: Space
popT :: Space
popT = Name -> Space
Actor "Populate"

-- | Collects variables needed for odeint's ODEs as 'QuantityDict's.
odeintSymbols :: [QuantityDict]
odeintSymbols :: [QuantityDict]
odeintSymbols = (CodeVarChunk -> QuantityDict) -> [CodeVarChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw [CodeVarChunk
odeintCurrVals, CodeVarChunk
rk, CodeVarChunk
stepper, CodeVarChunk
pop, CodeVarChunk
t, CodeVarChunk
y, CodeVarChunk
ode] [QuantityDict] -> [QuantityDict] -> [QuantityDict]
forall a. [a] -> [a] -> [a]
++ (CodeFuncChunk -> QuantityDict)
-> [CodeFuncChunk] -> [QuantityDict]
forall a b. (a -> b) -> [a] -> [b]
map CodeFuncChunk -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw
  [CodeFuncChunk
rkdp5C, CodeFuncChunk
makeControlled, CodeFuncChunk
adamsBashC, CodeFuncChunk
integrateConst, CodeFuncChunk
odeCtor, CodeFuncChunk
odeOp, CodeFuncChunk
popCtor,
  CodeFuncChunk
popOp]

odeintCurrVals, rk, stepper, pop :: CodeVarChunk
odeintCurrVals :: CodeVarChunk
odeintCurrVals = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "currVals_odeint" (Name -> Name -> NP
nounPhrase
  "vector holding ODE solution values for the current step"
  "vectors holding ODE solution values for the current step")
  (Space -> Space
Vect Space
Real) (Name -> Symbol
label "currVals")
rk :: CodeVarChunk
rk = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "rk_odeint" (Name -> Name -> NP
nounPhrase
  "stepper for solving ODE system using Runge-Kutta-Dopri5 method"
  "steppers for solving ODE system using Runge-Kutta-Dopri5 method")
  (Name -> Space
Actor Name
rkdp5) (Name -> Symbol
label "rk")
stepper :: CodeVarChunk
stepper = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "stepper_odeint" (Name -> Name -> NP
nounPhrase
  "stepper for solving ODE system" "steppers for solving ODE system")
  (Name -> Space
Actor "auto") (Name -> Symbol
label "stepper")
pop :: CodeVarChunk
pop = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "pop_odeint" (Name -> Name -> NP
nounPhrase
  "object to populate ODE solution vector"
  "objects to populate ODE solution vector") Space
popT (Name -> Symbol
label "pop")

rkdp5C, makeControlled, adamsBashC, integrateConst, odeOp, popCtor,
  popOp :: CodeFuncChunk
rkdp5C :: CodeFuncChunk
rkdp5C = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "rkdp5_odeint" (Name -> Name -> NP
nounPhrase
  "constructor for stepper using Runge-Kutta-Dopri5 method"
  "constructors for stepper using Runge-Kutta-Dopri5 method")
  (Name -> Space
Actor Name
rkdp5) (Name -> Symbol
Label Name
rkdp5)
makeControlled :: CodeFuncChunk
makeControlled = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "make_controlled_odeint" (Name -> Name -> NP
nounPhrase
  "function for adding error control to a stepper"
  "functions for adding error control to a stepper")
  (Name -> Space
Actor "auto") (Name -> Symbol
Label (Name -> Symbol) -> Name -> Symbol
forall a b. (a -> b) -> a -> b
$ Name
odeNameSpace Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "make_controlled")
adamsBashC :: CodeFuncChunk
adamsBashC = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "adamsBash_odeint" (Name -> Name -> NP
nounPhrase
  "constructor for stepper using Adams-Bashforth method"
  "constructors for stepper using Adams-Bashforth method")
  (Name -> Space
Actor Name
adamsBash) (Name -> Symbol
Label Name
adamsBash)
integrateConst :: CodeFuncChunk
integrateConst = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "integrate_const_odeint" (Name -> Name -> NP
nounPhrase
  "function for integrating with a constant step size"
  "functions for integrating with a constant step size")
  Space
Void (Name -> Symbol
Label (Name -> Symbol) -> Name -> Symbol
forall a b. (a -> b) -> a -> b
$ Name
odeNameSpace Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "integrate_const")
odeOp :: CodeFuncChunk
odeOp = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "ode_operator_odeint" (Name -> Name -> NP
nounPhrase
  "method defining override for calling ODE object"
  "methods defining override for calling ODE object") Space
Void
  (Name -> Symbol
label "operator()")
popCtor :: CodeFuncChunk
popCtor = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "Populate_odeint" (Name -> Name -> NP
nounPhrase
  "constructor for Populate object for ODE solving with odeint"
  "constructors for Populate object for ODE solving with odeint")
  Space
popT (Name -> Symbol
label "Populate")
popOp :: CodeFuncChunk
popOp = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "pop_operator_odeint" (Name -> Name -> NP
nounPhrase
  "method defining override for calling Populate object"
  "methods defining override for calling Populate object") Space
Void
  (Name -> Symbol
label "operator()")

-- 'CodeChunk's used in multiple external ODE libraries

ode, t, y :: CodeVarChunk
-- | ODE object & definition.
ode :: CodeVarChunk
ode = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "ode_obj" (Name -> Name -> NP
nounPhrase
  "object representing an ODE system" "objects representing an ODE system")
  Space
odeObj (Name -> Symbol
label "ode")
-- | Independent variable in an ODE.
t :: CodeVarChunk
t = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "t_ode" (Name -> Name -> NP
nounPhrase
  "current independent variable value in ODE solution"
  "current independent variable value in ODE solution")
  Space
Real (Name -> Symbol
label "t")
-- | Dependent variable in an ODE.
y :: CodeVarChunk
y = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "y_ode" (Name -> Name -> NP
nounPhrase
  "current dependent variable value in ODE solution"
  "current dependent variable value in ODE solution")
  (Space -> Space
Vect Space
Real) (Name -> Symbol
label "y")

-- | ODE object constructor.
odeCtor :: CodeFuncChunk
odeCtor :: CodeFuncChunk
odeCtor = QuantityDict -> CodeFuncChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeFuncChunk
quantfunc (QuantityDict -> CodeFuncChunk) -> QuantityDict -> CodeFuncChunk
forall a b. (a -> b) -> a -> b
$ Name -> NP -> Space -> Symbol -> QuantityDict
implVar "ODE_constructor" (Name -> Name -> NP
nounPhrase
  "constructor for ODE object" "constructors for ODE object") Space
odeObj
  (Name -> Symbol
label "ODE")

-- | ODE object.
odeObj :: Space
odeObj :: Space
odeObj = Name -> Space
Actor "ODE"

-- | ODE method unavailable message.
odeMethodUnavailable :: String
odeMethodUnavailable :: Name
odeMethodUnavailable = "Chosen ODE solving method is not available" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
          " in chosen ODE solving library"

-- | Change in @X@ chunk constructor (where @X@ is a given argument).
diffCodeChunk :: CodeVarChunk -> CodeVarChunk
diffCodeChunk :: CodeVarChunk -> CodeVarChunk
diffCodeChunk c :: CodeVarChunk
c = QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (QuantityDict -> CodeVarChunk) -> QuantityDict -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$ UID
-> NP
-> Maybe Name
-> Space
-> Symbol
-> Maybe UnitDefn
-> QuantityDict
implVarUID' (CodeVarChunk
c CodeVarChunk -> Name -> UID
forall a. HasUID a => a -> Name -> UID
+++ "d" )
  (NP -> NP -> NP
forall a b. (NounPhrase a, NounPhrase b) => a -> b -> NP
compoundPhrase (Name -> NP
nounPhraseSP "change in") (CodeVarChunk
c CodeVarChunk -> Getting NP CodeVarChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP CodeVarChunk NP
forall c. NamedIdea c => Lens' c NP
term)) (CodeVarChunk -> Maybe Name
forall c. Idea c => c -> Maybe Name
getA CodeVarChunk
c) (CodeVarChunk
c CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Lens' c Space
typ)
  ([Symbol] -> Symbol
Concat [Name -> Symbol
label "d", CodeVarChunk -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol CodeVarChunk
c Stage
Implementation]) (CodeVarChunk -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit CodeVarChunk
c)

-- FIXME: This is surely a hack, but I can't think of a better way right now.
-- | Some libraries use an array instead of a list to internally represent the ODE.
-- So we need a way to switch the dependent variable from list to array,
-- and the array version must have a distinct UID so it can be stored in the DB.
modifiedODESyst :: String -> ODEInfo -> [CodeExpr]
modifiedODESyst :: Name -> ODEInfo -> [CodeExpr]
modifiedODESyst sufx :: Name
sufx info :: ODEInfo
info = (CodeExpr -> CodeExpr) -> [CodeExpr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> CodeExpr
replaceDepVar (ODEInfo -> [CodeExpr]
odeSyst ODEInfo
info)
  where
    replaceDepVar :: CodeExpr -> CodeExpr
replaceDepVar cc :: CodeExpr
cc@(C c :: UID
c) | UID
c UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== ODEInfo -> CodeVarChunk
depVar ODEInfo
info CodeVarChunk -> Getting UID CodeVarChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeVarChunk UID
forall c. HasUID c => Lens' c UID
uid = UID -> CodeExpr
C (UID -> CodeExpr) -> UID -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ODEInfo -> CodeVarChunk
depVar ODEInfo
info CodeVarChunk -> Name -> UID
forall a. HasUID a => a -> Name -> UID
+++ ("_" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sufx)
                           | Bool
otherwise               = CodeExpr
cc
    replaceDepVar (AssocA a :: AssocArithOper
a es :: [CodeExpr]
es)           = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA AssocArithOper
a ((CodeExpr -> CodeExpr) -> [CodeExpr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> CodeExpr
replaceDepVar [CodeExpr]
es)
    replaceDepVar (AssocB b :: AssocBoolOper
b es :: [CodeExpr]
es)           = AssocBoolOper -> [CodeExpr] -> CodeExpr
AssocB AssocBoolOper
b ((CodeExpr -> CodeExpr) -> [CodeExpr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> CodeExpr
replaceDepVar [CodeExpr]
es)
    replaceDepVar (FCall u :: UID
u es :: [CodeExpr]
es nes :: [(UID, CodeExpr)]
nes)        = UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
FCall UID
u ((CodeExpr -> CodeExpr) -> [CodeExpr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> CodeExpr
replaceDepVar [CodeExpr]
es)
      (((UID, CodeExpr) -> (UID, CodeExpr))
-> [(UID, CodeExpr)] -> [(UID, CodeExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (UID, CodeExpr) (UID, CodeExpr) CodeExpr CodeExpr
-> (CodeExpr -> CodeExpr) -> (UID, CodeExpr) -> (UID, CodeExpr)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (UID, CodeExpr) (UID, CodeExpr) CodeExpr CodeExpr
forall s t a b. Field2 s t a b => Lens s t a b
_2 CodeExpr -> CodeExpr
replaceDepVar) [(UID, CodeExpr)]
nes)
    replaceDepVar (New u :: UID
u es :: [CodeExpr]
es nes :: [(UID, CodeExpr)]
nes)          = UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
New UID
u ((CodeExpr -> CodeExpr) -> [CodeExpr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> CodeExpr
replaceDepVar [CodeExpr]
es)
      (((UID, CodeExpr) -> (UID, CodeExpr))
-> [(UID, CodeExpr)] -> [(UID, CodeExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (UID, CodeExpr) (UID, CodeExpr) CodeExpr CodeExpr
-> (CodeExpr -> CodeExpr) -> (UID, CodeExpr) -> (UID, CodeExpr)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (UID, CodeExpr) (UID, CodeExpr) CodeExpr CodeExpr
forall s t a b. Field2 s t a b => Lens s t a b
_2 CodeExpr -> CodeExpr
replaceDepVar) [(UID, CodeExpr)]
nes)
    replaceDepVar (Message au :: UID
au mu :: UID
mu es :: [CodeExpr]
es nes :: [(UID, CodeExpr)]
nes)  = UID -> UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
Message UID
au UID
mu ((CodeExpr -> CodeExpr) -> [CodeExpr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> CodeExpr
replaceDepVar [CodeExpr]
es)
      (((UID, CodeExpr) -> (UID, CodeExpr))
-> [(UID, CodeExpr)] -> [(UID, CodeExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (UID, CodeExpr) (UID, CodeExpr) CodeExpr CodeExpr
-> (CodeExpr -> CodeExpr) -> (UID, CodeExpr) -> (UID, CodeExpr)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (UID, CodeExpr) (UID, CodeExpr) CodeExpr CodeExpr
forall s t a b. Field2 s t a b => Lens s t a b
_2 CodeExpr -> CodeExpr
replaceDepVar) [(UID, CodeExpr)]
nes)
    replaceDepVar (Case c :: Completeness
c cs :: [(CodeExpr, CodeExpr)]
cs)             = Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
Case Completeness
c (((CodeExpr, CodeExpr) -> (CodeExpr, CodeExpr))
-> [(CodeExpr, CodeExpr)] -> [(CodeExpr, CodeExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (CodeExpr, CodeExpr) (CodeExpr, CodeExpr) CodeExpr CodeExpr
-> (CodeExpr -> CodeExpr)
-> (CodeExpr, CodeExpr)
-> (CodeExpr, CodeExpr)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (CodeExpr, CodeExpr) (CodeExpr, CodeExpr) CodeExpr CodeExpr
forall s t a b. Field1 s t a b => Lens s t a b
_1 CodeExpr -> CodeExpr
replaceDepVar) [(CodeExpr, CodeExpr)]
cs)
    replaceDepVar (Matrix es :: [[CodeExpr]]
es)             = [[CodeExpr]] -> CodeExpr
Matrix ([[CodeExpr]] -> CodeExpr) -> [[CodeExpr]] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ([CodeExpr] -> [CodeExpr]) -> [[CodeExpr]] -> [[CodeExpr]]
forall a b. (a -> b) -> [a] -> [b]
map ((CodeExpr -> CodeExpr) -> [CodeExpr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map CodeExpr -> CodeExpr
replaceDepVar) [[CodeExpr]]
es
    replaceDepVar (UnaryOp u :: UFunc
u e :: CodeExpr
e)           = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
u (CodeExpr -> CodeExpr) -> CodeExpr -> CodeExpr
forall a b. (a -> b) -> a -> b
$ CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e
    replaceDepVar (UnaryOpB u :: UFuncB
u e :: CodeExpr
e)          = UFuncB -> CodeExpr -> CodeExpr
UnaryOpB UFuncB
u (CodeExpr -> CodeExpr) -> CodeExpr -> CodeExpr
forall a b. (a -> b) -> a -> b
$ CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e
    replaceDepVar (UnaryOpVV u :: UFuncVV
u e :: CodeExpr
e)         = UFuncVV -> CodeExpr -> CodeExpr
UnaryOpVV UFuncVV
u (CodeExpr -> CodeExpr) -> CodeExpr -> CodeExpr
forall a b. (a -> b) -> a -> b
$ CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e
    replaceDepVar (UnaryOpVN u :: UFuncVN
u e :: CodeExpr
e)         = UFuncVN -> CodeExpr -> CodeExpr
UnaryOpVN UFuncVN
u (CodeExpr -> CodeExpr) -> CodeExpr -> CodeExpr
forall a b. (a -> b) -> a -> b
$ CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e
    replaceDepVar (ArithBinaryOp b :: ArithBinOp
b e1 :: CodeExpr
e1 e2 :: CodeExpr
e2) = ArithBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ArithBinaryOp ArithBinOp
b
      (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e1) (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e2)
    replaceDepVar (BoolBinaryOp b :: BoolBinOp
b e1 :: CodeExpr
e1 e2 :: CodeExpr
e2)  = BoolBinOp -> CodeExpr -> CodeExpr -> CodeExpr
BoolBinaryOp BoolBinOp
b
      (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e1) (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e2)
    replaceDepVar (EqBinaryOp b :: EqBinOp
b e1 :: CodeExpr
e1 e2 :: CodeExpr
e2)    = EqBinOp -> CodeExpr -> CodeExpr -> CodeExpr
EqBinaryOp EqBinOp
b
      (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e1) (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e2)
    replaceDepVar (LABinaryOp b :: LABinOp
b e1 :: CodeExpr
e1 e2 :: CodeExpr
e2)    = LABinOp -> CodeExpr -> CodeExpr -> CodeExpr
LABinaryOp LABinOp
b
      (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e1) (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e2)
    replaceDepVar (OrdBinaryOp b :: OrdBinOp
b e1 :: CodeExpr
e1 e2 :: CodeExpr
e2)   = OrdBinOp -> CodeExpr -> CodeExpr -> CodeExpr
OrdBinaryOp OrdBinOp
b
      (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e1) (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e2)
    replaceDepVar (VVNBinaryOp b :: VVNBinOp
b e1 :: CodeExpr
e1 e2 :: CodeExpr
e2)   = VVNBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVNBinaryOp VVNBinOp
b
      (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e1) (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e2)
    replaceDepVar (VVVBinaryOp b :: VVVBinOp
b e1 :: CodeExpr
e1 e2 :: CodeExpr
e2)   = VVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVVBinaryOp VVVBinOp
b
      (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e1) (CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e2)
    replaceDepVar (Operator ao :: AssocArithOper
ao dd :: DiscreteDomainDesc CodeExpr CodeExpr
dd e :: CodeExpr
e)      = AssocArithOper
-> DiscreteDomainDesc CodeExpr CodeExpr -> CodeExpr -> CodeExpr
Operator AssocArithOper
ao DiscreteDomainDesc CodeExpr CodeExpr
dd (CodeExpr -> CodeExpr) -> CodeExpr -> CodeExpr
forall a b. (a -> b) -> a -> b
$ CodeExpr -> CodeExpr
replaceDepVar CodeExpr
e
    replaceDepVar e :: CodeExpr
e = CodeExpr
e