From ab0411a5fecd26547428f1505f73b714365a8579 Mon Sep 17 00:00:00 2001 From: jeffeaton Date: Tue, 29 Oct 2024 00:53:24 +0100 Subject: [PATCH 1/5] update plots and tables to end 2023 --- DESCRIPTION | 2 +- NEWS.md | 4 ++++ R/inputs.R | 2 +- R/likelihood.R | 4 ++-- R/plot_functions.R | 22 +++++++++++----------- R/plot_outputs.R | 34 +++++++++++++++++----------------- R/retest.R | 8 ++++---- R/table_output.R | 4 ++-- R/time_functions.R | 6 +++--- 9 files changed, 45 insertions(+), 41 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 18a3906..057e2b6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: first90 -Version: 1.6.10 +Version: 1.6.11 Title: The first90 model Description: Implements the Shiny90 model for estimating progress towards the UNAIDS "first 90" target for HIV awareness of status in sub-Saharan Africa. Authors@R: diff --git a/NEWS.md b/NEWS.md index ee28ec4..d4ed35e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# first90 1.6.11 + +* Update plots and tables to end in 2023. + # first90 1.6.10 * Implement recovery to next higher CD4 category following ART interruption for those on ART greater than one year. diff --git a/R/inputs.R b/R/inputs.R index fe9ff5d..27742ea 100644 --- a/R/inputs.R +++ b/R/inputs.R @@ -37,7 +37,7 @@ select_prgmdata <- function(prgm_dat, cnt, age_group) { ## * year vector needs to be extended to output results to current year prg_dat <- data.frame(country = cnt, - year = 2010:2022, + year = 2010:2023, agegr = '15-99', sex = 'both', tot = NA, totpos = NA, vct = NA, vctpos = NA, anc = NA, ancpos = NA) diff --git a/R/likelihood.R b/R/likelihood.R index 735f9dd..448ce77 100644 --- a/R/likelihood.R +++ b/R/likelihood.R @@ -64,7 +64,7 @@ ll_prgdat <- function(mod, fp, dat) { ## -- UPDATE HERE -- ## * max_year = incremented each year -art_constraint_penalty <- function(mod, fp, max_year = 2022) { +art_constraint_penalty <- function(mod, fp, max_year = 2023) { ind_year <- c(2000:max_year) - fp$ss$proj_start + 1L tot_late <- apply(attr(mod, "late_diagnoses")[,,, ind_year], 4, sum) tot_untreated_pop <- apply(attr(mod, "hivpop")[,,, ind_year], 4, sum) @@ -74,7 +74,7 @@ art_constraint_penalty <- function(mod, fp, max_year = 2022) { return(penalty) } # Include this in ll_hts if you want to incorporate the likelihood constraint on ART. - # val_art_penalty <- art_constraint_penalty(mod, fp, max_year = 2022) + # val_art_penalty <- art_constraint_penalty(mod, fp, max_year = 2023) # val <- val1 + val2 + val3 + val_prior + val_art_penalty # Function to prepare the data for input in the likelihood function. diff --git a/R/plot_functions.R b/R/plot_functions.R index 015ea38..0fbc36d 100644 --- a/R/plot_functions.R +++ b/R/plot_functions.R @@ -19,7 +19,7 @@ get_pjnz_summary_data <- function(fp) { #' ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz_prv <- function(pjnz_summary, yr_pred = 2022) { +plot_pjnz_prv <- function(pjnz_summary, yr_pred = 2023) { pjnz_summary <- stats::na.omit(data.frame(year = pjnz_summary[["year"]], prv = pjnz_summary[["prevalence"]]*100)) pjnz_summary$year <- pjnz_summary$year + 0.5 plot(pjnz_summary$prv ~ pjnz_summary$year, @@ -34,7 +34,7 @@ plot_pjnz_prv <- function(pjnz_summary, yr_pred = 2022) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz_inc <- function(pjnz_summary, yr_pred = 2022) { +plot_pjnz_inc <- function(pjnz_summary, yr_pred = 2023) { pjnz_summary <- stats::na.omit(data.frame(year = pjnz_summary[["year"]], inc = pjnz_summary[["incidence"]]*1000)) pjnz_summary$year <- pjnz_summary$year + 0.5 pjnz_summary <- subset(pjnz_summary, year >= 2000) @@ -50,7 +50,7 @@ plot_pjnz_inc <- function(pjnz_summary, yr_pred = 2022) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz_pop <- function(pjnz_summary, yr_pred = 2022) { +plot_pjnz_pop <- function(pjnz_summary, yr_pred = 2023) { pjnz_summary <- stats::na.omit(data.frame(year = pjnz_summary[["year"]], pop = pjnz_summary[["pop"]]/1000)) pjnz_summary$year <- pjnz_summary$year + 0.5 plot(pjnz_summary$pop ~ pjnz_summary$year, @@ -65,7 +65,7 @@ plot_pjnz_pop <- function(pjnz_summary, yr_pred = 2022) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz_plhiv <- function(pjnz_summary, yr_pred = 2022) { +plot_pjnz_plhiv <- function(pjnz_summary, yr_pred = 2023) { pjnz_summary <- stats::na.omit(data.frame(year = pjnz_summary[["year"]], plhiv = pjnz_summary[["plhiv"]]/1000)) pjnz_summary$year <- pjnz_summary$year + 0.5 plot(pjnz_summary$plhiv ~ pjnz_summary$year, @@ -83,7 +83,7 @@ plot_pjnz_plhiv <- function(pjnz_summary, yr_pred = 2022) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz <- function(fp, yr_pred = 2022) { +plot_pjnz <- function(fp, yr_pred = 2023) { summary <- get_pjnz_summary_data(fp) graphics::par(mfrow=c(2,2)) plot_pjnz_prv(summary, yr_pred) @@ -126,7 +126,7 @@ combine_rows <- function(prgdat) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_input_tot <- function(prgdat, fp, yr_pred = 2022) { +plot_input_tot <- function(prgdat, fp, yr_pred = 2023) { start <- fp$ss$proj_start mod <- simmod(fp) pop <- apply(mod[1:35,,,], 4, FUN=sum) @@ -157,7 +157,7 @@ plot_input_tot <- function(prgdat, fp, yr_pred = 2022) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_input_totpos <- function(prgdat, fp, yr_pred = 2022) { +plot_input_totpos <- function(prgdat, fp, yr_pred = 2023) { start <- fp$ss$proj_start mod <- simmod(fp) plhiv <- apply(attr(mod, "hivpop")[,1:8,,], 4, FUN = sum) + @@ -201,7 +201,7 @@ plot_input_totpos <- function(prgdat, fp, yr_pred = 2022) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_input_anctot <- function(prgdat, fp, yr_pred = 2022) { +plot_input_anctot <- function(prgdat, fp, yr_pred = 2023) { if (sum(prgdat$anc, na.rm = TRUE) > 0) { prgdat <- subset(prgdat, sex != 'male') @@ -217,7 +217,7 @@ plot_input_anctot <- function(prgdat, fp, yr_pred = 2022) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_input_ancpos <- function(prgdat, fp, yr_pred = 2022) { +plot_input_ancpos <- function(prgdat, fp, yr_pred = 2023) { if (sum(prgdat$ancpos, na.rm = TRUE) > 0) { prgdat <- subset(prgdat, sex != 'male') @@ -235,7 +235,7 @@ plot_input_ancpos <- function(prgdat, fp, yr_pred = 2022) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_inputdata <- function(prgm_dat, fp, yr_pred = 2022) { +plot_inputdata <- function(prgm_dat, fp, yr_pred = 2023) { graphics::par(mfrow = c(2,2)) plot_input_tot(prgm_dat, fp, yr_pred) plot_input_totpos(prgm_dat, fp, yr_pred) @@ -330,7 +330,7 @@ optimized_par <- function(opt, param = NULL) { 'RR re-testing: PLHIV aware (not ART) 2010', ## -- UPDATE HERE -- ## * update label to current year - 'RR re-testing: PLHIV aware (not ART) 2022', + 'RR re-testing: PLHIV aware (not ART) 2023', 'RR re-testing: PLHIV on ART (*RR not ART)', 'RR among 25-34 men', 'RR among 35+ men', diff --git a/R/plot_outputs.R b/R/plot_outputs.R index bc3331b..11429bf 100644 --- a/R/plot_outputs.R +++ b/R/plot_outputs.R @@ -146,7 +146,7 @@ get_out_pregprev <- function(mod, fp) { ## ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_out_nbtest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2022, +plot_out_nbtest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2023, plot_title = TRUE) { # if fitting with HTS program data stratified by sex, we add both sex back ld <- likdat$hts @@ -237,7 +237,7 @@ plot_out_nbtest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2022, ## ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_out_nbtest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2022) { +plot_out_nbtest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2023) { # redact <- c('Namibia','Uganda','Zambia','Zimbabwe') redact <- c('XXX') @@ -321,7 +321,7 @@ plot_out_nbtest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 20 ## ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_out_nbpostest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2022, +plot_out_nbpostest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2023, plot_title = TRUE) { # if fitting with HTS program data stratified by sex, we add both sex back ld <- likdat$hts @@ -420,7 +420,7 @@ plot_out_nbpostest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 202 ## ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_out_nbpostest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2022) { +plot_out_nbpostest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2023) { # redact <- c('Namibia','Uganda','Zambia','Zimbabwe') redact <- c('XXX') @@ -500,7 +500,7 @@ plot_out_nbpostest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_evertestneg <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, - simul = NULL, plot_legend = TRUE, yr_pred = 2022) { + simul = NULL, plot_legend = TRUE, yr_pred = 2023) { out_evertest <- subset(out_evertest, year <= yr_pred) out_evertest$year <- out_evertest$year + 0.5 @@ -580,7 +580,7 @@ plot_out_evertestneg <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_evertestpos <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, - simul = NULL, plot_legend = TRUE, yr_pred = 2022, + simul = NULL, plot_legend = TRUE, yr_pred = 2023, plot_title = TRUE) { out_evertest <- subset(out_evertest, year <= yr_pred) @@ -655,7 +655,7 @@ plot_out_evertestpos <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_evertest <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, - simul = NULL, plot_legend = TRUE, yr_pred = 2022, + simul = NULL, plot_legend = TRUE, yr_pred = 2023, plot_title = TRUE) { out_evertest <- subset(out_evertest, year <= yr_pred) @@ -732,7 +732,7 @@ plot_out_evertest <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_90s <- function(mod, fp, likdat, cnt, out_evertest, survey_hts, - simul = NULL, plot_legend = TRUE, yr_pred = 2022) { + simul = NULL, plot_legend = TRUE, yr_pred = 2023) { phia_aware <- subset(survey_hts, country == cnt & agegr == '15-49' & sex == 'both' & outcome == 'aware') @@ -853,7 +853,7 @@ plot_out_90s <- function(mod, fp, likdat, cnt, out_evertest, survey_hts, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_evertest_fbyage <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, - simul = NULL, plot_legend = TRUE, yr_pred = 2022) { + simul = NULL, plot_legend = TRUE, yr_pred = 2023) { out_evertest <- subset(out_evertest, year <= yr_pred) out_evertest$year <- out_evertest$year + 0.5 @@ -947,7 +947,7 @@ plot_out_evertest_fbyage <- function(mod, fp, likdat, cnt, survey_hts, out_evert ## * update yr_pred to current year plot_out_evertest_mbyage <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, simul = NULL, - plot_legend = TRUE, yr_pred = 2022) { + plot_legend = TRUE, yr_pred = 2023) { out_evertest <- subset(out_evertest, year <= yr_pred) out_evertest$year <- out_evertest$year + 0.5 @@ -1040,7 +1040,7 @@ plot_out_evertest_mbyage <- function(mod, fp, likdat, cnt, survey_hts, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, simul = NULL, - plot_legend = TRUE, yr_pred = 2022) { + plot_legend = TRUE, yr_pred = 2023) { graphics::par(mfrow = c(3,2), mar = c(4,4,2,2)) plot_out_nbtest(mod, fp, likdat, cnt, simul, yr_pred) plot_out_nbpostest(mod, fp, likdat, cnt, simul, yr_pred) @@ -1055,7 +1055,7 @@ graphics::par(mfrow = c(3,2), mar = c(4,4,2,2)) ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_strat <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, simul = NULL, - plot_legend = TRUE, yr_pred = 2022) { + plot_legend = TRUE, yr_pred = 2023) { graphics::par(mfrow = c(1,2), mar = c(4,4,2,2)) plot_out_evertest_mbyage(mod, fp, likdat, cnt, survey_hts, out_evertest, simul, plot_legend, yr_pred) plot_out_evertest_fbyage(mod, fp, likdat, cnt, survey_hts, out_evertest, simul, plot_legend, yr_pred) @@ -1076,7 +1076,7 @@ end_of_year <- function(year, value){ ## -- UPDATE HERE -- ## * update year_range to include current year tab_out_evertest <- function(mod, fp, age_grp = '15-49', gender = 'both', - hiv = 'all', year_range = c(2010, 2022), + hiv = 'all', year_range = c(2010, 2023), simul = NULL, end_year = TRUE) { interpolate_output <- end_year && fp$projection_period == "midyear" || @@ -1116,7 +1116,7 @@ tab_out_evertest <- function(mod, fp, age_grp = '15-49', gender = 'both', ## -- UPDATE HERE -- ## * update year_range to include current year tab_out_aware <- function(mod, fp, age_grp = '15-49', gender = 'both', - year_range = c(2010, 2022), simul = NULL, + year_range = c(2010, 2023), simul = NULL, end_year = TRUE) { interpolate_output <- end_year && fp$projection_period == "midyear" || @@ -1167,7 +1167,7 @@ tab_out_aware <- function(mod, fp, age_grp = '15-49', gender = 'both', ## -- UPDATE HERE -- ## * update year_range to include current year tab_out_nbaware <- function(mod, fp, age_grp = '15-49', - gender = 'both', year_range = c(2010, 2022), + gender = 'both', year_range = c(2010, 2023), end_year = TRUE) { interpolate_output <- end_year && fp$projection_period == "midyear" || @@ -1195,7 +1195,7 @@ tab_out_nbaware <- function(mod, fp, age_grp = '15-49', ## -- UPDATE HERE -- ## * update year_range to include current year tab_out_artcov <- function(mod, fp, gender = 'both', - year_range = c(2010, 2022)) { + year_range = c(2010, 2023)) { ## ART coverage is already end-of-year, no need to adjust if (length(year_range) == 1) { @@ -1235,7 +1235,7 @@ tab_out_artcov <- function(mod, fp, gender = 'both', ## ## -- UPDATE HERE -- ## * update year_range to include current year -tab_out_pregprev <- function(mod, fp, year_range = c(2010, 2022), +tab_out_pregprev <- function(mod, fp, year_range = c(2010, 2023), end_year = TRUE) { if (length(year_range) == 1) { diff --git a/R/retest.R b/R/retest.R index ac3ce16..6bd45f6 100644 --- a/R/retest.R +++ b/R/retest.R @@ -14,7 +14,7 @@ #' #' @export -number_retests <- function(mod, fp, df){ +number_retests <- function(mod, fp, df) { tests <- unaware <- aware <- art <- pop <- retests <- numeric(length(df$haidx)) for(i in seq_along(df$haidx)) { @@ -102,7 +102,7 @@ number_retests <- function(mod, fp, df){ ## -- UPDATE HERE -- ## * update yr_pred to current year plot_retest_test_neg <- function(mod, fp, likdat, cnt, relative = F, - yr_pred = 2022, + yr_pred = 2023, plot_title = TRUE) { end_date <- fp$ss$proj_start + fp$ss$PROJ_YEARS - 1L out_retest <- expand.grid(year = 2000:end_date, @@ -165,7 +165,7 @@ plot_retest_test_neg <- function(mod, fp, likdat, cnt, relative = F, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_retest_test_pos <- function(mod, fp, likdat, cnt, relative = F, - yr_pred = 2022, + yr_pred = 2023, plot_legend = TRUE, plot_title = TRUE) { end_date <- fp$ss$proj_start + fp$ss$PROJ_YEARS - 1L out_retest <- expand.grid(year = 2000:end_date, @@ -235,7 +235,7 @@ plot_retest_test_pos <- function(mod, fp, likdat, cnt, relative = F, ## -- UPDATE HERE -- ## * update retest to current year -plot_prv_pos_yld <- function(mod, fp, likdat, cnt, yr_pred = 2022, +plot_prv_pos_yld <- function(mod, fp, likdat, cnt, yr_pred = 2023, plot_legend = TRUE, plot_title = TRUE) { diff --git a/R/table_output.R b/R/table_output.R index 85e4485..cf25d7e 100644 --- a/R/table_output.R +++ b/R/table_output.R @@ -64,10 +64,10 @@ spectrum_output_table <- function(mod, fp) { ## -- UPDATE HERE -- ## * increment year range by one to current year - prb_dx_1yr_m <- pool_prb_dx_one_yr(mod, fp, year = c(2000:2022), + prb_dx_1yr_m <- pool_prb_dx_one_yr(mod, fp, year = c(2000:2023), age = c("15-24","25-34", "35-49", "50-99"), sex = c("male")) - prb_dx_1yr_f <- pool_prb_dx_one_yr(mod, fp, year = c(2000:2022), + prb_dx_1yr_f <- pool_prb_dx_one_yr(mod, fp, year = c(2000:2023), age = c("15-24","25-34", "35-49", "50-99"), sex = c("female")) ## -- UPDATE ABOVE -- diff --git a/R/time_functions.R b/R/time_functions.R index 27a2977..ecd1043 100644 --- a/R/time_functions.R +++ b/R/time_functions.R @@ -6,7 +6,7 @@ ## -- UPDATE HERE -- ## * Increment year by one to include current year -prb_dx_one_yr <- function(fp, year = c(2000:2022), age = "15-24", sex = "male", test_ever = "never", dt = 0.1, version = "R") { +prb_dx_one_yr <- function(fp, year = c(2000:2023), age = "15-24", sex = "male", test_ever = "never", dt = 0.1, version = "R") { if (version == "C") { val <- prb_dx_one_yr_cpp(fp, year = year, age = age, sex = sex, test_ever = test_ever, dt = dt) @@ -137,7 +137,7 @@ prb_dx_one_yr <- function(fp, year = c(2000:2022), age = "15-24", sex = "male", #' @export ## -- UPDATE HERE -- ## * Increment year by one to include current year -pool_prb_dx_one_yr <- function(mod, fp, year = c(2000:2022), +pool_prb_dx_one_yr <- function(mod, fp, year = c(2000:2023), age = c("15-24", "25-34", "35-49", "50-99"), sex = c("male", "female")) { @@ -195,7 +195,7 @@ pool_prb_dx_one_yr <- function(mod, fp, year = c(2000:2022), #' @export ## -- UPDATE HERE -- ## * Increment year by one to include current year -simul_pool_prb_dx_one_yr <- function(samp, mod, fp, year = c(2010:2022), +simul_pool_prb_dx_one_yr <- function(samp, mod, fp, year = c(2010:2023), age = c("15-24", "25-34", "35-49", "50-99"), sex = c("male", "female")) { From 210a1a781354733972a26e92301a104f2ced1c04 Mon Sep 17 00:00:00 2001 From: jeffeaton Date: Fri, 8 Nov 2024 15:02:14 -0500 Subject: [PATCH 2/5] fix end-year net migration in first year ART eligibility --- DESCRIPTION | 2 +- NEWS.md | 4 ++++ R/eppasm.R | 6 +++--- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 057e2b6..e44cb86 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: first90 -Version: 1.6.11 +Version: 1.7.0 Title: The first90 model Description: Implements the Shiny90 model for estimating progress towards the UNAIDS "first 90" target for HIV awareness of status in sub-Saharan Africa. Authors@R: diff --git a/NEWS.md b/NEWS.md index d4ed35e..d74e9d7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# first90 1.7.0 + +* Fix bug in R version for end-year net migration in first year of ART eligibility + # first90 1.6.11 * Update plots and tables to end in 2023. diff --git a/R/eppasm.R b/R/eppasm.R index 2c02eb7..617f62f 100644 --- a/R/eppasm.R +++ b/R/eppasm.R @@ -543,7 +543,7 @@ simmod <- function(fp, VERSION = "C") { hiv.mr.prob <- apply(mr.prob * pop[,,hivp.idx,i], 2, ctapply, ag.idx, sum) / apply(pop[,,hivp.idx,i], 2, ctapply, ag.idx, sum) hiv.mr.prob[is.nan(hiv.mr.prob)] <- 0 - if(i > fp$t_hts_start) { + if(i >= fp$t_hts_start) { hivn.mr.prob <- apply(mr.prob * pop[,,hivn.idx,i], 2, ctapply, ag.idx, sum) / apply(pop[,,hivn.idx,i], 2, ctapply, ag.idx, sum) hivn.mr.prob[is.nan(hivn.mr.prob)] <- 0 } @@ -551,13 +551,13 @@ simmod <- function(fp, VERSION = "C") { pop[,,,i] <- sweep(pop[,,,i], 1:2, mr.prob, "*") hivpop[,,,i] <- sweep(hivpop[,,,i], 2:3, hiv.mr.prob, "*") - if(i > fp$t_hts_start) { + if(i >= fp$t_hts_start) { testnegpop[,, hivn.idx,i] <- testnegpop[,,hivn.idx,i] * hivn.mr.prob testnegpop[,, hivp.idx,i] <- testnegpop[,,hivp.idx,i] * hiv.mr.prob diagnpop[,,,i] <- sweep(diagnpop[,,,i], 2:3, hiv.mr.prob, "*") } - if(i > fp$tARTstart) + if(i >= fp$tARTstart) artpop[,,,,i] <- sweep(artpop[,,,,i], 3:4, hiv.mr.prob, "*") } From 06ab9508b48afeca8adcbf3527f06e89a73c149e Mon Sep 17 00:00:00 2001 From: jeffeaton Date: Fri, 8 Nov 2024 15:21:05 -0500 Subject: [PATCH 3/5] add excess non-AIDS mortality --- NEWS.md | 22 +++++++++ R/create_fp.R | 4 ++ R/eppasm.R | 56 ++++++++++++++++++++-- R/extract-pjnz.R | 42 +++++++++++++++++ src/eppasm.cpp | 118 +++++++++++++++++++++++++++++++++++++++++++---- 5 files changed, 227 insertions(+), 15 deletions(-) diff --git a/NEWS.md b/NEWS.md index d74e9d7..2ca91b9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,27 @@ # first90 1.7.0 +* Implement new excess non-AIDS mortality among PLHIV implemented in + Spectrum 6.38 for 2025 UNAIDS HIV estimates. + + Spectrum 6.38 implements rates of non-AIDS excess mortality by sex, + age group, CD4 category and ART status. By default these mortality rates + are applied in concentrated epidemic countries and defaulted to zero in + African HIV epidemic settings. + + Spectrum outputs for non-AIDS deaths among PLHIV in AIM include non-AIDS + excess deaths. EPP-ASM deaths outputs are updated accordingly. + + To ensure backward compatibility, excess non-AIDS mortality are initialized + to 0.0 and replaced with values read from Spectrum if the relevant values + exist in the .DP file. + + `simmod()` updated to incorporate excess non-AIDS mortality among PLHIV. + Internally new model parameters arrays `cd4_nonaids_excess_mort` and + `art_nonaids_excess_mort` follow the same dimensions and stratification + of `cd4_mort` and `art_mort` arrays. These represent expansions of the + arrays saved in Spectrum-AIM, to all age groups and ART duration categories, + consistent with handling of the `cd4_mort` and `art_mort` arrays. + * Fix bug in R version for end-year net migration in first year of ART eligibility # first90 1.6.11 diff --git a/R/create_fp.R b/R/create_fp.R index 8c61c98..dba6956 100644 --- a/R/create_fp.R +++ b/R/create_fp.R @@ -131,6 +131,10 @@ create_fp <- function(projp, fp$art_mort <- projp$art_mort[,,projp.h.ag,] fp$artmx_timerr <- projp$artmx_timerr + fp$cd4_nonaids_excess_mort <- projp$cd4_nonaids_excess_mort[,projp.h.ag,] + fp$art_nonaids_excess_mort <- array(0.0, dim(fp$art_mort)) + fp$art_nonaids_excess_mort[] <- rep(projp$art_nonaids_excess_mort[,projp.h.ag,], each = hTS) + frr_agecat <- as.integer(rownames(projp$fert_rat)) frr_agecat[frr_agecat == 18] <- 17 fert_rat.h.ag <- findInterval(AGE_START + cumsum(h.ag.span[h.fert.idx]) - h.ag.span[h.fert.idx], frr_agecat) diff --git a/R/eppasm.R b/R/eppasm.R index 617f62f..88aa56a 100644 --- a/R/eppasm.R +++ b/R/eppasm.R @@ -48,6 +48,17 @@ simmod <- function(fp, VERSION = "C") { hivdeaths <- array(0, c(pAG, NG, PROJ_YEARS)) natdeaths <- array(0, c(pAG, NG, PROJ_YEARS)) + excessnonaidsdeaths <- array(0.0, c(pAG, NG, PROJ_YEARS)) + + aidsdeaths_noart <- array(0.0, c(hDS, hAG, NG, PROJ_YEARS)) + natdeaths_noart <- array(0.0, c(hDS, hAG, NG, PROJ_YEARS)) + excessnonaidsdeaths_noart <- array(0.0, c(hDS, hAG, NG, PROJ_YEARS)) + + aidsdeaths_art <- array(0.0, c(hTS, hDS, hAG, NG, PROJ_YEARS)) + natdeaths_art <- array(0.0, c(hTS, hDS, hAG, NG, PROJ_YEARS)) + excessnonaidsdeaths_art <- array(0.0, c(hTS, hDS, hAG, NG, PROJ_YEARS)) + + hivpopdeaths <- array(0, c(hDS, hAG, NG, PROJ_YEARS)) artpopdeaths <- array(0, c(hTS, hDS, hAG, NG, PROJ_YEARS)) @@ -207,12 +218,21 @@ simmod <- function(fp, VERSION = "C") { cd4mx_scale <- hivpop[,,,i] / (hivpop[,,,i] + colSums(artpop[,,,,i])) cd4mx_scale[!is.finite(cd4mx_scale)] <- 1.0 cd4_mort_ts <- fp$cd4_mort * cd4mx_scale - } else + } else { cd4_mort_ts <- fp$cd4_mort + } - grad <- grad - cd4_mort_ts * hivpop[,,,i] # HIV mortality, untreated - hivdeaths.ts <- cd4_mort_ts * hivpop[,,,i] + hivdeaths.ts <- cd4_mort_ts * hivpop[,,,i] # HIV mortality, untreated + grad <- grad - hivdeaths.ts hivdeaths_hAG.ts <- colSums(hivdeaths.ts) + aidsdeaths_noart[,,,i] <- aidsdeaths_noart[,,,i] + DT * hivdeaths.ts + + ## Non-AIDS excess mortality + nonaids_excess.ts <- fp$cd4_nonaids_excess_mort * hivpop[,,,i] + grad <- grad - nonaids_excess.ts + nonaids_excess_hAG.ts <- DT * colSums(nonaids_excess.ts) + excessnonaidsdeaths_noart[,,,i] <- excessnonaidsdeaths_noart[,,,i] + DT * nonaids_excess.ts + ## ---- Distributing new infections in disease model ---- if(fp$eppmod == "directinfections_hts") { @@ -260,6 +280,9 @@ simmod <- function(fp, VERSION = "C") { prop_tn_hivp[!is.finite(prop_tn_hivp)] <- 0.0 grad_tn[ , , hivp.idx] <- grad_tn[ , , hivp.idx] - hivdeaths_hAG.ts * prop_tn_hivp + ## Remove non-AIDS excess deaths among tested negative pop + grad_tn[ , , hivp.idx] <- grad_tn[ , , hivp.idx] - excess_nonaids_hAG.ts * prop_tn_hivp + undiagnosed_i <- (hivpop[,,,i] - diagnpop[,,,i]) prop_testneg <- testnegpop[ , , hivp.idx, i] / colSums(undiagnosed_i) prop_testneg[is.na(prop_testneg) | prop_testneg > 1 | prop_testneg < 0] <- 0 @@ -283,6 +306,7 @@ simmod <- function(fp, VERSION = "C") { grad_diagn[-1,,] <- grad_diagn[-1,,] + fp$cd4_prog * diagnpop[-hDS,,,i] # add cd4 stage progression (untreated) grad_diagn <- grad_diagn - fp$cd4_mort * diagnpop[,,,i] # HIV mortality, untreated + grad_diagn <- grad_diagn - fp$cd4_nonaids_excess_mort * diagnpop[,,,i] # Non-AIDS excess mortality diagnoses[,,,i] <- diagnoses[,,,i] + DT * (diagn_naive + diagn_testneg) @@ -291,7 +315,7 @@ simmod <- function(fp, VERSION = "C") { } hivpop[,,,i] <- hivpop[,,,i] + DT*grad - hivpopdeaths[,,, i] <- hivpopdeaths[,,, i] + DT * hivdeaths.ts + hivpopdeaths[,,, i] <- hivpopdeaths[,,, i] + DT * (hivdeaths.ts + nonaids_excess.ts) ## ART population @@ -308,8 +332,15 @@ simmod <- function(fp, VERSION = "C") { hivdeaths_hAG.ts <- hivdeaths_hAG.ts + colSums(artdeaths.ts,,2) + nonaids_excess_onart.ts <- fp$art_nonaids_excess_mort * artpop[,,,,i] + gradART <- gradART - nonaids_excess_onart.ts + nonaids_excess_hAG.ts <- nonaids_excess_hAG.ts + + DT * colSums(nonaids_excess_onart.ts,,2) + excessnonaidsdeaths_art[,,,,i] <- excessnonaidsdeaths_art[,,,,i] + + DT * nonaids_excess_onart.ts + artpop[,,,, i] <- artpop[,,,, i] + DT * gradART - artpopdeaths[,,,, i] <- artpopdeaths[,,,, i] + DT * artdeaths.ts + artpopdeaths[,,,, i] <- artpopdeaths[,,,, i] + DT * (artdeaths.ts + nonaids_excess_onart.ts) ## ART dropout ## remove proportion from all adult ART groups back to untreated pop @@ -496,6 +527,10 @@ simmod <- function(fp, VERSION = "C") { pop[,,hivp.idx,i] <- pop[,,hivp.idx,i] - hivdeaths_p.ts hivdeaths[,,i] <- hivdeaths[,,i] + hivdeaths_p.ts + nonaids_excess_p.ts <- apply(nonaids_excess_hAG.ts, 2, rep, h.ag.span) * apply(pop[,,hivp.idx,i], 2, calc.agdist) # Non-AIDS excess deaths by single-year age + pop[,,hivp.idx,i] <- pop[,,hivp.idx,i] - nonaids_excess_p.ts + excessnonaidsdeaths[,,i] <- excessnonaidsdeaths[,,i] + nonaids_excess_p.ts + } # ---- End Disease Model ---- @@ -622,6 +657,17 @@ simmod <- function(fp, VERSION = "C") { attr(pop, "hivpopdeaths") <- hivpopdeaths attr(pop, "artpopdeaths") <- artpopdeaths + attr(pop, "excessnonaidsdeaths") <- excessnonaidsdeaths + + attr(pop, "aidsdeaths_noart") <- aidsdeaths_noart + attr(pop, "natdeaths_noart") <- natdeaths_noart + attr(pop, "excessnonaidsdeaths_noart") <- excessnonaidsdeaths_noart + + attr(pop, "aidsdeaths_art") <- aidsdeaths_art + attr(pop, "natdeaths_art") <- natdeaths_art + attr(pop, "excessnonaidsdeaths_art") <- excessnonaidsdeaths_art + + attr(pop, "hivtests") <- hivtests attr(pop, "diagnoses") <- diagnoses attr(pop, "late_diagnoses") <- late_diagnoses diff --git a/R/extract-pjnz.R b/R/extract-pjnz.R index 89436a6..3b92219 100644 --- a/R/extract-pjnz.R +++ b/R/extract-pjnz.R @@ -101,6 +101,9 @@ extract_pjnz <- function(pjnz = NULL, dp_file= NULL, pjn_file = NULL) { v$cd4_mort <- get_dp_cd4_mort(dp) v$art_mort <- get_dp_art_mort(dp) v$artmx_timerr <- get_dp_artmx_timerr(dp, proj_years) + + ## # Excess non-AIDS mortality + v <- c(v, get_dp_nonaids_excessmort(dp)) ## # ART programme data v$art15plus_numperc <- array(as.numeric(unlist(dpsub(dp, "", 4:5, col_idx))), lengths(dn), dn) @@ -607,6 +610,45 @@ get_dp_art_mort <- function(dp) { art_mort } +get_dp_nonaids_excessmort <- function(dp) { + + ## Non-AIDS excess mortality by CD4 + ## * Added in Spectrum 6.37 beta 17 + ## * Initiated to default 0.0; will update witgh values from .DP if tag exists + ## + ## Formatting note from Rob Glaubius: + ## New tag stores the new rates. + ## These are organized into four rows for + ## 1) men off ART, + ## 2) men on ART, + ## 3) women off ART, + ## 4) women on ART. + ## + ## Each row is laid out left-to-right in the same as our other adult HIV-related mortality rates: + ## * 15-24: CD4>500, 350-500, …, <50 + ## * 25-34: CD4>500, 350-500, …, <50 + ## * 35-44: CD4>500, 350-500, …, <50 + ## * 45-54: CD4>500, 350-500, …, <50 + ## + + dn <- list(cd4stage=1:DS, + agecat=c("15-24", "25-34", "35-44", "45+"), + sex=c("male", "female")) + + val <- list() + val$cd4_nonaids_excess_mort <- array(0.0, c(DS, 4, NG), dn) + val$art_nonaids_excess_mort <- array(0.0, c(DS, 4, NG), dn) + + if(exists_dptag(dp, "")) { + val$cd4_nonaids_excess_mort[,,"male"] <- array(as.numeric(dpsub(dp, "", 2, 4:31)), c(DS, 4)) + val$art_nonaids_excess_mort[,,"male"] <- array(as.numeric(dpsub(dp, "", 3, 4:31)), c(DS, 4)) + val$cd4_nonaids_excess_mort[,,"female"] <- array(as.numeric(dpsub(dp, "", 4, 4:31)), c(DS, 4)) + val$art_nonaids_excess_mort[,,"female"] <- array(as.numeric(dpsub(dp, "", 5, 4:31)), c(DS, 4)) + } + + val +} + get_dp_age14hivpop <- function(dp, proj_years) { PAED_DS <- 6 # number of paediatric stages of infection diff --git a/src/eppasm.cpp b/src/eppasm.cpp index 9e9cd32..f25ee66 100644 --- a/src/eppasm.cpp +++ b/src/eppasm.cpp @@ -112,7 +112,9 @@ extern "C" { multi_array_ref cd4_initdist(REAL(getListElement(s_fp, "cd4_initdist")), extents[NG][hAG][hDS]); multi_array_ref cd4_prog(REAL(getListElement(s_fp, "cd4_prog")), extents[NG][hAG][hDS-1]); multi_array_ref cd4_mort(REAL(getListElement(s_fp, "cd4_mort")), extents[NG][hAG][hDS]); + multi_array_ref cd4_nonaids_excess_mort(REAL(getListElement(s_fp, "cd4_nonaids_excess_mort")), extents[NG][hAG][hDS]); multi_array_ref art_mort(REAL(getListElement(s_fp, "art_mort")), extents[NG][hAG][hDS][hTS]); + multi_array_ref art_nonaids_excess_mort(REAL(getListElement(s_fp, "art_nonaids_excess_mort")), extents[NG][hAG][hDS][hTS]); multi_array_ref artmx_timerr(REAL(getListElement(s_fp, "artmx_timerr")), extents[PROJ_YEARS][hTS]); // sub-fertility @@ -285,6 +287,85 @@ extern "C" { multi_array_ref natdeaths(REAL(s_natdeaths), extents[PROJ_YEARS][NG][pAG]); memset(REAL(s_natdeaths), 0, length(s_natdeaths)*sizeof(double)); + SEXP s_excessnonaidsdeaths = PROTECT(allocVector(REALSXP, pAG * NG * PROJ_YEARS)); + SEXP s_excessnonaidsdeaths_dim = PROTECT(allocVector(INTSXP, 3)); + INTEGER(s_excessnonaidsdeaths_dim)[0] = pAG; + INTEGER(s_excessnonaidsdeaths_dim)[1] = NG; + INTEGER(s_excessnonaidsdeaths_dim)[2] = PROJ_YEARS; + setAttrib(s_excessnonaidsdeaths, R_DimSymbol, s_excessnonaidsdeaths_dim); + setAttrib(s_pop, install("excessnonaidsdeaths"), s_excessnonaidsdeaths); + multi_array_ref excessnonaidsdeaths(REAL(s_excessnonaidsdeaths), extents[PROJ_YEARS][NG][pAG]); + memset(REAL(s_excessnonaidsdeaths), 0, length(s_excessnonaidsdeaths)*sizeof(double)); + + SEXP s_aidsdeaths_noart = PROTECT(allocVector(REALSXP, hDS * hAG * NG * PROJ_YEARS)); + SEXP s_aidsdeaths_noart_dim = PROTECT(allocVector(INTSXP, 4)); + INTEGER(s_aidsdeaths_noart_dim)[0] = hDS; + INTEGER(s_aidsdeaths_noart_dim)[1] = hAG; + INTEGER(s_aidsdeaths_noart_dim)[2] = NG; + INTEGER(s_aidsdeaths_noart_dim)[3] = PROJ_YEARS; + setAttrib(s_aidsdeaths_noart, R_DimSymbol, s_aidsdeaths_noart_dim); + setAttrib(s_pop, install("aidsdeaths_noart"), s_aidsdeaths_noart); + multi_array_ref aidsdeaths_noart(REAL(s_aidsdeaths_noart), extents[PROJ_YEARS][NG][hAG][hDS]); + memset(REAL(s_aidsdeaths_noart), 0, length(s_aidsdeaths_noart)*sizeof(double)); + + SEXP s_natdeaths_noart = PROTECT(allocVector(REALSXP, hDS * hAG * NG * PROJ_YEARS)); + SEXP s_natdeaths_noart_dim = PROTECT(allocVector(INTSXP, 4)); + INTEGER(s_natdeaths_noart_dim)[0] = hDS; + INTEGER(s_natdeaths_noart_dim)[1] = hAG; + INTEGER(s_natdeaths_noart_dim)[2] = NG; + INTEGER(s_natdeaths_noart_dim)[3] = PROJ_YEARS; + setAttrib(s_natdeaths_noart, R_DimSymbol, s_natdeaths_noart_dim); + setAttrib(s_pop, install("natdeaths_noart"), s_natdeaths_noart); + multi_array_ref natdeaths_noart(REAL(s_natdeaths_noart), extents[PROJ_YEARS][NG][hAG][hDS]); + memset(REAL(s_natdeaths_noart), 0, length(s_natdeaths_noart)*sizeof(double)); + + SEXP s_excessnonaidsdeaths_noart = PROTECT(allocVector(REALSXP, hDS * hAG * NG * PROJ_YEARS)); + SEXP s_excessnonaidsdeaths_noart_dim = PROTECT(allocVector(INTSXP, 4)); + INTEGER(s_excessnonaidsdeaths_noart_dim)[0] = hDS; + INTEGER(s_excessnonaidsdeaths_noart_dim)[1] = hAG; + INTEGER(s_excessnonaidsdeaths_noart_dim)[2] = NG; + INTEGER(s_excessnonaidsdeaths_noart_dim)[3] = PROJ_YEARS; + setAttrib(s_excessnonaidsdeaths_noart, R_DimSymbol, s_excessnonaidsdeaths_noart_dim); + setAttrib(s_pop, install("excessnonaidsdeaths_noart"), s_excessnonaidsdeaths_noart); + multi_array_ref excessnonaidsdeaths_noart(REAL(s_excessnonaidsdeaths_noart), extents[PROJ_YEARS][NG][hAG][hDS]); + memset(REAL(s_excessnonaidsdeaths_noart), 0, length(s_excessnonaidsdeaths_noart)*sizeof(double)); + + SEXP s_aidsdeaths_art = PROTECT(allocVector(REALSXP, hTS * hDS * hAG * NG * PROJ_YEARS)); + SEXP s_aidsdeaths_art_dim = PROTECT(allocVector(INTSXP, 5)); + INTEGER(s_aidsdeaths_art_dim)[0] = hTS; + INTEGER(s_aidsdeaths_art_dim)[1] = hDS; + INTEGER(s_aidsdeaths_art_dim)[2] = hAG; + INTEGER(s_aidsdeaths_art_dim)[3] = NG; + INTEGER(s_aidsdeaths_art_dim)[4] = PROJ_YEARS; + setAttrib(s_aidsdeaths_art, R_DimSymbol, s_aidsdeaths_art_dim); + setAttrib(s_pop, install("aidsdeaths_art"), s_aidsdeaths_art); + multi_array_ref aidsdeaths_art(REAL(s_aidsdeaths_art), extents[PROJ_YEARS][NG][hAG][hDS][hTS]); + memset(REAL(s_aidsdeaths_art), 0, length(s_aidsdeaths_art)*sizeof(double)); + + SEXP s_natdeaths_art = PROTECT(allocVector(REALSXP, hTS * hDS * hAG * NG * PROJ_YEARS)); + SEXP s_natdeaths_art_dim = PROTECT(allocVector(INTSXP, 5)); + INTEGER(s_natdeaths_art_dim)[0] = hTS; + INTEGER(s_natdeaths_art_dim)[1] = hDS; + INTEGER(s_natdeaths_art_dim)[2] = hAG; + INTEGER(s_natdeaths_art_dim)[3] = NG; + INTEGER(s_natdeaths_art_dim)[4] = PROJ_YEARS; + setAttrib(s_natdeaths_art, R_DimSymbol, s_natdeaths_art_dim); + setAttrib(s_pop, install("natdeaths_art"), s_natdeaths_art); + multi_array_ref natdeaths_art(REAL(s_natdeaths_art), extents[PROJ_YEARS][NG][hAG][hDS][hTS]); + memset(REAL(s_natdeaths_art), 0, length(s_natdeaths_art)*sizeof(double)); + + SEXP s_excessnonaidsdeaths_art = PROTECT(allocVector(REALSXP, hTS * hDS * hAG * NG * PROJ_YEARS)); + SEXP s_excessnonaidsdeaths_art_dim = PROTECT(allocVector(INTSXP, 5)); + INTEGER(s_excessnonaidsdeaths_art_dim)[0] = hTS; + INTEGER(s_excessnonaidsdeaths_art_dim)[1] = hDS; + INTEGER(s_excessnonaidsdeaths_art_dim)[2] = hAG; + INTEGER(s_excessnonaidsdeaths_art_dim)[3] = NG; + INTEGER(s_excessnonaidsdeaths_art_dim)[4] = PROJ_YEARS; + setAttrib(s_excessnonaidsdeaths_art, R_DimSymbol, s_excessnonaidsdeaths_art_dim); + setAttrib(s_pop, install("excessnonaidsdeaths_art"), s_excessnonaidsdeaths_art); + multi_array_ref excessnonaidsdeaths_art(REAL(s_excessnonaidsdeaths_art), extents[PROJ_YEARS][NG][hAG][hDS][hTS]); + memset(REAL(s_excessnonaidsdeaths_art), 0, length(s_excessnonaidsdeaths_art)*sizeof(double)); + // 0: negative, never tested // 1: negative, previously tested // 2: positive, never tested @@ -568,6 +649,9 @@ extern "C" { double hivdeaths_ha[NG][hAG]; memset(hivdeaths_ha, 0, sizeof(double)*NG*hAG); + double nonaids_excess_ha[NG][hAG]; + memset(nonaids_excess_ha, 0, sizeof(double)*NG*hAG); + // untreated population // disease progression and mortality @@ -584,10 +668,15 @@ extern "C" { cd4mx_scale = hivpop[t][g][ha][hm] / (hivpop[t][g][ha][hm] + artpop_hahm); } - double deaths = cd4mx_scale * cd4_mort[g][ha][hm] * hivpop[t][g][ha][hm]; - hivdeaths_ha[g][ha] += DT*deaths; - hivpopdeaths[t][g][ha][hm] += DT*deaths; - grad[g][ha][hm] = -deaths; + double aids_deaths = cd4mx_scale * cd4_mort[g][ha][hm] * hivpop[t][g][ha][hm]; + hivdeaths_ha[g][ha] += DT*aids_deaths; + hivpopdeaths[t][g][ha][hm] += DT*aids_deaths; + + double excess_nonaids_deaths = cd4_nonaids_excess_mort[g][ha][hm] * hivpop[t][g][ha][hm]; + nonaids_excess_ha[g][ha] += DT * excess_nonaids_deaths; + excessnonaidsdeaths_noart[t][g][ha][hm] += DT * excess_nonaids_deaths; + + grad[g][ha][hm] = -(aids_deaths + excess_nonaids_deaths); } for(int hm = 1; hm < hDS; hm++){ grad[g][ha][hm-1] -= cd4_prog[g][ha][hm-1] * hivpop[t][g][ha][hm-1]; @@ -683,6 +772,8 @@ extern "C" { grad_testneg_hivp -= diagn_testneg; diagnoses[t][g][ha][hm] += DT * (diagn_naive + diagn_testneg); grad_diagn[hm] = (diagn_naive + diagn_testneg) - cd4_mort[g][ha][hm] * diagnpop[t][g][ha][hm]; + + grad_diagn[hm] -= cd4_nonaids_excess_mort[g][ha][hm] * diagnpop[t][g][ha][hm]; } for(int hm = 1; hm < hDS; hm++){ grad_diagn[hm-1] -= cd4_prog[g][ha][hm-1] * diagnpop[t][g][ha][hm-1]; @@ -713,10 +804,15 @@ extern "C" { double gradART[hTS]; for(int hu = 0; hu < hTS; hu++){ - double deaths = art_mort[g][ha][hm][hu] * artmx_timerr[t][hu] * artpop[t][g][ha][hm][hu]; - hivdeaths_ha[g][ha] += DT*deaths; - artpopdeaths[t][g][ha][hm][hu] += DT*deaths; - gradART[hu] = -deaths; + double aids_deaths = art_mort[g][ha][hm][hu] * artmx_timerr[t][hu] * artpop[t][g][ha][hm][hu]; + hivdeaths_ha[g][ha] += DT*aids_deaths; + artpopdeaths[t][g][ha][hm][hu] += DT*aids_deaths; + + double nonaids_deaths = art_nonaids_excess_mort[g][ha][hm][hu] * artpop[t][g][ha][hm][hu]; + nonaids_excess_ha[g][ha] += DT * nonaids_deaths; + excessnonaidsdeaths_art[t][g][ha][hm][hu] += DT * nonaids_deaths; + + gradART[hu] = -(aids_deaths + nonaids_deaths); } gradART[ART0MOS] += -ART_STAGE_PROG_RATE * artpop[t][g][ha][hm][ART0MOS]; @@ -1021,9 +1117,11 @@ extern "C" { for(int ha = 0; ha < hAG; ha++){ if(hivpop_ha[ha] > 0){ double hivqx_ha = hivdeaths_ha[g][ha] / hivpop_ha[ha]; + double nonaids_excess_qx_ha = nonaids_excess_ha[g][ha] / hivpop_ha[ha]; for(int i = 0; i < hAG_SPAN[ha]; i++){ hivdeaths[t][g][a] += pop[t][HIVP][g][a] * hivqx_ha; - pop[t][HIVP][g][a] *= (1.0-hivqx_ha); + excessnonaidsdeaths[t][g][a] += pop[t][HIVP][g][a] * nonaids_excess_qx_ha; + pop[t][HIVP][g][a] *= (1.0 - hivqx_ha - nonaids_excess_qx_ha); a++; } } else { @@ -1196,7 +1294,7 @@ extern "C" { incid15to49[t] /= hivn15to49[t-1]; } - UNPROTECT(33); + UNPROTECT(47); return s_pop; } } From f35d1204163180934b1f7191ae2fd562b1420ada Mon Sep 17 00:00:00 2001 From: jeffeaton Date: Fri, 8 Nov 2024 15:35:16 -0500 Subject: [PATCH 4/5] update theta0 with additional knot --- NEWS.md | 2 ++ data-raw/initial-theta0-values.R | 4 +-- data-raw/theta0-2024.csv | 51 +++++++++++++++++++++++++++++++ data/theta0.rda | Bin 546 -> 549 bytes 4 files changed, 55 insertions(+), 2 deletions(-) create mode 100644 data-raw/theta0-2024.csv diff --git a/NEWS.md b/NEWS.md index 2ca91b9..5f28750 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # first90 1.7.0 +* Extend theta0 initial values for additional year random-walk parameters. + * Implement new excess non-AIDS mortality among PLHIV implemented in Spectrum 6.38 for 2025 UNAIDS HIV estimates. diff --git a/data-raw/initial-theta0-values.R b/data-raw/initial-theta0-values.R index 6490a11..c811fe6 100644 --- a/data-raw/initial-theta0-values.R +++ b/data-raw/initial-theta0-values.R @@ -13,7 +13,7 @@ stopifnot(c(par_med_f15to24rate, par_med_diagnrr, par_med_other) == par_med) # Every year new estimates are produced, we need to add one knot # -- UPDATE HERE -- -n_k <- length(2000:2023) +n_k <- length(2000:2024) # -- UPDATE ABOVE -- # Starting parameters @@ -40,4 +40,4 @@ stopifnot(length(theta0) == n_k + n_k-10 + 11) stopifnot(length(theta1) == n_k + n_k-10 + 11) usethis::use_data(theta0, overwrite = TRUE) -write.table(theta0, "theta0-2023.csv", row.names = FALSE, col.names = FALSE) +write.table(theta0, "theta0-2024.csv", row.names = FALSE, col.names = FALSE) diff --git a/data-raw/theta0-2024.csv b/data-raw/theta0-2024.csv new file mode 100644 index 0000000..3823ab0 --- /dev/null +++ b/data-raw/theta0-2024.csv @@ -0,0 +1,51 @@ +-4.94567218324993 +-4.78229328283511 +-4.64800443901616 +-4.44160998803144 +-4.23959585994485 +-3.93677512709652 +-3.55074338832309 +-3.27246008379625 +-2.964937944367 +-2.76935902780989 +-2.68011620841197 +-2.61750469800346 +-2.61531113054939 +-2.68435327035668 +-2.62708160657715 +-2.65753215125499 +-2.61660633759081 +-2.54249854589498 +-2.53392970938711 +-2.6791322530727 +-2.708350714628 +-2.70714552753876 +-2.70714552753876 +-2.70714552753876 +-2.70714552753876 +-1.08775962946703 +-1.08772480067105 +-1.15805339603805 +-1.15802343850473 +-1.13277542331576 +-1.08761874856315 +-1.05602401358226 +-1.13576615787538 +-1.17740794931848 +-1.24659659624302 +-1.2507859983025 +-1.25828973181206 +-1.25828973181206 +-1.25828973181206 +-1.25828973181206 +0.278331499511562 +-0.12435309282136 +-0.961054198918614 +-0.915429925790886 +0.629003776055309 +-0.972852736023532 +-1.09604327785753 +-1.59248602290477 +-1.55588951261081 +-2.53179890376087 +-0.763447877683033 diff --git a/data/theta0.rda b/data/theta0.rda index 43ab951ef4a6a63b2ed648d5cea3df0a346f3a4b..2d31096b323c0743a65eaaf9f36f85059ab32b69 100644 GIT binary patch delta 533 zcmV+w0_y#u1f>KTLRx4!F+o`-Q&};~*aiRqQvd(|_4{G**ME^39DkW?RS}SAG|*@a z(i#m0hJZ8x27mwzfW!g4P%;?+&@=;04AcgPh|&P{2&hc}G5|DadYS+<15F3&fCh~Z zPywbu4Kxh^4KfBso}e@U8&CnKsM?H#Q_>{Kra;q1K+pgh0004?000^WfBK39sxWo;!uc)5s3>B)<7V@N&=NEA;F~pB+Su}Vq(vN)$yb) z`*fZ_0vST2*yx_x9;FRwV7;|d07LqxUf^1$inR&QIi}x1XoK?;Q=IbjLcQDosz@-E zUH~KHoHViuJ@DHW6#5EB`rRMDDY0bOfE|%j8PS5-Q#JajuYcj%F@CZUU_qO*z#bC! zGDrY1TuR1kDnoZ?1IhNQkwb)Er@FkNwezR6H$>y@Is=Uc2_>^ga!=H!$o%;E4uwjtOJ(Hrq=x{!vbNH@&NA zb9D?WMj|DqM{@V=wzAs2-7{(llx5siQ;FN$8A*h@y+nlb=1G%_}m z)IA^o7(fOSKxoO6(lAXlJwc!V&;V!vG&F5OwAD14G|)5}XaVW~GynhtKxk+Ipbt<0 z13&-(0MGz514BbVD1S^sYd4|*ArLW$m5`(%L`0&zLtzm}w4@*$tWT9l48+NaiekTm z*nExWpLfU13QVHcXvakNDC^6gXe1MvY7?eJn|u@ptsYgMWKc2jl={qxIU0i0Vg%ZdG*%zsVv`2iQuX6YNC1$e`B z3>BFJSb`gl%|P7FitYvKIYP@*(W-}Y0bic)gHDrGU`s~YXuPZtCCZT$A>q&?=|0^O zpEODviiMC(d>EE&I6@BsWy8qon66-*p<@^)jFrtqQrM|w^$m*??3I1?#{DmTdHH@b zDs;BMAq_g&^luSm5q$AQySUg26Fxy3+Z)VI+JQ-fYWXwQwMN|8`1_8)A5YJRL58j$ zOQ2)4QzI~IVA0@_xYbD3dxn-Gw%DWzR{E(ih^ziX=*LswM1R5rSWqFs_PK(A=>mj) UKyiIVYJ>b;$rRy2LbS3y{IP`ZZ~y=R From 174bbdfa2dedf563dd473d3af3333c84806c6ce0 Mon Sep 17 00:00:00 2001 From: jeffeaton Date: Fri, 8 Nov 2024 15:40:41 -0500 Subject: [PATCH 5/5] extend outputs to 2024 --- NEWS.md | 2 ++ R/create_hts_param.R | 2 ++ R/inputs.R | 2 +- R/likelihood.R | 6 +++--- R/plot_functions.R | 22 +++++++++++----------- R/plot_outputs.R | 34 +++++++++++++++++----------------- R/retest.R | 6 +++--- R/table_output.R | 4 ++-- R/time_functions.R | 6 +++--- 9 files changed, 44 insertions(+), 40 deletions(-) diff --git a/NEWS.md b/NEWS.md index 5f28750..af1bb5f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # first90 1.7.0 +* Update output plots and tables to 2024. + * Extend theta0 initial values for additional year random-walk parameters. * Implement new excess non-AIDS mortality among PLHIV implemented in diff --git a/R/create_hts_param.R b/R/create_hts_param.R index c9a7010..21a8b5d 100644 --- a/R/create_hts_param.R +++ b/R/create_hts_param.R @@ -48,6 +48,8 @@ create_hts_param <- function(theta, fp) { 2022 } else if (length(theta) == 49) { 2023 + } else if (length(theta) == 51) { + 2024 } else { stop("Unexpected length of parameter vector.") } diff --git a/R/inputs.R b/R/inputs.R index 27742ea..90b34c4 100644 --- a/R/inputs.R +++ b/R/inputs.R @@ -37,7 +37,7 @@ select_prgmdata <- function(prgm_dat, cnt, age_group) { ## * year vector needs to be extended to output results to current year prg_dat <- data.frame(country = cnt, - year = 2010:2023, + year = 2010:2024, agegr = '15-99', sex = 'both', tot = NA, totpos = NA, vct = NA, vctpos = NA, anc = NA, ancpos = NA) diff --git a/R/likelihood.R b/R/likelihood.R index 448ce77..cbcc6a8 100644 --- a/R/likelihood.R +++ b/R/likelihood.R @@ -64,7 +64,7 @@ ll_prgdat <- function(mod, fp, dat) { ## -- UPDATE HERE -- ## * max_year = incremented each year -art_constraint_penalty <- function(mod, fp, max_year = 2023) { +art_constraint_penalty <- function(mod, fp, max_year = 2024) { ind_year <- c(2000:max_year) - fp$ss$proj_start + 1L tot_late <- apply(attr(mod, "late_diagnoses")[,,, ind_year], 4, sum) tot_untreated_pop <- apply(attr(mod, "hivpop")[,,, ind_year], 4, sum) @@ -74,7 +74,7 @@ art_constraint_penalty <- function(mod, fp, max_year = 2023) { return(penalty) } # Include this in ll_hts if you want to incorporate the likelihood constraint on ART. - # val_art_penalty <- art_constraint_penalty(mod, fp, max_year = 2023) + # val_art_penalty <- art_constraint_penalty(mod, fp, max_year = 2024) # val <- val1 + val2 + val3 + val_prior + val_art_penalty # Function to prepare the data for input in the likelihood function. @@ -142,7 +142,7 @@ lprior_hts <- function(theta, mod, fp) { ## -- UPDATE HERE -- ## * Extend knots by 1 year to current year - knots <- 2000:2023 - fp$ss$proj_start + 1L + knots <- 2000:2024 - fp$ss$proj_start + 1L ## -- UPDATE ABOVE -- n_k1 <- length(knots) diff --git a/R/plot_functions.R b/R/plot_functions.R index 0fbc36d..9d69b3c 100644 --- a/R/plot_functions.R +++ b/R/plot_functions.R @@ -19,7 +19,7 @@ get_pjnz_summary_data <- function(fp) { #' ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz_prv <- function(pjnz_summary, yr_pred = 2023) { +plot_pjnz_prv <- function(pjnz_summary, yr_pred = 2024) { pjnz_summary <- stats::na.omit(data.frame(year = pjnz_summary[["year"]], prv = pjnz_summary[["prevalence"]]*100)) pjnz_summary$year <- pjnz_summary$year + 0.5 plot(pjnz_summary$prv ~ pjnz_summary$year, @@ -34,7 +34,7 @@ plot_pjnz_prv <- function(pjnz_summary, yr_pred = 2023) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz_inc <- function(pjnz_summary, yr_pred = 2023) { +plot_pjnz_inc <- function(pjnz_summary, yr_pred = 2024) { pjnz_summary <- stats::na.omit(data.frame(year = pjnz_summary[["year"]], inc = pjnz_summary[["incidence"]]*1000)) pjnz_summary$year <- pjnz_summary$year + 0.5 pjnz_summary <- subset(pjnz_summary, year >= 2000) @@ -50,7 +50,7 @@ plot_pjnz_inc <- function(pjnz_summary, yr_pred = 2023) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz_pop <- function(pjnz_summary, yr_pred = 2023) { +plot_pjnz_pop <- function(pjnz_summary, yr_pred = 2024) { pjnz_summary <- stats::na.omit(data.frame(year = pjnz_summary[["year"]], pop = pjnz_summary[["pop"]]/1000)) pjnz_summary$year <- pjnz_summary$year + 0.5 plot(pjnz_summary$pop ~ pjnz_summary$year, @@ -65,7 +65,7 @@ plot_pjnz_pop <- function(pjnz_summary, yr_pred = 2023) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz_plhiv <- function(pjnz_summary, yr_pred = 2023) { +plot_pjnz_plhiv <- function(pjnz_summary, yr_pred = 2024) { pjnz_summary <- stats::na.omit(data.frame(year = pjnz_summary[["year"]], plhiv = pjnz_summary[["plhiv"]]/1000)) pjnz_summary$year <- pjnz_summary$year + 0.5 plot(pjnz_summary$plhiv ~ pjnz_summary$year, @@ -83,7 +83,7 @@ plot_pjnz_plhiv <- function(pjnz_summary, yr_pred = 2023) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_pjnz <- function(fp, yr_pred = 2023) { +plot_pjnz <- function(fp, yr_pred = 2024) { summary <- get_pjnz_summary_data(fp) graphics::par(mfrow=c(2,2)) plot_pjnz_prv(summary, yr_pred) @@ -126,7 +126,7 @@ combine_rows <- function(prgdat) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_input_tot <- function(prgdat, fp, yr_pred = 2023) { +plot_input_tot <- function(prgdat, fp, yr_pred = 2024) { start <- fp$ss$proj_start mod <- simmod(fp) pop <- apply(mod[1:35,,,], 4, FUN=sum) @@ -157,7 +157,7 @@ plot_input_tot <- function(prgdat, fp, yr_pred = 2023) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_input_totpos <- function(prgdat, fp, yr_pred = 2023) { +plot_input_totpos <- function(prgdat, fp, yr_pred = 2024) { start <- fp$ss$proj_start mod <- simmod(fp) plhiv <- apply(attr(mod, "hivpop")[,1:8,,], 4, FUN = sum) + @@ -201,7 +201,7 @@ plot_input_totpos <- function(prgdat, fp, yr_pred = 2023) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_input_anctot <- function(prgdat, fp, yr_pred = 2023) { +plot_input_anctot <- function(prgdat, fp, yr_pred = 2024) { if (sum(prgdat$anc, na.rm = TRUE) > 0) { prgdat <- subset(prgdat, sex != 'male') @@ -217,7 +217,7 @@ plot_input_anctot <- function(prgdat, fp, yr_pred = 2023) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_input_ancpos <- function(prgdat, fp, yr_pred = 2023) { +plot_input_ancpos <- function(prgdat, fp, yr_pred = 2024) { if (sum(prgdat$ancpos, na.rm = TRUE) > 0) { prgdat <- subset(prgdat, sex != 'male') @@ -235,7 +235,7 @@ plot_input_ancpos <- function(prgdat, fp, yr_pred = 2023) { #' @export ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_inputdata <- function(prgm_dat, fp, yr_pred = 2023) { +plot_inputdata <- function(prgm_dat, fp, yr_pred = 2024) { graphics::par(mfrow = c(2,2)) plot_input_tot(prgm_dat, fp, yr_pred) plot_input_totpos(prgm_dat, fp, yr_pred) @@ -330,7 +330,7 @@ optimized_par <- function(opt, param = NULL) { 'RR re-testing: PLHIV aware (not ART) 2010', ## -- UPDATE HERE -- ## * update label to current year - 'RR re-testing: PLHIV aware (not ART) 2023', + 'RR re-testing: PLHIV aware (not ART) 2024', 'RR re-testing: PLHIV on ART (*RR not ART)', 'RR among 25-34 men', 'RR among 35+ men', diff --git a/R/plot_outputs.R b/R/plot_outputs.R index 11429bf..cdc738c 100644 --- a/R/plot_outputs.R +++ b/R/plot_outputs.R @@ -146,7 +146,7 @@ get_out_pregprev <- function(mod, fp) { ## ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_out_nbtest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2023, +plot_out_nbtest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2024, plot_title = TRUE) { # if fitting with HTS program data stratified by sex, we add both sex back ld <- likdat$hts @@ -237,7 +237,7 @@ plot_out_nbtest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2023, ## ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_out_nbtest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2023) { +plot_out_nbtest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2024) { # redact <- c('Namibia','Uganda','Zambia','Zimbabwe') redact <- c('XXX') @@ -321,7 +321,7 @@ plot_out_nbtest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 20 ## ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_out_nbpostest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2023, +plot_out_nbpostest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2024, plot_title = TRUE) { # if fitting with HTS program data stratified by sex, we add both sex back ld <- likdat$hts @@ -420,7 +420,7 @@ plot_out_nbpostest <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 202 ## ## -- UPDATE HERE -- ## * update yr_pred to current year -plot_out_nbpostest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2023) { +plot_out_nbpostest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = 2024) { # redact <- c('Namibia','Uganda','Zambia','Zimbabwe') redact <- c('XXX') @@ -500,7 +500,7 @@ plot_out_nbpostest_sex <- function(mod, fp, likdat, cnt, simul = NULL, yr_pred = ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_evertestneg <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, - simul = NULL, plot_legend = TRUE, yr_pred = 2023) { + simul = NULL, plot_legend = TRUE, yr_pred = 2024) { out_evertest <- subset(out_evertest, year <= yr_pred) out_evertest$year <- out_evertest$year + 0.5 @@ -580,7 +580,7 @@ plot_out_evertestneg <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_evertestpos <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, - simul = NULL, plot_legend = TRUE, yr_pred = 2023, + simul = NULL, plot_legend = TRUE, yr_pred = 2024, plot_title = TRUE) { out_evertest <- subset(out_evertest, year <= yr_pred) @@ -655,7 +655,7 @@ plot_out_evertestpos <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_evertest <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, - simul = NULL, plot_legend = TRUE, yr_pred = 2023, + simul = NULL, plot_legend = TRUE, yr_pred = 2024, plot_title = TRUE) { out_evertest <- subset(out_evertest, year <= yr_pred) @@ -732,7 +732,7 @@ plot_out_evertest <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_90s <- function(mod, fp, likdat, cnt, out_evertest, survey_hts, - simul = NULL, plot_legend = TRUE, yr_pred = 2023) { + simul = NULL, plot_legend = TRUE, yr_pred = 2024) { phia_aware <- subset(survey_hts, country == cnt & agegr == '15-49' & sex == 'both' & outcome == 'aware') @@ -853,7 +853,7 @@ plot_out_90s <- function(mod, fp, likdat, cnt, out_evertest, survey_hts, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_evertest_fbyage <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, - simul = NULL, plot_legend = TRUE, yr_pred = 2023) { + simul = NULL, plot_legend = TRUE, yr_pred = 2024) { out_evertest <- subset(out_evertest, year <= yr_pred) out_evertest$year <- out_evertest$year + 0.5 @@ -947,7 +947,7 @@ plot_out_evertest_fbyage <- function(mod, fp, likdat, cnt, survey_hts, out_evert ## * update yr_pred to current year plot_out_evertest_mbyage <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, simul = NULL, - plot_legend = TRUE, yr_pred = 2023) { + plot_legend = TRUE, yr_pred = 2024) { out_evertest <- subset(out_evertest, year <= yr_pred) out_evertest$year <- out_evertest$year + 0.5 @@ -1040,7 +1040,7 @@ plot_out_evertest_mbyage <- function(mod, fp, likdat, cnt, survey_hts, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, simul = NULL, - plot_legend = TRUE, yr_pred = 2023) { + plot_legend = TRUE, yr_pred = 2024) { graphics::par(mfrow = c(3,2), mar = c(4,4,2,2)) plot_out_nbtest(mod, fp, likdat, cnt, simul, yr_pred) plot_out_nbpostest(mod, fp, likdat, cnt, simul, yr_pred) @@ -1055,7 +1055,7 @@ graphics::par(mfrow = c(3,2), mar = c(4,4,2,2)) ## -- UPDATE HERE -- ## * update yr_pred to current year plot_out_strat <- function(mod, fp, likdat, cnt, survey_hts, out_evertest, simul = NULL, - plot_legend = TRUE, yr_pred = 2023) { + plot_legend = TRUE, yr_pred = 2024) { graphics::par(mfrow = c(1,2), mar = c(4,4,2,2)) plot_out_evertest_mbyage(mod, fp, likdat, cnt, survey_hts, out_evertest, simul, plot_legend, yr_pred) plot_out_evertest_fbyage(mod, fp, likdat, cnt, survey_hts, out_evertest, simul, plot_legend, yr_pred) @@ -1076,7 +1076,7 @@ end_of_year <- function(year, value){ ## -- UPDATE HERE -- ## * update year_range to include current year tab_out_evertest <- function(mod, fp, age_grp = '15-49', gender = 'both', - hiv = 'all', year_range = c(2010, 2023), + hiv = 'all', year_range = c(2010, 2024), simul = NULL, end_year = TRUE) { interpolate_output <- end_year && fp$projection_period == "midyear" || @@ -1116,7 +1116,7 @@ tab_out_evertest <- function(mod, fp, age_grp = '15-49', gender = 'both', ## -- UPDATE HERE -- ## * update year_range to include current year tab_out_aware <- function(mod, fp, age_grp = '15-49', gender = 'both', - year_range = c(2010, 2023), simul = NULL, + year_range = c(2010, 2024), simul = NULL, end_year = TRUE) { interpolate_output <- end_year && fp$projection_period == "midyear" || @@ -1167,7 +1167,7 @@ tab_out_aware <- function(mod, fp, age_grp = '15-49', gender = 'both', ## -- UPDATE HERE -- ## * update year_range to include current year tab_out_nbaware <- function(mod, fp, age_grp = '15-49', - gender = 'both', year_range = c(2010, 2023), + gender = 'both', year_range = c(2010, 2024), end_year = TRUE) { interpolate_output <- end_year && fp$projection_period == "midyear" || @@ -1195,7 +1195,7 @@ tab_out_nbaware <- function(mod, fp, age_grp = '15-49', ## -- UPDATE HERE -- ## * update year_range to include current year tab_out_artcov <- function(mod, fp, gender = 'both', - year_range = c(2010, 2023)) { + year_range = c(2010, 2024)) { ## ART coverage is already end-of-year, no need to adjust if (length(year_range) == 1) { @@ -1235,7 +1235,7 @@ tab_out_artcov <- function(mod, fp, gender = 'both', ## ## -- UPDATE HERE -- ## * update year_range to include current year -tab_out_pregprev <- function(mod, fp, year_range = c(2010, 2023), +tab_out_pregprev <- function(mod, fp, year_range = c(2010, 2024), end_year = TRUE) { if (length(year_range) == 1) { diff --git a/R/retest.R b/R/retest.R index 6bd45f6..5644513 100644 --- a/R/retest.R +++ b/R/retest.R @@ -102,7 +102,7 @@ number_retests <- function(mod, fp, df) { ## -- UPDATE HERE -- ## * update yr_pred to current year plot_retest_test_neg <- function(mod, fp, likdat, cnt, relative = F, - yr_pred = 2023, + yr_pred = 2024, plot_title = TRUE) { end_date <- fp$ss$proj_start + fp$ss$PROJ_YEARS - 1L out_retest <- expand.grid(year = 2000:end_date, @@ -165,7 +165,7 @@ plot_retest_test_neg <- function(mod, fp, likdat, cnt, relative = F, ## -- UPDATE HERE -- ## * update yr_pred to current year plot_retest_test_pos <- function(mod, fp, likdat, cnt, relative = F, - yr_pred = 2023, + yr_pred = 2024, plot_legend = TRUE, plot_title = TRUE) { end_date <- fp$ss$proj_start + fp$ss$PROJ_YEARS - 1L out_retest <- expand.grid(year = 2000:end_date, @@ -235,7 +235,7 @@ plot_retest_test_pos <- function(mod, fp, likdat, cnt, relative = F, ## -- UPDATE HERE -- ## * update retest to current year -plot_prv_pos_yld <- function(mod, fp, likdat, cnt, yr_pred = 2023, +plot_prv_pos_yld <- function(mod, fp, likdat, cnt, yr_pred = 2024, plot_legend = TRUE, plot_title = TRUE) { diff --git a/R/table_output.R b/R/table_output.R index cf25d7e..eed81f6 100644 --- a/R/table_output.R +++ b/R/table_output.R @@ -64,10 +64,10 @@ spectrum_output_table <- function(mod, fp) { ## -- UPDATE HERE -- ## * increment year range by one to current year - prb_dx_1yr_m <- pool_prb_dx_one_yr(mod, fp, year = c(2000:2023), + prb_dx_1yr_m <- pool_prb_dx_one_yr(mod, fp, year = c(2000:2024), age = c("15-24","25-34", "35-49", "50-99"), sex = c("male")) - prb_dx_1yr_f <- pool_prb_dx_one_yr(mod, fp, year = c(2000:2023), + prb_dx_1yr_f <- pool_prb_dx_one_yr(mod, fp, year = c(2000:2024), age = c("15-24","25-34", "35-49", "50-99"), sex = c("female")) ## -- UPDATE ABOVE -- diff --git a/R/time_functions.R b/R/time_functions.R index ecd1043..ddf484c 100644 --- a/R/time_functions.R +++ b/R/time_functions.R @@ -6,7 +6,7 @@ ## -- UPDATE HERE -- ## * Increment year by one to include current year -prb_dx_one_yr <- function(fp, year = c(2000:2023), age = "15-24", sex = "male", test_ever = "never", dt = 0.1, version = "R") { +prb_dx_one_yr <- function(fp, year = c(2000:2024), age = "15-24", sex = "male", test_ever = "never", dt = 0.1, version = "R") { if (version == "C") { val <- prb_dx_one_yr_cpp(fp, year = year, age = age, sex = sex, test_ever = test_ever, dt = dt) @@ -137,7 +137,7 @@ prb_dx_one_yr <- function(fp, year = c(2000:2023), age = "15-24", sex = "male", #' @export ## -- UPDATE HERE -- ## * Increment year by one to include current year -pool_prb_dx_one_yr <- function(mod, fp, year = c(2000:2023), +pool_prb_dx_one_yr <- function(mod, fp, year = c(2000:2024), age = c("15-24", "25-34", "35-49", "50-99"), sex = c("male", "female")) { @@ -195,7 +195,7 @@ pool_prb_dx_one_yr <- function(mod, fp, year = c(2000:2023), #' @export ## -- UPDATE HERE -- ## * Increment year by one to include current year -simul_pool_prb_dx_one_yr <- function(samp, mod, fp, year = c(2010:2023), +simul_pool_prb_dx_one_yr <- function(samp, mod, fp, year = c(2010:2024), age = c("15-24", "25-34", "35-49", "50-99"), sex = c("male", "female")) {