求解R中的微分方程组

Question

我在R中有一个简单的通量模型。它归结为两个微分方程，模拟模型中的两个状态变量，我们称之为A和B。它们被计算为四分量通量flux1-flux4，5个参数p1-p5和第六个参数of_interest的简单差分方程，它们可以取0-1之间的值。

parameters<- c(p1=0.028, p2=0.3, p3=0.5, p4=0.0002, p5=0.001, of_interest=0.1) 
state     <- c(A=28, B=1.4)

model<-function(t,state,parameters){
  with(as.list(c(state,parameters)),{
  #fluxes
  flux1  = (1-of_interest) * p1*(B / (p2 + B))*p3
  flux2  = p4* A          #microbial death
  flux3  = of_interest * p1*(B / (p2 + B))*p3 
  flux4  = p5* B      

  #differential equations of component fluxes
  dAdt<- flux1 - flux2
  dBdt<- flux3 - flux4
  list(c(dAdt,dBdt))
  })

我想编写一个函数来获取dAdt相对于of_interest的导数，将导出的等式设置为0，然后重新排列并求解of_interest的值。这将是最大化函数of_interest的参数dAdt的值。

到目前为止，我已经能够在of_interest的可能值范围内以稳定状态求解模型，以证明应该存在最大值。

require(rootSolve)
range<- seq(0,1,by=0.01)
for(i in range){
of_interest=i
parameters<- c(p1=0.028, p2=0.3, p3=0.5, p4=0.0002, p5=0.001, of_interest=of_interest) 
state     <- c(A=28, B=1.4)
ST<- stode(y=y,func=model,parms=parameters,pos=T)
out<- c(out,ST$y[1])

然后绘图：

plot(out~range, pch=16,col='purple')
lines(smooth.spline(out~range,spar=0.35), lwd=3,lty=1)

如何以分析方式求解在R中最大化of_interest的{​​{1}}的值？如果无法获得分析解决方案，我怎么知道，以及如何以数字方式解决这个问题？

更新：我认为这个问题可以通过R中的deSolve包解决，链接here，但是我在使用我的特定示例时无法实现它。

Answer 1

B(t)中的公式只是可分离的，因为你可以将B(t)分开，从中可以得到

B(t) = C * exp{-p5 * t} * (p2 + B(t)) ^ {of_interest * p1 * p3}

这是B(t)的隐式解决方案，我们将逐点解决。

如果初始值为C，您可以求解B。我想最初是t = 0？在这种情况下

C = B_0 / (p2 + B_0) ^ {of_interest * p1 * p3}

这也为A(t)提供了一个更好看的表达式：

dA(t) / dt = B_0 / (p2 + B_0) * p1 * p3 * (1 - of_interest) *
   exp{-p5 * t} * ((p2 + B(t) / (p2 + B_0)) ^ 
   {of_interest * p1 * p3 - 1} - p4 * A(t)

这可以通过积分因子（= exp{p4 * t}），通过涉及B(t)的术语的数值积分来解决。我们将积分的下限指定为0，这样我们就不必在[0, t]范围之外评估B，这意味着积分常数只是A_0，因此：

A(t) = (A_0 + integral_0^t { f(tau; parameters) d tau}) * exp{-p4 * t}

基本要点是B(t)正在驱动这个系统中的所有内容 - 方法将是：解决B(t)的行为，然后使用它来弄清楚{{1}发生了什么然后最大化。

首先，“外部”参数;我们还需要A(t)才能获得nleqslv：

B

从这里开始，基本概要是：

1. 给定参数值（特别是library(nleqslv) t_min <- 0 t_max <- 10000 t_N <- 10 #we'll only solve the behavior of A & B over t_rng t_rng <- seq(t_min, t_max, length.out = t_N) #I'm calling of_interest ttheta ttheta_min <- 0 ttheta_max <- 1 ttheta_N <- 5 tthetas <- seq(ttheta_min, ttheta_max, length.out = ttheta_N) B_0 <- 1.4 A_0 <- 28 #No sense storing this as a vector when we'll only ever use it as a list parameters <- list(p1 = 0.028, p2 = 0.3, p3 = 0.5, p4 = 0.0002, p5 = 0.001) ），通过非线性方程求解求解ttheta超过BB
2. 给定t_rng和参数值，通过数值积分求解BB超过AA
3. 鉴于t_rng以及您对dAdt的表达，请插入＆amp;最大化。

衍生物＆lt; -   sapply（tthetas，function（th）{     #append current ttheta     params＆lt; - c（参数，ttheta = th）

AA

注意：

此代码未针对效率进行优化。有几个地方有一些潜在的加速：

• 可能更快地递归运行方程求解器，因为它会以更好的初始猜测收敛得更快 - 使用先前的值而不是初始值肯定更好
• 简单地使用黎曼总和进行整合会更快;权衡是准确的，但如果你有足够密集的网格应该没问题。黎曼的一个美妙之处在于你根本不需要插值，而在数值上它们是简单的线性代数。我用#declare a function we'll use to solve for B (see above) b_slv <- function(b, t) with(params, b - B_0 * ((p2 + b)/(p2 + B_0)) ^ (ttheta * p1 * p3) * exp(-p5 * t)) #solving point-wise (this is pretty fast) # **See below for a note** BB <- sapply(t_rng, function(t) nleqslv(B_0, function(b) b_slv(b, t))$x) #this is f(tau; params) that I mentioned above; # we have to do linear interpolation since the # numerical integrator isn't constrained to the grid. # **See below for note** a_int <- function(t){ #approximate t to the grid (t_rng) # (assumes B is monotonic, which seems to be true) # (also, if t ends up negative, just assign t_rng[1]) t_n <- max(1L, which.max(t_rng - t >= 0) - 1L) idx <- t_n:(t_n+1) ts <- t_rng[idx] #distance-weighted average of the local B values B_app <- sum((-1) ^ (0:1) * (t - ts) / diff(ts) * BB[idx]) #finally, f(tau; params) with(params, (1 - ttheta) * p1 * p3 * B_0 / (p2 + B_0) * ((p2 + B_app)/(p2 + B_0)) ^ (ttheta * p1 * p3 - 1) * exp((p4 - p5) * t)) } #a_int only works on scalars; the numeric integrator # requires a version that works on vectors a_int_v <- function(t) sapply(t, a_int) AA <- exp(-params$p4 * t_rng) * sapply(t_rng, function(tt) #I found the subdivisions constraint binding in some cases # at the default value; no trouble at 1000. A_0 + integrate(a_int_v, 0, tt, subdivisions = 1000L)$value) #using the explicit version of dAdt given as flux1 - flux2 max(with(params, (1 - ttheta) * p1 * p3 * BB / (p2 + BB) - p4 * AA))}) Finally, simply run `tthetas[which.max(derivs)]` to get the maximizer. 运行它，并在几分钟内运行。
• 可能直接对t_N == ttheta_N == 1000L进行矢量化，而不仅仅是a_int，这可以通过更直接地吸引BLAS来加快速度。
• 其他小东西。预计算sapply，因为它被重复使用等等。

我并不打算包括任何这些东西，因为你真的可能最好把它移植到更快的语言 - 朱莉娅是我自己的宠物最喜欢的，但当然R与C ++，C， Fortran等。