diff --git a/DESCRIPTION b/DESCRIPTION index aa3f771..db0252c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,11 +1,11 @@ Package: vimpact Title: Vaccine Impact Calculation -Version: 0.1.3 +Version: 0.1.4 Authors@R: - c(person(given = "Rich", - family = "FitzJohn", + c(person(given = "Xiang", + family = "Li", role = c("aut", "cre"), - email = "rich.fitzjohn@gmail.com"), + email = "x.li@imperial.ac.uk"), person("Imperial College of Science, Technology and Medicine", role = "cph")) Description: VIMC IMPACT CALCULATION PACKAGE. This package is mainly for the VIMC Science Team to investigate vaccination impact. @@ -34,6 +34,6 @@ Suggests: RSQLite, withr Remotes: reside-ic/fakerbase -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 VignetteBuilder: knitr Config/testthat/edition: 3 diff --git a/NEWS.md b/NEWS.md index 090057a..1865aca 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# vimpact 0.1.4 + +* Produce age specific calendar impact. + # vimpact 0.1.3 * Recognise new burden outcomes. diff --git a/R/impact_central.R b/R/impact_central.R index 7f30b39..60cf8f3 100644 --- a/R/impact_central.R +++ b/R/impact_central.R @@ -1,32 +1,10 @@ -get_raw_impact_details <- function(con, meta1, burden_outcome, is_under5 = FALSE, countries_to_extract = NULL){ +get_raw_impact_details <- function(con, meta1, burden_outcome, is_under5 = FALSE, countries_to_extract = NULL, age_specific = FALSE){ #verify parameters stopifnot(nrow(meta1) == 2L) stopifnot(burden_outcome %in% c("deaths", "cases", "dalys", "yll", "deaths_cwyx", "cases_cwyx", "dalys_cwyx", "yll_cwyx")) # _cwyx outcomes are MenA specific. stopifnot(is_under5 %in% c(TRUE, FALSE)) - #preparation - # determine burden outcome, k will be used to determine burden outcome ids - if(burden_outcome == "deaths"){ - k <- 1 - } else if(burden_outcome == "cases"){ - k <- 2 - } else if(burden_outcome == "dalys"){ - k <- 3 - } else if(burden_outcome == "yll"){ - k <- 4 - } else if(burden_outcome == "deaths_cwyx"){ - k <- 5 - } else if(burden_outcome == "cases_cwyx"){ - k <- 6 - } else if(burden_outcome == "dalys_cwyx"){ - k <- 7 - } else if(burden_outcome == "yll_cwyx"){ - k <- 8 - } else { - stop("Can only take burden outcome as one of deaths, cases, dalys, yll, deaths_cwyx, cases_cwyx, dalys_cwyx, yll_cwyx") - } - # determine whether a recipe is for routine or campaign vaccine delivery # routine or campaign matters for method2a in terms of the shape of burden estimates to extract # if routine, by year of birth @@ -56,13 +34,22 @@ get_raw_impact_details <- function(con, meta1, burden_outcome, is_under5 = FALSE # set up db extraction sql queries if((meta1$method[1] == "method0") || (meta1$method[1] == "method2a" && any(j))){ - sql <- paste("SELECT country, year AS time, sum(value) AS value", - "FROM burden_estimate", - "WHERE burden_estimate_set = %s", - "AND burden_outcome IN %s", - age_constrain, - country_constrain, - "GROUP BY country, year") + if(meta1$method[1] == "method0" & age_specific){ + sql <- paste("SELECT country, year AS time, age, value", + "FROM burden_estimate", + "WHERE burden_estimate_set = %s", + "AND burden_outcome IN %s", + age_constrain, + country_constrain) + } else { + sql <- paste("SELECT country, year AS time, sum(value) AS value", + "FROM burden_estimate", + "WHERE burden_estimate_set = %s", + "AND burden_outcome IN %s", + age_constrain, + country_constrain, + "GROUP BY country, year") + } } else if((meta1$method[1] == "method1") || (meta1$method[1] == "method2a" && any(i)) || (meta1$method[1] == "method2b")){ sql <- paste("SELECT country, (year-age) AS time, sum(value)AS value", "FROM burden_estimate", @@ -75,18 +62,23 @@ get_raw_impact_details <- function(con, meta1, burden_outcome, is_under5 = FALSE # get burden outcome ids i <- meta1$meta_type == "focal" - ii <- unlist(strsplit(meta1$burden_outcome_id[i], ";")) + ss_id <- unlist(strsplit(meta1$burden_outcome_id[i], ";")) + ss_code <- unlist(strsplit(meta1$burden_outcome[i], ";")) + ii <- ss_id[ss_code == burden_outcome] + j <- meta1$meta_type == "baseline" - jj <- unlist(strsplit(meta1$burden_outcome_id[j], ";")) + ss_id <- unlist(strsplit(meta1$burden_outcome_id[j], ";")) + ss_code <- unlist(strsplit(meta1$burden_outcome[j], ";")) + jj <- ss_id[ss_code == burden_outcome] # extract burden estimates d_baseline <- DBI::dbGetQuery(con, sprintf(sql, sql_in(meta1$burden_estimate_set[j], text_item = FALSE), - sql_in(jj[k], text_item = FALSE))) + sql_in(jj, text_item = FALSE))) d_focal <- DBI::dbGetQuery(con, sprintf(sql, sql_in(meta1$burden_estimate_set[i], text_item = FALSE), - sql_in(ii[k], text_item = FALSE))) + sql_in(ii, text_item = FALSE))) if(meta1$disease[1] == "HepB" && (nrow(d_focal) == 0L || nrow(d_baseline) == 0L)) { # when you are extracting data for HepB - IC and CDA models - for specific countries # you may end out with 0 rows for d_baseline or d_focal diff --git a/tests/testthat/test-db-impact.R b/tests/testthat/test-db-impact.R index 2796287..1373f67 100644 --- a/tests/testthat/test-db-impact.R +++ b/tests/testthat/test-db-impact.R @@ -180,6 +180,7 @@ test_that("impact calculation by year of vaccination country perspective", { }) test_that("impact calculation by year of vaccination cohort perspective", { + impact <- impact_by_year_of_vaccination_cohort_perspective( impact_test_data, fvp_test_data_15, 2000:2030) expect_equal(colnames(impact), @@ -272,11 +273,13 @@ test_that("impact by calendar year: external and internal functions agree", { meta <- data_frame( scenario_type = c("default", "default"), + disease = c("YF", "YF"), vaccine_delivery = c("YF-campaign,YF-routine", "YF-routine"), meta_type = c("baseline", "focal"), index = c(1, 1), method = c("method0", "method0"), burden_estimate_set = c(1, 2), + burden_outcome = c("deaths", "deaths"), burden_outcome_id = c("1", "1")) vimc_impact <- get_raw_impact_details(con = con, meta, @@ -332,14 +335,16 @@ test_that("impact by birth year: external and internal functions agree", { meta <- data_frame( scenario_type = c("default", "default"), + disease = c("YF", "YF"), vaccine_delivery = c("YF-campaign,YF-routine", "YF-routine"), meta_type = c("baseline", "focal"), index = c(1, 1), method = c("method1", "method1"), burden_estimate_set = c(1, 2), + burden_outcome = c("deaths", "deaths"), burden_outcome_id = c("1", "1")) - vimc_impact <- get_raw_impact_details(con = con, meta, + vimc_impact <- get_raw_impact_details(con = con, meta, burden_outcome = "deaths") public_impact <- impact_by_birth_year(impact_test_data_baseline, impact_test_data_focal) @@ -426,6 +431,7 @@ test_that("impact activity type: functions agree - routine", { index = c(1, 1), method = c("method2a", "method2a"), burden_estimate_set = c(1, 2), + burden_outcome = c("deaths", "deaths"), burden_outcome_id = c("1", "1")) routine_raw_impact <- get_raw_impact_details(con = con, meta, @@ -475,6 +481,7 @@ test_that("impact activity type: functions agree - campaign", { index = c(1, 1), method = c("method2a", "method2a"), burden_estimate_set = c(1, 2), + burden_outcome = c("deaths", "deaths"), burden_outcome_id = c("1", "1")) campaign_raw_impact <- get_raw_impact_details(con = con, meta, @@ -541,6 +548,7 @@ test_that("impact birth cohort: internal and external functions agree", { index = c(1, 1), method = c("method2b", "method2b"), burden_estimate_set = c(1, 2), + burden_outcome = c("deaths", "deaths"), burden_outcome_id = c("1", "1")) vimc_raw_impact <- get_raw_impact_details(con = con, meta,