API options for {epidemics}

epidemics_api_options.R

#### Dummy internal fn ####
f_internal <- function(x) x

#### Dummy internal stochastic fn ####
# some function of the input (fixed) and draws from a distr (stochastic)
# assumes a param beta at position 3
f_internal_stochastic <- function(x) x[[3]] + runif(length(x))

#### Single parameter set and single intervention ####
# function operates on some parameters with one run per parameter
f_current <- function(contacts, npi, ...) {
  # cross-check interventions and population characteristics, here, demo grps
  stopifnot(nrow(contacts) == nrow(npi))
  # some internal operation on a list
  f_internal(
    list(contacts, npi, ...)
  )
}
f_current(matrix(1, 2, 2), matrix(0.2, 2, 2), beta = 1, sigma = 2, gamma = 3)

#### Single parameter set and multiple interventions ####
f_multi_npi <- function(contacts, npi, ...) {
  # if npi is a list, cross-check each element else cross-check npi
  if (is.list(npi)) {
    invisible(
      lapply(npi, function(x) {
        # cross-checking
        stopifnot(nrow(contacts) == nrow(x))
      })
    )
  } else {
    stopifnot(nrow(contacts) == nrow(npi))
  }

  # collect intervention combinations for internal fn
  if (is.list(npi)) {
    scenarios <- lapply(npi, function(x) {
      list(contacts, x, ...)
    })

    # return internal fn operation on parameter-intervention combos
    # aka a 'scenario'
    lapply(scenarios, function(sce) {
      f_internal(sce)
    })
  } else {
    f_internal(list(contacts, npi, ...))
  }
}
f_multi_npi(matrix(1, 2, 2), matrix(0.2, 2, 2), beta = 1, sigma = 2, gamma = 3)

# function multi npi is identical to single npi case when a single npi is passed
identical(
  f_current(matrix(1, 2, 2), matrix(0.2, 2, 2), beta = 1, sigma = 2, gamma = 3),
  f_multi_npi(matrix(1, 2, 2), matrix(0.2, 2, 2), beta = 1, sigma = 2, gamma = 3)
)

# function multi npi returns a list of outputs when multiple interventions
# are passed
f_multi_npi(
  contacts = matrix(1, 2, 2),
  npi = list(
    matrix(0.2, 2, 2),
    matrix(0.3, 2, 2),
    matrix(0.15, 2, 2)
  ),
  beta = 1, sigma = 2, gamma = 3
)

# cross checking required for each npi
f_multi_npi(
  contacts = matrix(1, 2, 2),
  npi = list(
    matrix(0.2, 2, 2),
    matrix(0.3, 1, 2), # this npi is not compatible with contacts
    matrix(0.15, 2, 2)
  ),
  beta = 1, sigma = 2, gamma = 3
)

# compare outputs in some appropriate way

#### Multiple parameter sets, single intervention ####
# user passes parameters as vectors of equal lengths - no recycling
f_multi_param <- function(contacts, npi, ...) {
  # cross-checking single intervention
  stopifnot(nrow(contacts) == nrow(npi))

  # collect params and check
  params <- list(...)
  stopifnot(
    length(unique(vapply(params, length, FUN.VALUE = 1L))) == 1
  )

  # prepare param combos for discrete runs of internal fn
  params <- purrr::transpose(params)
  params <- lapply(
    params, function(x) {
      c(
        list(contacts, npi),
        x
      )
    }
  )

  # run internal fn and return list of outputs
  lapply(params, f_internal)
}

f_multi_param(
  matrix(1, 2, 2), matrix(0.2, 2, 2),
  beta = runif(3),
  sigma = runif(3),
  gamma = runif(3)
)

#### Stochastic internal function, multiple parameter sets ####
# specify replicates as times to run each combination of parameters
f_stochastic <- function(contacts, npi, replicates, ...) {
  # cross-checking single intervention
  # NOTE ebola model does not accept contact matrix
  # but other stochastic models might
  stopifnot(nrow(contacts) == nrow(npi))

  ## SIMILAR TO fn_multi_param
  # collect params and check
  params <- list(...)
  stopifnot(
    length(unique(vapply(params, length, FUN.VALUE = 1L))) == 1
  )

  # prepare param combos for discrete runs of internal fn
  params <- purrr::transpose(params)
  params <- lapply(
    params, function(x) {
      c(
        list(contacts, npi),
        x
      )
    }
  )

  # similar logic applies for combinations of parameters and interventions

  # N replicates per parameter combination
  # running with preserved seed --- NOTE: NOT ABLE TO HAVE THE SEED
  # VARY BETWEEN REPLICATES using `replicate()` +
  # `withr::with_preserve_seed()`
  # hence using hacky implementation
  data <- lapply(
    seq(replicates), function(t) {
      lapply(params, function(p_list) {
        withr::with_seed(
          t,
          f_internal_stochastic(p_list)
        )
      })
    })

  # set names for clarity
  names(data) <- sprintf("replicate_%i", seq_along(data))
  data <- lapply(data, function(x) {
    names(x) <- sprintf("param_%i", seq_along(x))
    x
  })

  data
}

# same random number stream across parameters, differs over replicates
output <- f_stochastic(
  matrix(1, 2, 2), matrix(0.2, 2, 2),
  replicates = 3,
  beta = c(10, 20, 30),
  sigma = c(10, 20, 30),
  gamma = c(10, 20, 30)
)

Ignore the dot. Copy paste. Just treat it as an unvectorised function a user has been given of which they know nothing about underlying checks.

Ah got it.

@Bisaloo expressed concerns/doubts on the API so hoping to have similar discussion today to explain what was decided and why.

Sure, and I broadly agree but I'm not sure there's much room for manoeuvre given growing interest in this sort of functionality (as in https://github.com/orgs/epiverse-trace/discussions/173).