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)
}