using a time series of parameters to solve ODE in R

Question

I am trying to solve a simple ODE in R using deSolve: dQ/dt = f(Q)*(P - E).The whole thing is a time series of Q. The trick is that P and E are fixed time series of data themselves, so the diff eq is effectively in Q alone.

It's relatively straightforward to solve this iteratively with a fixed time step, but I am trying to find a way to use an adaptive time step in R. Because P and E are discrete, successive timesteps may have the same value of P and E, which is fine. I have been playing around with deSolve, but have not been able to work this out. Ideally I would like to use standard 4th order Runge-Kutta.

Any ideas? Do it in MATLAB?

Edited for reproduceable example. I would like to be able to do this calc with a variable time step Runge-Kutta 4 method. I could program a fixed time step rk4 pretty easily, not so much adaptive.

working <- structure(list(datetime = structure(c(1185915600, 1185919200, 
1185922800, 1185926400, 1185930000, 1185933600, 1185937200, 1185940800, 
1185944400, 1185948000, 1185951600), class = c("POSIXct", "POSIXt"
), tzone = "UTC"), p = c(0, 0, 0, 1.1, 0.5, 0.7, 0, 0, 1.3, 0, 
0), e = c(0.15, 0.14, 0.13, 0.21, 0.15, 0.1, 0.049, 0, 0, 0, 
0), qsim = c(-1.44604436552566, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA)), .Names = c("datetime", "p", "e", "qsim"), row.names = c(NA, 11L), 
class = "data.frame")


# this is the derivative function dQ/dt = f(Q,p,e) where p and e are time series
dqdt <- function(qsim, pcp, pet) {
  dq <- (qsim ^ 2) * ((pcp - pet) / qsim) 
  return(dq)
}

# loops through and calculates the Q at each time step using the Euler method
for (i in 1:(nrow(working) - 1)) {
  dq <- dqdt(working$qsim[i], pcp = working$p[i], pet = working$e[i])
  working$qsim[i + 1] <- working$qsim[i] + dq
}

Answer 1

Maybe not the most sophisticated approach, but the quick and dirty approach is to keep the time-dependent forcing variables as external (global) variables.

I use pmax(1,ceiling(t)) to convert from the time index to the row index of the data frame (the pmax is necessary if you want to start from t=0 because ceiling(0) is 0, and x[0] in R is generally an empty vector, which then breaks stuff). There are probably other ways to do the indexing.

library(deSolve)
gradfun <- function(t,y,parms) {
   pcp <- working$p[pmax(1,ceiling(t))]
   pet <- working$e[pmax(1,ceiling(t))]
   list(y^2*((pcp-pet)/y),NULL)
}

gradfun(0,working$qsim[1],1)   ## test
ode1 <- ode(y=c(qsim=working$qsim[1]),func=gradfun,
                time=seq(0,nrow(working),length.out=101),
                parms=NULL,method="rk4")
plot(ode1)

Answer 2

An alternative would be to develop a function to describe the time dependent forcing variables. If linear interpolation between the values is ok use something like:

pcp_F <- approxfun(0:nrow(working), c(0, working$p ), method = "linear")
pet_F <- approxfun(0:nrow(working), c(0.150, working$e ), method = "linear")

Or, change method to "constant", but test that you are using the values you expect for a given time index.

parameters <- NULL
state <- c(qsim = working$qsim[1])
times <- seq(0,nrow(working),length.out=101)

gradfun <- function(t, state, parameters) {
  with(as.list(c(state, parameters)),{
  # rate of change

  pcp <- pcp_F(t)
  pet <- pet_F(t)
  dq <- (qsim ^ 2) * ((pcp - pet) / qsim) 
  list(dq)
  })
}

out_de <- ode(y = state, times = times, func = gradfun, parms = parameters, method = "rk4")
plot(out_de)

Answer 3

Ben's solution can be improved by saving your vectors working$p and working$e in the "parameter" list that will be passed to the ODE. Instead of parameters <- NULL, do parameters2 <- list(vec1 = your_time_series, vec2 = your_other_time_series). Then:

gradfun <- function(t,y,parms) {
   pcp <- vec1[pmax(1,ceiling(t))]
   pet <- vec2[pmax(1,ceiling(t))]
   list(y^2*((pcp-pet)/y),NULL)
}

That way you don't have to relay in the external (global) variables, which can be a huge pain