R/utils.R

Defines functions .logistic_curve .read_demographics .sample_fixed_TRUE .get_vaccination_level .calculate_reff

# Reff calculation
.calculate_reff <- function(total_cases, initial_cases, iterations) {
  (total_cases / initial_cases)^(1/iterations) - 1
}

# vaccine rate function ------------------------------------------------------
.get_vaccination_level <- function(age,
                                   levels = NULL) {

  if (length(levels) != 1 & length(levels) != 10) {
    stop("Vaccination levels must be either a vector of length 1 or 10")
  }

  if (length(levels) == 1) return(levels)

  ret <- fcase(
      age <=  10, levels[1],
      age <=  20, levels[2],
      age <=  30, levels[3],
      age <=  40, levels[4],
      age <=  50, levels[5],
      age <=  60, levels[6],
      age <=  70, levels[7],
      age <=  80, levels[8],
      age <=  90, levels[9],
      age >   90, levels[10]
    )

}


# helper function
.sample_fixed_TRUE <- function(n, nTRUE) {
  nFALSE <- n - nTRUE
  if (nTRUE >= n) {
    return(rep(TRUE, n))
  }
  if (nFALSE >= n) {
    return(rep(FALSE, n))
  }

  out <- dqrng::dqsample(rep(c(FALSE, TRUE),
                             c(nFALSE, nTRUE)))

  out
}


.read_demographics <- function(uncounted = TRUE,
                               n_pop = 25698093
                               ) {

  scale_factor <- n_pop / sum(auspop$n)

  ret <- auspop %>%
    mutate(n = round(n * scale_factor))


  if (uncounted) {
    ret <- ret %>%
      uncount() %>%
      select(age)
  }

  return(ret)

}

# function for vaccination rates:
.logistic_curve <- function(t, M, n0, c) {
  M / (1 + ((M - n0) / n0) * exp(-c*t))
}
grattan/covidReff documentation built on Dec. 20, 2021, 12:51 p.m.