求解R中的微分方程組

Question

我在R中有一個簡單的通量模型。它歸結為兩個微分方程，模擬模型中的兩個狀態變量，我們稱之為A和B 它們被計算為四分量通量flux1-flux4個參數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))
  })

我想寫一個函數來獲取關於of_interest的dAdt的導數，將導出的方程設置為0，然后重新排列並求解of_interest的值。 這將是最大化函數dAdt的參數of_interest的值。

到目前為止，我已經能夠在穩定狀態下解決模型，跨越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)

我該如何分析解決的價值of_interest最大化dAdt R中？ 如果無法獲得分析解決方案，我怎么知道，如何以數字方式解決這個問題呢？

更新：我認為這個問題可以通過R中的deSolve包解決，在這里鏈接，但是我在使用我的特定示例實現它時遇到了麻煩。

Answer 1

你在B(t)等式只是可分離的，因為你可以除去B(t) ，從中可以得到它

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

這是B(t)的隱式解，我們將逐點解決。

您可以根據B的初始值求解C 我想最初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)的行為，然后用它來弄清楚A(t)發生了什么，然后最大化。

一，“外”參數; 我們還需要nleqslv才能獲得B ：

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)

從這里開始，基本概要是：

1. 給定參數值（特別是ttheta ），通過非線性方程求解求解BB超過t_rng
2. 給定BB和參數值，通過數值積分求解AA超過t_rng
3. 鑒於AA和dAdt的表達式，插入和最大化。

deris < - sapply（tthetas，function（th）{#append current ttheta params < - c（parameters，ttheta = th）

#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進行矢量化而不是僅僅sapply ，這可以通過更直接地吸引BLAS來加速。
• 其他小東西的負荷。 預先計算ttheta * p1 * p3因為它被重復使用了很多，等等。

我沒有打擾包括任何這些東西，但是，因為你真的可能更好地將它移植到更快的語言 - Julia是我自己的寵物最喜歡的，但當然R與C ++，C，Fortran等說得很好。