[R-sig-dyn-mod] deSolve events - different event functions at different times

[Thomas Petzoldt]

On 25.01.2013 16:27, Faelens Ruben wrote:

> @List: I am very open to alternative suggestions that depend less on
> the precision of the solver though...

Hi,

what about creating a dispatch function that decides between the two (or
more) events?

Have fun!

Thomas P.

##-- two events ---------------------------------------

library("deSolve")

## Derivative function
derivs <- function(t, v, parms) list(c(0, -0.5 * v[2]))

## events
event1 <- function(t, y, parms){
   cat("event1 at t=", t, "\n")
   with (as.list(y), {
     v1 <- v1 + 1
     v2 <- 5 * runif(1)
     return(c(v1, v2))
   })
}

event2 <- function(t, y, parms){
   cat("event2 at t=", t, "\n")
   with (as.list(y), {
     v1 <- v1 + 0.5 * v2
     v2 <- 5 * runif(1)
     return(c(v1, v2))
   })
}

etimes1 <- c(1, 3, 4, 5)
etimes2 <- c(2, 4, 6)
allevents <- sort(unique(c(etimes1, etimes2)))

dispatch <- function(t, y, parms) {
   ## important! conflict resolution
   ##   what if 2 events occur at the same time?
   ## here: use 2nd event
   ##   alternatives: add, average, randomize, ...
   ret <- y
   if (t %in% etimes1) ret <- event1(t, y, parms)
   if (t %in% etimes2) ret <- event2(t, y, parms)
   return(ret)
}

out <- ode(func = derivs,
   y = c(v1  = 1, v2 = 2),
   times = seq(0, 10, by=0.1),
   parms = NULL,
   events = list(func = dispatch, time = allevents))

plot(out)
abline(v=etimes1, col="blue", lty="dashed")
abline(v=etimes2, col="red", lty="dotted", lwd=2)