R/wait_times.R

In covid19br/now_fcts: Auxiliary functions for analyzing COVID-19 data from different sources

#' rwaittime
#'
#' @param n n
#' @param fit fit
#'
#' @export
#' @importFrom brms fixef
#' @importFrom stats rweibull
rwaittime <-  function(n, fit) {
  mu = fixef(fit)[1,"Estimate"]
  shape = mean(as.data.frame(fit)$shape)
  lambda = exp(mu) / gamma( 1 + 1/shape )
  rweibull(n, shape = shape, scale = lambda)
}

#' rwaittime_posterior_age
#'
#' @param n n
#' @param age age
#' @param fit fit
#'
#' @export
#' @importFrom plyr aaply
#' @importFrom stats rweibull
rwaittime_posterior_age <- function(n, age, fit) {
  model_matrix = as.matrix(fit)
  x = model_matrix[1, ]
  aaply(model_matrix, 1, function(x) {
    random_int = x[grep(age, names(x))]
    if (length(random_int) == 0)
      random_int = 0
    mu = x["b_Intercept"] + random_int
    shape = x["shape"]
    lambda = exp(mu) / gamma(1 + 1 / shape)
    rweibull(n, shape = shape, scale = lambda)
  })
}

#' rwaittime_age
#'
#' @param n n
#' @param age age
#' @param fit fit
#'
#' @export
#' @importFrom stats coef rweibull
#'
rwaittime_age <- function(n, age, fit) {
  mu = coef(fit)$age_class[age,"Estimate","Intercept"]
  shape = summary(fit)$spec_pars[1]
  lambda = exp(mu) / gamma( 1 + 1/shape )
  rweibull(n, shape = shape, scale = lambda)
}