# NOT RUN {
## =============================================================================
## exercise 6 from Shampine and Thompson, 2000
## solving delay differential equations with dde23
##
## two lag values
## =============================================================================
##-----------------------------
## the derivative function
##-----------------------------
derivs <- function(t, y, parms) { 
  History <- function(t) c(cos(t), sin(t))
  if (t < 1)
    lag1 <- History(t - 1)[1]    
  else 
    lag1 <- lagvalue(t - 1)[1] # returns a vector; select first element
  if (t < 2)
    lag2 <- History(t - 2)[2]
  else 
    lag2 <- lagvalue(t - 2,2) # faster than lagvalue(t - 2)[2]
  dy1 <- lag1 * lag2
  dy2 <- -y[1] * lag2
  
  list(c(dy1, dy2), lag1 = lag1, lag2 = lag2)
}
##-----------------------------
## parameters
##-----------------------------
r <- 3.5; m <- 19
##-----------------------------
## initial values and times
##-----------------------------
yinit <- c(y1 = 0, y2 = 0)
times <- seq(0, 20, by = 0.01)
##-----------------------------
## solve the model  
##-----------------------------
yout <- dede(y = yinit, times = times, func = derivs,
  parms = NULL, atol = 1e-9)
##-----------------------------
## plot results
##-----------------------------
plot(yout, type = "l", lwd = 2)
## =============================================================================
## The predator-prey model with time lags, from Hale
## problem 1 from Shampine and Thompson, 2000
## solving delay differential equations with dde23
##
## a vector with lag valuess
## =============================================================================
##-----------------------------
## the derivative function
##-----------------------------
predprey <- function(t, y, parms) {
  tlag <- t - 1
  if (tlag < 0)
    ylag <- c(80, 30)
  else 
    ylag <- lagvalue(tlag)  # returns a vector
  
  dy1 <- a * y[1] * (1 - y[1]/m) + b * y[1] * y[2]
  dy2 <- c * y[2] + d * ylag[1] * ylag[2]
  list(c(dy1, dy2))
}
##-----------------------------
## parameters
##-----------------------------
a <- 0.25; b <- -0.01; c <- -1 ; d <- 0.01; m <- 200
##-----------------------------
## initial values and times
##-----------------------------
yinit <- c(y1 = 80, y2 = 30)
times <- seq(0, 100, by = 0.01)
#-----------------------------
# solve the model  
#-----------------------------
yout <- dede(y = yinit, times = times, func = predprey, parms = NULL)
##-----------------------------
## display, plot results
##-----------------------------
plot(yout, type = "l", lwd = 2, main = "Predator-prey model", mfrow = c(2, 2))
plot(yout[,2], yout[,3], xlab = "y1", ylab = "y2", type = "l", lwd = 2)
diagnostics(yout)
## =============================================================================
##
## A neutral delay differential equation (lagged derivative)   
##  y't = -y'(t-1), y(t) t < 0 = 1/t
##
## =============================================================================
##-----------------------------
## the derivative function
##-----------------------------
derivs <- function(t, y, parms) {
  tlag <- t - 1
  if (tlag < 0)
    dylag <- -1
  else
    dylag <- lagderiv(tlag)
  list(c(dy = -dylag), dylag = dylag)
}
##-----------------------------
## initial values and times
##-----------------------------
yinit <- 0
times <- seq(0, 4, 0.001)
##-----------------------------
## solve the model  
##-----------------------------
yout <- dede(y = yinit, times = times, func = derivs, parms = NULL)
##-----------------------------
## display, plot results
##-----------------------------
plot(yout, type = "l", lwd = 2)
# }
Run the code above in your browser using DataLab