Skip to content

Commit

Permalink
change parameter name vaccs to vacc in function complete_vacc_activit…
Browse files Browse the repository at this point in the history 
…ies() for more consistency
  • Loading branch information
@tinigarske
tinigarske committed Mar 21, 2024
1 parent 6bc2695 commit bb71890
Show file tree
Hide file tree
Showing 6 changed files with 62 additions and 62 deletions.
38 changes: 19 additions & 19 deletions R/popim_vacc_activities.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -190,43 +190,43 @@ read_vacc_activities <- function(file) {
##' activity, the function checks if they are consistent with the
##' population size, and fails if there are any inconsistencies.
##'
##' @param vaccs `popim_vacc_activities` object
##' @param vacc `popim_vacc_activities` object
##' @param pop `popim_population` object
##' @return The supplied object of class `popim_vacc_activities`,
##' updated to have both `doses` and `coverage` information.
##' @author Tini Garske
##' @export
complete_vacc_activities <- function(vaccs, pop) {
validate_vacc_activities(vaccs)
complete_vacc_activities <- function(vacc, pop) {
validate_vacc_activities(vacc)
stopifnot(is_population(pop))

## double check coverage and doses are compatible:
ii <- which(!is.na(vaccs$coverage) & !is.na(vaccs$doses))
ii <- which(!is.na(vacc$coverage) & !is.na(vacc$doses))
if(length(ii) > 0) {
new_doses <- sapply(ii, function(i)
doses_from_coverage(pop, vaccs$coverage[i], vaccs$region[i],
vaccs$year[i],
vaccs$age_first[i], vaccs$age_last[i]))
doses_from_coverage(pop, vacc$coverage[i], vacc$region[i],
vacc$year[i],
vacc$age_first[i], vacc$age_last[i]))

stopifnot(isTRUE(all.equal(vaccs$doses[ii], new_doses)))
stopifnot(isTRUE(all.equal(vacc$doses[ii], new_doses)))
}
## missing coverage:
ii <- which(is.na(vaccs$coverage))
ii <- which(is.na(vacc$coverage))
if(length(ii) > 0) {
vaccs$coverage[ii] <- sapply(ii, function(i)
coverage_from_doses(pop, vaccs$doses[i], vaccs$region[i],
vaccs$year[i],
vaccs$age_first[i], vaccs$age_last[i]))
vacc$coverage[ii] <- sapply(ii, function(i)
coverage_from_doses(pop, vacc$doses[i], vacc$region[i],
vacc$year[i],
vacc$age_first[i], vacc$age_last[i]))
}

## missing doses:
ii <- which(is.na(vaccs$doses))
ii <- which(is.na(vacc$doses))
if(length(ii) > 0) {
vaccs$doses[ii] <- sapply(ii, function(i)
doses_from_coverage(pop, vaccs$coverage[i], vaccs$region[i],
vaccs$year[i],
vaccs$age_first[i], vaccs$age_last[i]))
vacc$doses[ii] <- sapply(ii, function(i)
doses_from_coverage(pop, vacc$coverage[i], vacc$region[i],
vacc$year[i],
vacc$age_first[i], vacc$age_last[i]))
}

vaccs
vacc
}
38 changes: 19 additions & 19 deletions R/vacc_from_immunity.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ vacc_from_immunity <- function(pop, targeting = "random", n_digits = 10) {

pop <- add_immunity_rate(pop)

vaccs <- pop |>
vacc <- pop |>
dplyr::mutate(coverage =
coverage_from_immunity_diff(.data$immunity,
.data$immunity_diff,
Expand All @@ -60,13 +60,13 @@ vacc_from_immunity <- function(pop, targeting = "random", n_digits = 10) {
dplyr::arrange(.data$region, .data$year, .data$targeting,
round(.data$coverage, n_digits), .data$age_first)

class(vaccs) <- c("popim_vacc_activities", "data.frame")
if(nrow(vaccs) > 1)
vaccs <- aggregate_vacc_activities(vaccs, n_digits = n_digits)
vaccs <- complete_vacc_activities(vaccs, pop)
validate_vacc_activities(vaccs)
class(vacc) <- c("popim_vacc_activities", "data.frame")
if(nrow(vacc) > 1)
vacc <- aggregate_vacc_activities(vacc, n_digits = n_digits)
vacc <- complete_vacc_activities(vacc, pop)
validate_vacc_activities(vacc)

vaccs
vacc
}

##' Add the rate of immunity change to a `popim_population` object
Expand Down Expand Up @@ -206,40 +206,40 @@ get_consecutive_range <- function(ages) {
##' compressed into a (or several) consecutive age range, such that
##' the same information is coded in fewer lines.
##'
##' @param vacc_act popim_vacc_activities object to be aggregated
##' @param vacc popim_vacc_activities object to be aggregated
##' @param n_digits number of digits to which coverage is rounded
##' before coverages from different activities are matched.
##' @return popim_vacc_activities object containing the same vaccination
##' activities as the input object, but where possible aggregated
##' into fewer lines
##' @author Tini Garske
##' @noRd
aggregate_vacc_activities <- function(vacc_act, n_digits = 10) {
aggregate_vacc_activities <- function(vacc, n_digits = 10) {

assert_vacc_activities(vacc_act)
assert_vacc_activities(vacc)

if(nrow(vacc_act) < 2) {
message(sprintf("vacc_act has %d rows, no aggregation performed.",
nrow(vacc_act)))
return(vacc_act)
if(nrow(vacc) < 2) {
message(sprintf("vacc has %d rows, no aggregation performed.",
nrow(vacc)))
return(vacc)
}

vacc_act <- vacc_act |>
vacc <- vacc |>
dplyr::mutate(coverage = round(.data$coverage, n_digits)) |>
dplyr::group_by(.data$region, .data$year, .data$targeting,
.data$coverage) |>
dplyr::arrange(.data$region, .data$year, .data$targeting,
.data$coverage) |>
dplyr::mutate(id = dplyr::cur_group_id())

va_agg <- vacc_act |>
va_agg <- vacc |>
dplyr::summarise(doses = sum(.data$doses), id = mean(.data$id)) |>
dplyr::ungroup()
class(vacc_act) <- c("popim_vacc_activities", "data.frame")
class(vacc) <- c("popim_vacc_activities", "data.frame")

vacc_ids <- vacc_act$id |> unique()
vacc_ids <- vacc$id |> unique()
ages_list <- lapply(vacc_ids,
function(i) get_all_ages(vacc_act |>
function(i) get_all_ages(vacc |>
dplyr::filter(.data$id == i)))

ranges_list <- lapply(seq_along(ages_list),
Expand Down
2 changes: 1 addition & 1 deletion README.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -80,7 +80,7 @@ vaccination of infants (restricted to age 0) with an increasing
population of the target cohort to be vaccinated.

We now apply these vaccination activities sequentially to the
population using the function `apply_vaccs()`.
population using the function `apply_vacc()`.

```{r apply_vacc}
pop <- apply_vacc(pop, vacc)
Expand Down
2 changes: 1 addition & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,7 @@ vaccination of infants (restricted to age 0) with an increasing
population of the target cohort to be vaccinated.

We now apply these vaccination activities sequentially to the population
using the function `apply_vaccs()`.
using the function `apply_vacc()`.

``` r
pop <- apply_vacc(pop, vacc)
Expand Down
4 changes: 2 additions & 2 deletions man/complete_vacc_activities.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

40 changes: 20 additions & 20 deletions tests/testthat/test-complete_vacc_activities.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,13 +4,13 @@ test_that("complete_vacc_activities adds appropriate doses information for a sin
age_min = 0, age_max = 5)
pop$pop_size <- 100

vaccs <- popim_vacc_activities(region = "UK", year = 2000, age_first = 0,
vacc <- popim_vacc_activities(region = "UK", year = 2000, age_first = 0,
age_last = 0, coverage = 0.5, doses = NA,
targeting = "random")

vaccs <- complete_vacc_activities(vaccs = vaccs, pop = pop)
vacc <- complete_vacc_activities(vacc = vacc, pop = pop)

expect_equal(50, vaccs$doses)
expect_equal(50, vacc$doses)
})

test_that("complete_vacc_activities adds appropriate doses information for several activities", {
Expand All @@ -19,13 +19,13 @@ test_that("complete_vacc_activities adds appropriate doses information for sever
age_min = 0, age_max = 5)
pop$pop_size <- 100

vaccs <- popim_vacc_activities(region = "UK", year = 2000:2002, age_first = 0,
vacc <- popim_vacc_activities(region = "UK", year = 2000:2002, age_first = 0,
age_last = 0, coverage = 0.5, doses = NA,
targeting = "random")

vaccs <- complete_vacc_activities(vaccs = vaccs, pop = pop)
vacc <- complete_vacc_activities(vacc = vacc, pop = pop)

expect_equal(rep(50, 3), vaccs$doses)
expect_equal(rep(50, 3), vacc$doses)
})

test_that("complete_vacc_activities adds appropriate coverage information for a single activity", {
Expand All @@ -34,13 +34,13 @@ test_that("complete_vacc_activities adds appropriate coverage information for a
age_min = 0, age_max = 5)
pop$pop_size <- 100

vaccs <- popim_vacc_activities(region = "UK", year = 2000, age_first = 0,
vacc <- popim_vacc_activities(region = "UK", year = 2000, age_first = 0,
age_last = 0, coverage = NA, doses = 100,
targeting = "random")

vaccs <- complete_vacc_activities(vaccs = vaccs, pop = pop)
vacc <- complete_vacc_activities(vacc = vacc, pop = pop)

expect_equal(1, vaccs$coverage)
expect_equal(1, vacc$coverage)
})

test_that("complete_vacc_activities adds appropriate coverage information for several activities", {
Expand All @@ -49,13 +49,13 @@ test_that("complete_vacc_activities adds appropriate coverage information for se
age_min = 0, age_max = 5)
pop$pop_size <- 100

vaccs <- popim_vacc_activities(region = "UK", year = 2000:2002, age_first = 0,
vacc <- popim_vacc_activities(region = "UK", year = 2000:2002, age_first = 0,
age_last = 0, coverage = NA, doses = 100,
targeting = "random")

vaccs <- complete_vacc_activities(vaccs = vaccs, pop = pop)
vacc <- complete_vacc_activities(vacc = vacc, pop = pop)

expect_equal(rep(1, 3), vaccs$coverage)
expect_equal(rep(1, 3), vacc$coverage)
})

test_that("complete_vacc_activities flags inconsistend coverage and doses information for a single activity", {
Expand All @@ -64,11 +64,11 @@ test_that("complete_vacc_activities flags inconsistend coverage and doses inform
age_min = 0, age_max = 5)
pop$pop_size <- 100

vaccs <- popim_vacc_activities(region = "UK", year = 2000, age_first = 0,
vacc <- popim_vacc_activities(region = "UK", year = 2000, age_first = 0,
age_last = 0, coverage = 0.5, doses = 100,
targeting = "random")

expect_error(vaccs <- complete_vacc_activities(vaccs = vaccs, pop = pop))
expect_error(vacc <- complete_vacc_activities(vacc = vacc, pop = pop))
})

test_that("complete_vacc_activities adds appropriate coverage information for several activities", {
Expand All @@ -77,15 +77,15 @@ test_that("complete_vacc_activities adds appropriate coverage information for se
age_min = 0, age_max = 5)
pop$pop_size <- 100

vaccs <- popim_vacc_activities(region = "UK", year = 2000:2002, age_first = 0,
vacc <- popim_vacc_activities(region = "UK", year = 2000:2002, age_first = 0,
age_last = 0, coverage = c(NA, 0.5,0.5),
doses = c(50, 50, NA),
targeting = "random")

vaccs <- complete_vacc_activities(vaccs = vaccs, pop = pop)
vacc <- complete_vacc_activities(vacc = vacc, pop = pop)

expect_equal(rep(0.5, 3), vaccs$coverage)
expect_equal(rep(50, 3), vaccs$doses)
expect_equal(rep(0.5, 3), vacc$coverage)
expect_equal(rep(50, 3), vacc$doses)
})

test_that("complete_vacc_activities fails conflicting coverage/doses information for several activities", {
Expand All @@ -94,10 +94,10 @@ test_that("complete_vacc_activities fails conflicting coverage/doses information
age_min = 0, age_max = 5)
pop$pop_size <- 100

vaccs <- popim_vacc_activities(region = "UK", year = 2000:2002, age_first = 0,
vacc <- popim_vacc_activities(region = "UK", year = 2000:2002, age_first = 0,
age_last = 0, coverage = c(NA, 0.8,0.5),
doses = c(50, 50, NA),
targeting = "random")

expect_error(vaccs <- complete_vacc_activities(vaccs = vaccs, pop = pop))
expect_error(vacc <- complete_vacc_activities(vacc = vacc, pop = pop))
})

0 comments on commit bb71890

Please sign in to comment.