Final CombPrev version for AIDS paper

EpiModel · Aug 26, 2020 · 26ea27a · 26ea27a
1 parent 6983182
commit 26ea27a
Show file tree

Hide file tree

Showing 2 changed files with 48 additions and 3 deletions.
diff --git a/R/mod.hivtrans.R b/R/mod.hivtrans.R
@@ -48,6 +48,7 @@ hivtrans_msm <- function(dat, at) {
   rCT <- dat$attr$rCT
   uCT <- dat$attr$uCT
   race <- dat$attr$race
+  tx.status <- dat$attr$tx.status
 
   # Parameters
   URAI.prob <- dat$param$URAI.prob
@@ -88,6 +89,7 @@ hivtrans_msm <- function(dat, at) {
   # Attributes of infected
   ip.vl <- vl[disc.ip[, 1]]
   ip.stage <- stage[disc.ip[, 1]]
+  ip.txStat <- tx.status[disc.ip[, 1]]
 
   # Attributes of susceptible
   ip.prep <- prepStat[disc.ip[, 2]]
@@ -98,6 +100,10 @@ hivtrans_msm <- function(dat, at) {
   # Base TP from VL
   ip.tprob <- pmin(0.99, URAI.prob * 2.45^(ip.vl - 4.5))
 
+  # Adjustment (based on Supervie JAIDS) for VL Suppressed, on ART
+  ip.noTrans <- which(ip.vl <= log10(200) & ip.txStat == 1)
+  ip.tprob[ip.noTrans] <- 2.2/1e5
+
   # Transform to log odds
   ip.tlo <- log(ip.tprob/(1 - ip.tprob))
 
@@ -145,6 +151,7 @@ hivtrans_msm <- function(dat, at) {
   # Attributes of infected
   rp.vl <- vl[disc.rp[, 2]]
   rp.stage <- stage[disc.rp[, 2]]
+  rp.txStat <- tx.status[disc.rp[, 2]]
 
   # Attributes of susceptible
   rp.circ <- circ[disc.rp[, 1]]
@@ -156,6 +163,10 @@ hivtrans_msm <- function(dat, at) {
   # Base TP from VL
   rp.tprob <- pmin(0.99, UIAI.prob * 2.45^(rp.vl - 4.5))
 
+  # Adjustment (based on Supervie JAIDS) for VL Suppressed, on ART
+  rp.noTrans <- which(rp.vl <= log10(200) & rp.txStat == 1)
+  rp.tprob[rp.noTrans] <- 2.2/1e5
+
   # Transform to log odds
   rp.tlo <- log(rp.tprob/(1 - rp.tprob))
 
@@ -226,20 +237,37 @@ hivtrans_msm <- function(dat, at) {
     dat$attr$cuml.time.off.tx[infected] <- 0
 
     # Attributes of transmitter
-    transmitter <- c(disc.ip[trans.ip == 1, 1],
-                     disc.rp[trans.rp == 1, 2])
+    transmitter <- as.numeric(c(disc.ip[trans.ip == 1, 1],
+                                disc.rp[trans.rp == 1, 2]))
     tab.trans <- table(transmitter)
     uni.trans <- as.numeric(names(tab.trans))
     dat$attr$count.trans[uni.trans] <- dat$attr$count.trans[uni.trans] +
                                        as.numeric(tab.trans)
-  }
+   }
 
   # Summary Output
   dat$epi$incid[at] <- length(infected)
   dat$epi$incid.B[at] <- sum(dat$attr$race[infected] == 1)
   dat$epi$incid.H[at] <- sum(dat$attr$race[infected] == 2)
   dat$epi$incid.W[at] <- sum(dat$attr$race[infected] == 3)
 
+  if (length(infected) > 0) {
+    dat$epi$incid.undx[at] <- sum(dat$attr$diag.status[transmitter] == 0)
+    dat$epi$incid.dx[at] <- sum(dat$attr$diag.status[transmitter] == 1 &
+                                dat$attr$cuml.time.on.tx[transmitter] == 0)
+    dat$epi$incid.linked[at] <- sum(dat$attr$diag.status[transmitter] == 1 &
+                                    dat$attr$cuml.time.on.tx[transmitter] > 0 &
+                                    dat$attr$vl[transmitter] > log10(200))
+    dat$epi$incid.vsupp[at] <- sum(dat$attr$diag.status[transmitter] == 1 &
+                                   dat$attr$cuml.time.on.tx[transmitter] > 0 &
+                                   dat$attr$vl[transmitter] <= log10(200))
+  } else {
+    dat$epi$incid.undx[at] <- 0
+    dat$epi$incid.dx[at] <- 0
+    dat$epi$incid.linked[at] <- 0
+    dat$epi$incid.vsupp[at] <- 0
+  }
+
   return(dat)
 }
 

diff --git a/R/mod.prevalence.R b/R/mod.prevalence.R
@@ -178,6 +178,23 @@ prevalence_msm <- function(dat, at) {
   dat$epi$cc.dx.delay.int.W[at] <- mean(diag.time[diag.time >= 3380 & race == 3] -
                                       inf.time[diag.time >= 3380 & race == 3], na.rm = TRUE)
 
+  # same as above, but with medians
+  dat$epi$cc.dx.delay.med[at] <- median(diag.time[diag.time >= 2] - inf.time[diag.time >= 2], na.rm = TRUE)
+  dat$epi$cc.dx.delay.B.med[at] <- median(diag.time[diag.time >= 2 & race == 1] -
+                                      inf.time[diag.time >= 2 & race == 1], na.rm = TRUE)
+  dat$epi$cc.dx.delay.H.med[at] <- median(diag.time[diag.time >= 2 & race == 2] -
+                                      inf.time[diag.time >= 2 & race == 2], na.rm = TRUE)
+  dat$epi$cc.dx.delay.W.med[at] <- median(diag.time[diag.time >= 2 & race == 3] -
+                                      inf.time[diag.time >= 2 & race == 3], na.rm = TRUE)
+
+  dat$epi$cc.dx.delay.int.med[at] <- median(diag.time[diag.time >= 3380] - inf.time[diag.time >= 3380], na.rm = TRUE)
+  dat$epi$cc.dx.delay.int.B.med[at] <- median(diag.time[diag.time >= 3380 & race == 1] -
+                                          inf.time[diag.time >= 3380 & race == 1], na.rm = TRUE)
+  dat$epi$cc.dx.delay.int.H.med[at] <- median(diag.time[diag.time >= 3380 & race == 2] -
+                                          inf.time[diag.time >= 3380 & race == 2], na.rm = TRUE)
+  dat$epi$cc.dx.delay.int.W.med[at] <- median(diag.time[diag.time >= 3380 & race == 3] -
+                                          inf.time[diag.time >= 3380 & race == 3], na.rm = TRUE)
+
   # dat$epi$cc.tx.any1y[at] <- sum((at - dat$attr$tx.period.last <= 52), na.rm = TRUE) /
   #   sum(dat$attr$diag.status == 1, na.rm = TRUE)
   # dat$epi$cc.tx.any1y.B[at] <- sum((at - dat$attr$tx.period.last <= 52) & race == 1, na.rm = TRUE) /