S3 inheritance mocking dispatch on inherited types

s3inherit.R

# a simple Ricker model, which may be stochastic if you provide `sd` or deterministic if not
setup_ricker <- function(x0, r, k, sd = NULL) {
  type <- c("ricker")
  if (is.null(sd)) {
    type <- c(type, "ricker_deterministic")
  } else {
    type <- c(type, "ricker_stochastic")
  }
  mod <- structure(new.env(), class = type)
  mod$x <- x0
  mod$r <- r
  mod$k <- k
  mod$sd <- sd
  return(mod)
}

# the method to get output only has one method, for the "parent" class
output <- function(model) {
  UseMethod("output", model)
}

output.ricker <- function(model) {
  model$x
}

# the step function calls the one for the "parent" class
step <- function(model) {
  UseMethod("step", model)
}

# NextMethod() will walk to the next class in the class(model) "inheritance"
step.ricker <- function(model) {
  NextMethod()
}

step.ricker_deterministic <- function(model) {
  model$x <- model$x * (model$r - model$r * (model$x / model$k))
}

step.ricker_stochastic <- function(model) {
  theta <- rnorm(n = 1L, mean = 0, sd = model$sd)
  model$x <- model$x * (model$r - model$r * (model$x / model$k)) * exp(theta)
}

t <- 100
x0 <- 1
k <- 20
sd <- 0.1
r <- 2.2

# now we can write sort-of generic code
draw_ricker_traj <- function(t, x0, k, r, sd = NULL) {
  mod <- setup_ricker(x0 = x0, r = r, k = k, sd = sd)
  out <- rep(NaN, t)
  out[1] <- output(mod)
  for (i in 2:t) {
    step(mod)
    out[i] <- output(mod)
  }
  return(out)
}

out_d <- draw_ricker_traj(t = t, x0 = x0, k = k, r = r)
out_s <- replicate(n = 1e2, expr = {draw_ricker_traj(t = t, x0 = x0, k = k, r = r, sd = sd)})

matplot(x = 1:t, y = out_s, type = "b", pch = 16, cex = 0.5, col = adjustcolor("blue", alpha.f = 0.1), lwd = 1, lty = 1)
lines(x = 1:t, y = out_d, type = "b", pch = 16, cex = 0.5, col = "black", lwd = 2)