ODE，多根和事件，R

Question

我喜歡求解涉及多個閾值的耦合微分方程組。 瀏覽 R 信息，這使我將 ODE 與根函數和事件函數結合使用。

通過各種示例，即溫度模型，第 14 頁http://cran.r-project.org/web/packages/diffEq/vignettes/ODEinR.pdf -- 下面粘貼的代碼 --，我可以讓我的模型起作用在一個閾值上，即找到根/達到某個變量的閾值會觸發一個事件。

library(deSolve)
yini <- c(temp = 18, heating_on=1)

temp <- function(t,y, parms) {
  dy1 <- ifelse(y[2] == 1, 1.0, -0.5)
  dy2 <- 0
 list(c(dy1, dy2))
}

rootfunc <- function(t,y,parms) c(y[1]-18, y[1]-20)

eventfunc <- function(t,y,parms) {
  y[1] <- y[1]
  y[2] <- ! y[2]  
 return(y)
}

times <- seq(from=0, to=20, by=0.1)
out <- lsode(times=times, y=yini, func = temp, parms = NULL, 
         rootfun = rootfunc, events = list(func=eventfunc, root = TRUE))
plot(out, lwd=2)
attributes(out)$troot

該示例還顯示不同的根可以觸發相同的事件函數（y[1] – 18 和 y[1]-20 都觸發 eventfunc）。 然而，我的問題是，是否也有可能讓不同的根觸發不同的事件函數？ 換種說法，根據找到哪個root，觸發不同的eventfunc？ 或者，在同一個 eventfunct 中，它是否可以根據找到的根執行不同的操作。

為了簡單起見，我首先想看看這是否可以使用相同的示例工作，例如通過命名根和使用 if 語句？ 目前這不起作用。 有任何人對此有經驗嗎？ 如果您查看 attributes(out)，似乎 ODE 確實會記錄遇到 $indroot 的根目錄（但這是在評估之后。）在此先感謝您。

# library(deSolve)
yini <- c(temp = 18, heating_on=1)

temp <- function(t,y, parms) {
  dy1 <- ifelse(y[2] == 1, 1.0, -0.5)
  dy2 <- 0
 list(c(dy1, dy2))
}

rootfunc <- function(t,y,parms) {
  yroot <- vector(len = 2)
  yroot[1] <- y[1]-18 
  yroot[2] <- y[1]-20
 return(yroot)
}

eventfunc <- function(t,y, parms) {
  y[1] <- y[1]
  ifelse(yroot[2]==2, y[2] <- y[2], y[2] <- !y[2])
 return(y)
}

times <- seq(from=0, to=20,by=0.1)
out <- lsode(times=times, y=yini, func = temp, parms = NULL, 
         rootfun = rootfunc, events = list(func=eventfunc, root = TRUE))
plot(out, lwd=2)
attributes(out)$troot 

Answer 1

系統的狀態y在根函數和事件函數中都可用，因此可以作為觸發事件的條件。

對於更復雜的情況，當然也可以將事件從一個主事件函數分派到不同的函數中，以了解細節，同樣也可以檢查根條件。

感謝@Bakaburg 發現了這個有趣的懸而未決的問題。

這是一個也簡化了一些編程結構的解決方案：

library(deSolve)
yini <- c(temp = 18, heating_on = 1)

temp <- function(t,y, parms) {
  dy1 <- ifelse(y[2] == 1, 1.0, -0.5)
  dy2 <- 0
  list(c(dy1, dy2))
}

rootfunc <- function(t, y, parms) {
  yroot <- c(y[1] - 18, y[1] - 20)
  return(yroot)
}

eventfunc <- function(t, y, parms) {
  yroot <- c(y[1] - 18, y[1] - 20)
  whichroot <- which(abs(yroot) < 1e-6) # specify tolerance
  y[2] <- if(whichroot == 2) 0 else 1
  return(y)
}

times <- seq(from=0, to=20,by=0.1)
out <- lsode(times=times, y=yini, func = temp, parms = NULL, 
             rootfun = rootfunc, events = list(func=eventfunc, root = TRUE))
plot(out, lwd=2)

Answer 2

我通過在根中或直接在主函數中使用全局變量集來解決類似的問題（如果您基於克服特定方向的閾值來觸發它，則很有用。

全局標志然后改變事件函數的行為。

不是很優雅，但它的工作原理。

在您的情況下，代碼將變為：

trigger <- FALSE

rootfunc <- function(t,y,parms) {
  yroot <- vector(len = 2)
  yroot[1] <- y[1]-18 
  yroot[2] <- y[1]-20

  if (yroot[2] == 0) trigger <- TRUE

  return(yroot)
}

eventfunc <- function(t,y, parms) {
  y[1] <- y[1]
  if (trigger) y[2] <- y[2] else y[2] <- !y[2]
  return(y)
}