From e377f4e63fb29950f0cd062db6772972baa99c0a Mon Sep 17 00:00:00 2001 From: jeffeaton Date: Sat, 3 Feb 2024 07:11:40 -0500 Subject: [PATCH 1/3] formatting: spaces before if(...) { --- R/eppasm.R | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/R/eppasm.R b/R/eppasm.R index eb57561..7943a22 100644 --- a/R/eppasm.R +++ b/R/eppasm.R @@ -1,7 +1,7 @@ #' @useDynLib eppasm eppasmC #' @export -simmod.specfp <- function(fp, VERSION="C", ...){ +simmod.specfp <- function(fp, VERSION="C", ...) { if(!exists("popadjust", where=fp)) fp$popadjust <- FALSE @@ -9,7 +9,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ if(!exists("incidmod", where=fp)) fp$incidmod <- "eppspectrum" - if(VERSION != "R"){ + if(VERSION != "R") { ## eppmod codes: ## 0: r-spline @@ -29,7 +29,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ return(mod) } -################################################################################## + ################################################################################## if(requireNamespace("fastmatch", quietly = TRUE)) ctapply <- fastmatch::ctapply @@ -62,7 +62,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ popadj.prob <- array(0, c(pAG, NG, PROJ_YEARS)) - if(fp$eppmod != "directincid_ann"){ + if(fp$eppmod != "directincid_ann") { ## outputs by timestep incrate15to49.ts.out <- rep(NA, length(fp$rvec)) rvec <- if(fp$eppmod == "rtrend") rep(NA, length(fp$proj.steps)) else fp$rvec @@ -90,7 +90,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ ## Add lagged births into youngest age group entrant_prev <- fp$entrantprev[,i] - if(exists("popadjust", where=fp) & fp$popadjust){ + if(exists("popadjust", where=fp) & fp$popadjust) { hivn_entrants <- fp$entrantpop[,i-1]*(1-entrant_prev) hivp_entrants <- fp$entrantpop[,i-1]*entrant_prev } else { @@ -112,7 +112,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ hivpop[,-1,,i] <- hivpop[,-1,,i] + sweep(hivpop[,-hAG,,i-1], 2:3, hiv.ag.prob[-hAG,], "*") hivpop[,1,,i] <- hivpop[,1,,i] + sweep(fp$paedsurv_cd4dist[,,i], 2, hivp_entrants * (1-fp$entrantartcov[,i]), "*") - if(i > fp$tARTstart){ + if(i > fp$tARTstart) { artpop[,,,,i] <- artpop[,,,,i-1] artpop[,,-hAG,,i] <- artpop[,,-hAG,,i] - sweep(artpop[,,-hAG,,i-1], 3:4, hiv.ag.prob[-hAG,], "*") artpop[,,-1,,i] <- artpop[,,-1,,i] + sweep(artpop[,,-hAG,,i-1], 3:4, hiv.ag.prob[-hAG,], "*") @@ -213,7 +213,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ grad[-hDS,,] <- grad[-hDS,,] - fp$cd4_prog * hivpop[-hDS,,,i] # remove cd4 stage progression (untreated) grad[-1,,] <- grad[-1,,] + fp$cd4_prog * hivpop[-hDS,,,i] # add cd4 stage progression (untreated) - if(fp$scale_cd4_mort == 1){ + if(fp$scale_cd4_mort == 1) { 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 @@ -255,7 +255,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ art15plus.elig <- sweep(hivpop[,h.age15plus.idx,,i], 1, artcd4_percelig, "*") ## calculate pregnant women - if(fp$pw_artelig[i]){ + if(fp$pw_artelig[i]) { births.dist <- sweep(fp$frr_cd4[,,i] * hivpop[,h.fert.idx,f.idx,i], 2, births.by.h.age / (ctapply(pop[p.fert.idx, f.idx, hivn.idx, i], ag.idx[p.fert.idx], sum) + colSums(fp$frr_cd4[,,i] * hivpop[,h.fert.idx,f.idx,i]) + colSums(fp$frr_art[,,,i] * artpop[ ,,h.fert.idx,f.idx,i],,2)), "*") if(fp$artcd4elig_idx[i] > 1) @@ -266,14 +266,14 @@ simmod.specfp <- function(fp, VERSION="C", ...){ artpop_curr_g <- colSums(artpop[,,h.age15plus.idx,,i],,3) + DT*colSums(gradART[,,h.age15plus.idx,],,3) artnum.ii <- c(0,0) # number on ART this ts - if (fp$projection_period == "midyear" && DT*ii < 0.5){ + if (fp$projection_period == "midyear" && DT*ii < 0.5) { for(g in 1:2){ - if(!any(fp$art15plus_isperc[g,i-2:1])){ # both number + if(!any(fp$art15plus_isperc[g,i-2:1])) { # both number artnum.ii[g] <- c(fp$art15plus_num[g,i-2:1] %*% c(1-(DT*ii+0.5), DT*ii+0.5)) - } else if(all(fp$art15plus_isperc[g,i-2:1])){ # both percentage + } else if(all(fp$art15plus_isperc[g,i-2:1])) { # both percentage artcov.ii <- c(fp$art15plus_num[g,i-2:1] %*% c(1-(DT*ii+0.5), DT*ii+0.5)) artnum.ii[g] <- artcov.ii * (sum(art15plus.elig[,,g]) + artpop_curr_g[g]) - } else if(!fp$art15plus_isperc[g,i-2] & fp$art15plus_isperc[g,i-1]){ # transition number to percentage + } else if(!fp$art15plus_isperc[g,i-2] & fp$art15plus_isperc[g,i-1]) { # transition number to percentage curr_coverage <- artpop_curr_g[g] / (sum(art15plus.elig[,,g]) + artpop_curr_g[g]) artcov.ii <- curr_coverage + (fp$art15plus_num[g,i-1] - curr_coverage) * DT/(0.5-DT*(ii-1)) artnum.ii[g] <- artcov.ii * (sum(art15plus.elig[,,g]) + artpop_curr_g[g]) @@ -286,12 +286,12 @@ simmod.specfp <- function(fp, VERSION="C", ...){ art_interp_w <- art_interp_w - 0.5 } - if(!any(fp$art15plus_isperc[g,i-1:0])){ # both number + if(!any(fp$art15plus_isperc[g,i-1:0])) { # both number artnum.ii[g] <- c(fp$art15plus_num[g,i-1:0] %*% c(1-art_interp_w, art_interp_w)) } else if(all(fp$art15plus_isperc[g,i-1:0])) { # both percentage artcov.ii <- c(fp$art15plus_num[g,i-1:0] %*% c(1-art_interp_w, art_interp_w)) artnum.ii[g] <- artcov.ii * (sum(art15plus.elig[,,g]) + artpop_curr_g[g]) - } else if(!fp$art15plus_isperc[g,i-1] & fp$art15plus_isperc[g,i]){ # transition number to percentage + } else if(!fp$art15plus_isperc[g,i-1] & fp$art15plus_isperc[g,i]) { # transition number to percentage curr_coverage <- artpop_curr_g[g] / (sum(art15plus.elig[,,g]) + artpop_curr_g[g]) artcov.ii <- curr_coverage + (fp$art15plus_num[g,i] - curr_coverage) * DT/(1.0 - art_interp_w + DT) artnum.ii[g] <- artcov.ii * (sum(art15plus.elig[,,g]) + artpop_curr_g[g]) @@ -303,9 +303,9 @@ simmod.specfp <- function(fp, VERSION="C", ...){ art15plus.inits <- pmax(artnum.ii - artpop_curr_g, 0) ## calculate ART initiation distribution - if(!fp$med_cd4init_input[i]){ + if(!fp$med_cd4init_input[i]) { - if(fp$art_alloc_method == 4L){ ## by lowest CD4 + if(fp$art_alloc_method == 4L) { ## by lowest CD4 ## Calculate proportion to be initiated in each CD4 category artinit <- array(0, dim(art15plus.elig)) @@ -383,7 +383,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ ## incrate15to49.i <- (fp$prev15to49[i] - prev.i)/(1-prev.i) ## Direct incidence input - if(fp$eppmod == "directincid_ann"){ + if(fp$eppmod == "directincid_ann") { agesex.inc <- sweep(fp$incrr_age[,,i], 2, sexinc/(colSums(pop[p.incidpop.idx,,hivn.idx,i] * fp$incrr_age[p.incidpop.idx,,i])/colSums(pop[p.incidpop.idx,,hivn.idx,i-1])), "*") infections[,,i] <- agesex.inc * pop[,,hivn.idx,i] pop[,,hivn.idx,i] <- pop[,,hivn.idx,i] - infections[,,i] @@ -409,7 +409,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ ## adjust population to match target population size - if(exists("popadjust", where=fp) & fp$popadjust){ + if(exists("popadjust", where=fp) & fp$popadjust) { popadj.prob[,,i] <- fp$targetpop[,,i] / rowSums(pop[,,,i],,2) hiv.popadj.prob <- apply(popadj.prob[,,i] * pop[,,2,i], 2, ctapply, ag.idx, sum) / apply(pop[,,2,i], 2, ctapply, ag.idx, sum) hiv.popadj.prob[is.nan(hiv.popadj.prob)] <- 0 @@ -456,7 +456,7 @@ simmod.specfp <- function(fp, VERSION="C", ...){ attr(pop, "pregprevlag") <- pregprevlag - if(fp$eppmod != "directincid_ann"){ + if(fp$eppmod != "directincid_ann") { attr(pop, "incrate15to49_ts") <- incrate15to49.ts.out attr(pop, "prev15to49_ts") <- prev15to49.ts.out } From ace6cba773f52590f7527d0d993eebfb3e452047 Mon Sep 17 00:00:00 2001 From: jeffeaton Date: Sat, 3 Feb 2024 08:21:06 -0500 Subject: [PATCH 2/3] add CD4 recovervy on ART dropout for those >1 year ART --- DESCRIPTION | 2 +- NEWS.md | 4 +++ R/eppasm.R | 13 +++++++++- R/spectrum.R | 66 ++++++++++++++++++++++++++++---------------------- src/eppasm.cpp | 10 +++++++- 5 files changed, 63 insertions(+), 32 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c63c3f5..3f4fa76 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: eppasm Title: Age-structured EPP Model for HIV Epidemic Estimates -Version: 0.7.3 +Version: 0.7.4 Authors@R: person("Jeff", "Eaton", email = "jeffrey.eaton@imperial.ac.uk", role = c("aut", "cre")) Description: What the package does (one paragraph). Depends: R (>= 3.1.0), diff --git a/NEWS.md b/NEWS.md index bba5e7d..b7bf6ce 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +## eppasm 0.7.4 + +* Implement recovery to next higher CD4 category following ART interruption for those on ART greater than one year. + ## eppasm 0.7.3 * Bug fix: account for end-year net migration in the ART population in the first year of ART start. diff --git a/R/eppasm.R b/R/eppasm.R index 7943a22..f9942d6 100644 --- a/R/eppasm.R +++ b/R/eppasm.R @@ -244,7 +244,18 @@ simmod.specfp <- function(fp, VERSION="C", ...) { ## ART dropout ## remove proportion from all adult ART groups back to untreated pop - grad <- grad + fp$art_dropout[i]*colSums(artpop[,,,,i]) + art_dropout_ii <- fp$art_dropout[i]*colSums(artpop[1:2,,,,i]) + if (fp$art_dropout_recover_cd4) { + art_dropout_ii[1,,] <- art_dropout_ii[1,,] + + fp$art_dropout[i] * artpop[3:fp$ss$hTS,1,,,i] + art_dropout_ii[-fp$ss$hDS,,] <- art_dropout_ii[-fp$ss$hDS,,] + + fp$art_dropout[i] * artpop[3:fp$ss$hTS,-1,,,i] + } else { + art_dropout_ii <- art_dropout_ii + + fp$art_dropout[i] * artpop[3:fp$ss$hTS,,,,i] + } + + grad <- grad + art_dropout_ii gradART <- gradART - fp$art_dropout[i]*artpop[,,,,i] ## calculate number eligible for ART diff --git a/R/spectrum.R b/R/spectrum.R index 786c3e0..4ef69ae 100644 --- a/R/spectrum.R +++ b/R/spectrum.R @@ -11,7 +11,8 @@ create_spectrum_fixpar <- function(projp, demp, hiv_steps_per_year = 10L, proj_s AGE_START = 15L, relinfectART = projp$relinfectART, time_epi_start = projp$t0, popadjust=FALSE, targetpop=demp$basepop, artelig200adj=TRUE, who34percelig=0, frr_art6mos=projp$frr_art6mos, frr_art1yr=projp$frr_art6mos, - projection_period = NULL){ + projection_period = NULL, + art_dropout_recover_cd4 = NULL) { ## ########################## ## ## Define model state space ## @@ -150,7 +151,7 @@ create_spectrum_fixpar <- function(projp, demp, hiv_steps_per_year = 10L, proj_s ## set population adjustment fp$popadjust <- popadjust - if(!length(setdiff(proj_start:proj_end, dimnames(targetpop)[[3]]))){ + if(!length(setdiff(proj_start:proj_end, dimnames(targetpop)[[3]]))) { fp$entrantpop <- targetpop[AGE_START,,as.character(proj_start:proj_end)] fp$targetpop <- targetpop[(AGE_START+1):81,,as.character(proj_start:proj_end)] } @@ -214,6 +215,12 @@ create_spectrum_fixpar <- function(projp, demp, hiv_steps_per_year = 10L, proj_s ## percentage of those with CD4 <350 who are based on WHO Stage III/IV infection fp$who34percelig <- who34percelig + if (is.null(art_dropout_recover_cd4)) { + fp$art_dropout_recover_cd4 <- if (projp$spectrum_version >= "6.2") {TRUE} else {FALSE} + } else { + fp$art_dropout_recover_cd4 <- art_dropout_recover_cd4 + } + fp$art_dropout <- projp$art_dropout[as.character(proj_start:proj_end)]/100 fp$median_cd4init <- projp$median_cd4init[as.character(proj_start:proj_end)] fp$med_cd4init_input <- as.integer(fp$median_cd4init > 0) @@ -275,7 +282,7 @@ create_spectrum_fixpar <- function(projp, demp, hiv_steps_per_year = 10L, proj_s ## ART eligibility category. for(i in 2:PROJ_YEARS){ idx <- fp$artcd4elig_idx[i] - if(idx > 1){ + if(idx > 1) { fp$paedsurv_artcd4dist[ , idx, , i] <- fp$paedsurv_artcd4dist[ , idx, , i] + c(apply(fp$paedsurv_artcd4dist[ , 1:(idx-1), , i, drop=FALSE], c(1,3,4), sum)) fp$paedsurv_artcd4dist[,1:(idx-1),,i] <- 0 @@ -297,7 +304,7 @@ create_spectrum_fixpar <- function(projp, demp, hiv_steps_per_year = 10L, proj_s } -prepare_rtrend_model <- function(fp, iota=0.0025){ +prepare_rtrend_model <- function(fp, iota=0.0025) { fp$iota <- iota fp$tsEpidemicStart <- NULL fp$eppmod <- "rtrend" @@ -305,7 +312,7 @@ prepare_rtrend_model <- function(fp, iota=0.0025){ } -prepare_rspline_model <- function(fp, numKnots=NULL, tsEpidemicStart=fp$ss$time_epi_start+0.5){ +prepare_rspline_model <- function(fp, numKnots=NULL, tsEpidemicStart=fp$ss$time_epi_start+0.5) { if(!exists("numKnots", fp)) fp$numKnots <- 7 @@ -328,7 +335,7 @@ prepare_rspline_model <- function(fp, numKnots=NULL, tsEpidemicStart=fp$ss$time_ #' @export -update.specfp <- function (object, ..., keep.attr = TRUE, list = vector("list")){ +update.specfp <- function (object, ..., keep.attr = TRUE, list = vector("list")) { dots <- substitute(list(...))[-1] newnames <- names(dots) for (j in seq_along(dots)) { @@ -397,7 +404,7 @@ calc_pregprev <- function(mod, fp){ #' @return 3-dimensional array of mortality by age, sex, and year. #' #' @export -agemx.spec <- function(mod, nonhiv=FALSE){ +agemx.spec <- function(mod, nonhiv=FALSE) { if(nonhiv) deaths <- attr(mod, "natdeaths") else @@ -426,7 +433,7 @@ agemx.spec <- function(mod, nonhiv=FALSE){ #' @return 3-dimensional array of mortality by age, sex, and year. #' #' @export -natagemx.spec <- function(mod){ +natagemx.spec <- function(mod) { deaths <- attr(mod, "natdeaths") pop <- mod[,,1,]+ mod[,,2,] @@ -436,7 +443,7 @@ natagemx.spec <- function(mod){ return(mx) } -hivagemx.spec <- function(mod){ +hivagemx.spec <- function(mod) { deaths <- attr(mod, "natdeaths") pop <- mod[,,1,]+ mod[,,2,] @@ -457,12 +464,12 @@ hivagemx.spec <- function(mod){ #' @useDynLib eppasm ageprevC #' @export #' -ageprev <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, expand=FALSE, VERSION="C"){ +ageprev <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, expand=FALSE, VERSION="C") { if(length(agspan)==1) agspan <- rep(agspan, length(aidx)) - if(expand){ + if(expand) { dimout <- c(length(aidx), length(sidx), length(yidx)) df <- expand.grid(aidx=aidx, sidx=sidx, yidx=yidx) aidx <- df$aidx @@ -485,7 +492,7 @@ ageprev <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, expand=FALSE ## Add M/F entries with same id if sidx = 0. ## This is probably a pretty inefficient way of doing this... - if(any(idx$sidx == 0)){ + if(any(idx$sidx == 0)) { idx <- rbind(idx[idx$sidx != 0,], transform(idx[idx$sidx == 0,], sidx = 1), transform(idx[idx$sidx == 0,], sidx = 2)) idx <- idx[order(idx$gidx, idx$sidx),] } @@ -512,9 +519,9 @@ ageprev <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, expand=FALSE return(prev) } -ageincid <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, arridx=NULL){ +ageincid <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, arridx=NULL) { - if(is.null(arridx)){ + if(is.null(arridx)) { if(length(agspan)==1) agspan <- rep(agspan, length(aidx)) @@ -523,7 +530,7 @@ ageincid <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, arridx=NULL arridx_inf <- idx$aidx + (idx$sidx-1)*dims[1] + (idx$yidx-1)*dims[1]*dims[2] arridx_hivn <- idx$aidx + (idx$sidx-1)*dims[1] + (pmax(idx$yidx-2, 0))*dims[1]*dims[2] agspan <- rep(agspan, times=length(sidx)*length(yidx)) - } else if(length(agspan)==1){ + } else if(length(agspan)==1) { ## arridx_hivn NEED ADJUST arridx FOR PREVIOUS YEAR agspan <- rep(agspan, length(arridx)) } @@ -543,9 +550,9 @@ ageincid <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, arridx=NULL } -ageinfections <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, arridx=NULL){ +ageinfections <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, arridx=NULL) { - if(is.null(arridx)){ + if(is.null(arridx)) { if(length(agspan)==1) agspan <- rep(agspan, length(aidx)) @@ -554,7 +561,7 @@ ageinfections <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, arridx arridx_inf <- idx$aidx + (idx$sidx-1)*dims[1] + (idx$yidx-1)*dims[1]*dims[2] arridx_hivn <- idx$aidx + (idx$sidx-1)*dims[1] + (pmax(idx$yidx-2, 0))*dims[1]*dims[2] agspan <- rep(agspan, times=length(sidx)*length(yidx)) - } else if(length(agspan)==1){ + } else if(length(agspan)==1) { ## arridx_hivn NEED ADJUST arridx FOR PREVIOUS YEAR agspan <- rep(agspan, length(arridx)) } @@ -570,9 +577,9 @@ ageinfections <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, arridx } ageartcov <- function(mod, aidx=NULL, sidx=NULL, yidx=NULL, agspan=5, arridx=NULL, - h.ag.span=c(2, 3, 5, 5, 5, 5, 5, 5, 31)){ + h.ag.span=c(2, 3, 5, 5, 5, 5, 5, 5, 31)) { - if(is.null(arridx)){ + if(is.null(arridx)) { if(length(agspan)==1) agspan <- rep(agspan, length(aidx)) @@ -620,13 +627,13 @@ agepregprev <- function(mod, fp, aidx=3:9*5-fp$ss$AGE_START+1L, yidx=1:fp$ss$PROJ_YEARS, agspan=5, - expand=FALSE){ + expand=FALSE) { sidx <- fp$ss$f.idx # only women get pregnant if(length(agspan)==1) agspan <- rep(agspan, length(aidx)) - if(expand){ + if(expand) { idx <- expand.grid(aidx=aidx, sidx=sidx, yidx=yidx) idx$agspan <- rep(agspan, times=length(sidx)*length(yidx)) } else @@ -670,17 +677,18 @@ agepregartcov <- function(mod, fp, aidx=3:9*5-fp$ss$AGE_START+1L, yidx=1:fp$ss$PROJ_YEARS, agspan=5, - expand=FALSE){ + expand=FALSE) { sidx <- fp$ss$f.idx # only women get pregnant if(length(agspan)==1) agspan <- rep(agspan, length(aidx)) - if(expand){ + if(expand) { idx <- expand.grid(aidx=aidx, sidx=sidx, yidx=yidx) idx$agspan <- rep(agspan, times=length(sidx)*length(yidx)) - } else + } else { idx <- data.frame(aidx=aidx, sidx=sidx, yidx=yidx, agspan=agspan) + } idx$id <- seq_len(nrow(idx)) @@ -716,13 +724,13 @@ agepregartcov <- function(mod, fp, -incid_sexratio.spec <- function(mod){ +incid_sexratio.spec <- function(mod) { inc <- ageincid(mod, 1, 1:2, seq_len(dim(mod)[4]), 35)[,,] inc[2,] / inc[1,] } -calc_nqx.spec <- function(mod, fp, n=45, x=15, nonhiv=FALSE){ +calc_nqx.spec <- function(mod, fp, n=45, x=15, nonhiv=FALSE) { mx <- agemx(mod, nonhiv) return(1-exp(-colSums(mx[x+1:n-fp$ss$AGE_START,,]))) } @@ -733,14 +741,14 @@ artpop15to49.spec <- function(mod){colSums(attr(mod, "artpop")[,,1:8,,],,4)} artpop15plus.spec <- function(mod){colSums(attr(mod, "artpop"),,4)} #' @export -artcov15to49.spec <- function(mod, sex=1:2, ...){ +artcov15to49.spec <- function(mod, sex=1:2, ...) { n_art <- colSums(attr(mod, "artpop")[,,1:8,sex,,drop=FALSE],,4) n_hiv <- colSums(attr(mod, "hivpop")[,1:8,sex,,drop=FALSE],,3) return(n_art / (n_hiv+n_art)) } #' @export -artcov15plus.spec <- function(mod, sex=1:2, ...){ +artcov15plus.spec <- function(mod, sex=1:2, ...) { n_art <- colSums(attr(mod, "artpop")[,,,sex,,drop=FALSE],,4) n_hiv <- colSums(attr(mod, "hivpop")[,,sex,,drop=FALSE],,3) return(n_art / (n_hiv+n_art)) diff --git a/src/eppasm.cpp b/src/eppasm.cpp index c387ef0..55906f3 100644 --- a/src/eppasm.cpp +++ b/src/eppasm.cpp @@ -147,6 +147,7 @@ extern "C" { double *pw_artelig = REAL(getListElement(s_fp, "pw_artelig")); double who34percelig = *REAL(getListElement(s_fp, "who34percelig")); + int bin_art_dropout_recover_cd4 = *INTEGER(getListElement(s_fp, "art_dropout_recover_cd4")); double *art_dropout = REAL(getListElement(s_fp, "art_dropout")); double *median_cd4init = REAL(getListElement(s_fp, "median_cd4init")); @@ -708,7 +709,14 @@ extern "C" { // ART dropout if(art_dropout[t] > 0) for(int hu = 0; hu < hTS; hu++){ - grad[g][ha][hm] += art_dropout[t] * artpop[t][g][ha][hm][hu]; + + if (bin_art_dropout_recover_cd4 && hu >= 2 && hm >= 1) { + // recover people on ART >1 year to one higher CD4 category + grad[g][ha][hm-1] += art_dropout[t] * artpop[t][g][ha][hm][hu]; + } else { + grad[g][ha][hm] += art_dropout[t] * artpop[t][g][ha][hm][hu]; + } + gradART[g][ha][hm][hu] -= art_dropout[t] * artpop[t][g][ha][hm][hu]; } From 237894e9771b65f629e7825c0a4e1937d1661dee Mon Sep 17 00:00:00 2001 From: jeffeaton Date: Sat, 3 Feb 2024 12:22:17 -0500 Subject: [PATCH 3/3] change Spectrum version for CD4 recovery to 6.14 --- R/spectrum.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/spectrum.R b/R/spectrum.R index 4ef69ae..1edbc0f 100644 --- a/R/spectrum.R +++ b/R/spectrum.R @@ -216,7 +216,7 @@ create_spectrum_fixpar <- function(projp, demp, hiv_steps_per_year = 10L, proj_s fp$who34percelig <- who34percelig if (is.null(art_dropout_recover_cd4)) { - fp$art_dropout_recover_cd4 <- if (projp$spectrum_version >= "6.2") {TRUE} else {FALSE} + fp$art_dropout_recover_cd4 <- if (projp$spectrum_version >= "6.14") {TRUE} else {FALSE} } else { fp$art_dropout_recover_cd4 <- art_dropout_recover_cd4 }