Skip to content

Commit

Permalink
Merge pull request #6 from EpiModel/AIDSR1
Browse files Browse the repository at this point in the history 
AIDS R1 Revision
  • Loading branch information
@smjenness
smjenness authored Jul 6, 2020
2 parents b36bd75 + c6d8cd4 commit b6ca092
Show file tree
Hide file tree
Showing 105 changed files with 2,584 additions and 1,406 deletions.
1 change: 1 addition & 0 deletions .Rprofile
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
source("renv/activate.R")
30 changes: 15 additions & 15 deletions InstallStack.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,15 +18,15 @@ remotes::install_github(c("statnet/network@deff2a0",

# Latest Dev Versions of EpiModel Packages
remotes::install_github(c("statnet/EpiModel@2c131f0",
"statnet/EpiModelHPC@a64dbf2",
"statnet/EpiModelHPC@v2.1.0",
"statnet/[email protected]",
"EpiModel/EpiABC@c32ecb6",
"EpiModel/ARTnetData@1d8ec6e",
"EpiModel/ARTnet@150c631"),
upgrade = FALSE)

# Current Version of EpiModelHIV for Project
remotes::install_github("EpiModel/EpiModelHIV-p@CombPrev",
remotes::install_github("EpiModel/EpiModelHIV-p@CombPrev-AIDSR1",
upgrade = FALSE)


Expand All @@ -39,17 +39,17 @@ sessioninfo::package_info(pkgs = c("network", "networkDynamic", "statnet.common"
"tergmLite", "EpiABC", "EpiModelHIV",
"ARTnetData", "ARTnet"), dependencies = FALSE)

# Jul 10 2019
# June 25 2020
# package * version date lib source
# ARTnet 1.0.0 2019-07-10 [1] Github (EpiModel/ARTnet@150c631)
# ARTnetData 1.0 2019-07-10 [1] Github (EpiModel/ARTnetData@1d8ec6e)
# EpiABC 1.0 2019-05-17 [1] Github (EpiModel/EpiABC@c32ecb6)
# EpiModel * 1.7.3 2019-05-23 [1] Github (statnet/EpiModel@2c131f0)
# EpiModelHIV * 1.5.0 2019-07-10 [1] Github (EpiModel/EpiModelHIV-p@554186b)
# EpiModelHPC * 2.0.2 2019-07-10 [1] Github (statnet/EpiModelHPC@a64dbf2)
# ergm * 3.10.0-4851 2019-06-04 [1] Github (statnet/ergm@8b30e92)
# network * 1.14-377 2019-06-04 [1] Github (statnet/network@deff2a0)
# networkDynamic * 0.10 2019-06-04 [1] Github (statnet/networkDynamic@14182bf)
# statnet.common 4.3.0-230 2019-06-04 [1] Github (statnet/statnet.common@3307a8c)
# tergm * 3.6.0-1659 2019-06-04 [1] Github (statnet/tergm@d3af135)
# tergmLite * 1.2.0 2019-05-17 [1] Github (statnet/tergmLite@73d2a2d)
# ARTnet 1.0.0 2020-06-19 [1] Github (EpiModel/ARTnet@150c631)
# ARTnetData 1.0 2020-06-19 [1] Github (EpiModel/ARTnetData@1d8ec6e)
# EpiABC 1.0 2019-05-16 [1] Github (EpiModel/EpiABC@c32ecb6)
# EpiModel * 1.7.3 2020-06-25 [1] Github (statnet/EpiModel@2c131f0)
# EpiModelHIV * 1.5.0 2020-06-25 [1] Github (EpiModel/EpiModelHIV-p@d72a6eb)
# EpiModelHPC * 2.1.0 2020-06-25 [1] Github (statnet/EpiModelHPC@257bbf3)
# ergm * 3.10.0-4851 2020-06-24 [1] Github (statnet/ergm@8b30e92)
# network * 1.14-377 2020-06-24 [1] Github (statnet/network@deff2a0)
# networkDynamic * 0.10 2020-06-24 [1] Github (statnet/networkDynamic@14182bf)
# statnet.common 4.3.0-230 2020-06-24 [1] Github (statnet/statnet.common@3307a8c)
# tergm * 3.6.0-1659 2020-06-24 [1] Github (statnet/tergm@d3af135)
# tergmLite * 1.2.0 2020-06-24 [1] Github (statnet/tergmLite@73d2a2d)
44 changes: 29 additions & 15 deletions analysis/CalibrationFigures.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,10 +4,15 @@ library("EpiModelHIV")
sim <- NULL
source("analysis/fx.R")

fn <- list.files("burnin/data", full.names = TRUE)
fn <- list.files("burnin/burnin1/data", full.names = TRUE)
cbind(fn)

load(fn[1])

sim <- mutate_epi(sim, cc.dx.delay.B.medY = cc.dx.delay.B.med/52,
cc.dx.delay.H.medY = cc.dx.delay.H.med/52,
cc.dx.delay.W.medY = cc.dx.delay.W.med/52)

df <- as.data.frame(sim, out = "mean")
names(df)

Expand All @@ -18,7 +23,8 @@ sim$param$trans.scale

jpeg(file = "analysis/fig/Fig-Calib1.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = "i.prev", ylim = c(0, 0.4))
plot(sim, y = "i.prev", ylim = c(0, 0.4),
ylab = "Prevalence", xlab = "Calibration Weeks")
plot(sim, y = "i.prev.dx", add = TRUE, mean.col = "firebrick", qnts.col = "firebrick")
text(2500, 0.30, round(mean(tail(df$i.prev, 52)), 3), col = "steelblue")
text(2500, 0.15, round(mean(tail(df$i.prev.dx, 52)), 3), col = "firebrick")
Expand All @@ -27,7 +33,8 @@ dev.off()

jpeg(file = "analysis/fig/Fig-Calib2.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = c("i.prev.dx.B", "i.prev.dx.H", "i.prev.dx.W"), legend = TRUE, ylim = c(0, 0.4))
plot(sim, y = c("i.prev.dx.B", "i.prev.dx.H", "i.prev.dx.W"), legend = TRUE, ylim = c(0, 0.4),
ylab = "Prevalence", xlab = "Calibration Weeks")
abline(h = c(0.333, 0.127, 0.084), col = c("steelblue", "firebrick", "seagreen"), lty = 2)
x <- round(colMeans(tail(df[, c("i.prev.dx.B", "i.prev.dx.H", "i.prev.dx.W")], 52)), 3)
text(2500, 0.36, x[1], col = "steelblue")
Expand All @@ -38,7 +45,8 @@ dev.off()

jpeg(file = "analysis/fig/Fig-Calib3.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = "cc.dx", ylim = 0:1)
plot(sim, y = "cc.dx", ylim = 0:1,
ylab = "Proportion", xlab = "Calibration Weeks")
text(2500, 0.88, "Diagnosed", col = "steelblue")
plot(sim, y = "cc.vsupp", mean.col = "firebrick", qnts.col = "firebrick", add = TRUE)
text(2500, 0.64, "Viral Suppressed", col = "firebrick")
Expand All @@ -51,15 +59,17 @@ dev.off()

jpeg(file = "analysis/fig/Fig-Calib4a.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = c("cc.dx.B", "cc.dx.H", "cc.dx.W"), ylim = c(0, 1), legend = TRUE)
plot(sim, y = c("cc.dx.B", "cc.dx.H", "cc.dx.W"), ylim = c(0, 1), legend = TRUE,
ylab = "Proportion", xlab = "Calibration Weeks")
colMeans(tail(df[, c("cc.dx.B", "cc.dx.H", "cc.dx.W")], 52))
abline(h = c(0.804, 0.799, 0.88), col = c("steelblue", "firebrick", "seagreen"), lty = 2)
dev.off()


jpeg(file = "analysis/fig/Fig-Calib4b.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = c("cc.dx.B", "cc.dx.H", "cc.dx.W"), ylim = c(0.7, 1), legend = TRUE)
plot(sim, y = c("cc.dx.B", "cc.dx.H", "cc.dx.W"), ylim = c(0.7, 1), legend = TRUE,
ylab = "Proportion", xlab = "Calibration Weeks")
x <- round(colMeans(tail(df[, c("cc.dx.B", "cc.dx.H", "cc.dx.W")], 52)), 3)
abline(h = c(0.804, 0.799, 0.88), col = c("steelblue", "firebrick", "seagreen"), lty = 2)
text(2500, 0.92, x[3], col = "seagreen")
Expand All @@ -70,17 +80,18 @@ dev.off()
# related outcomes
jpeg(file = "analysis/fig/Fig-Calib5.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = c("cc.dx.delay.B", "cc.dx.delay.H", "cc.dx.delay.W"), ylim = c(0, 250), legend = TRUE)
x <- round(colMeans(tail(df[, c("cc.dx.delay.B", "cc.dx.delay.H", "cc.dx.delay.W")], 52))/52, 2)
text(2500, 225, x[1], col = "steelblue")
text(2500, 200, x[2], col = "firebrick")
text(2500, 75, x[3], col = "seagreen")
plot(sim, y = c("cc.dx.delay.B.medY", "cc.dx.delay.H.medY", "cc.dx.delay.W.medY"), ylim = c(0, 5),
legend = TRUE, ylab = "Years", xlab = "Calibration Weeks")
x <- round(colMeans(tail(df[, c("cc.dx.delay.B.medY", "cc.dx.delay.H.medY", "cc.dx.delay.W.medY")], 52)), 2)
text(2500, 160/52, "2.50", col = "steelblue")
text(2700, 160/52, x[2], col = "firebrick")
text(2500, 75/52, x[3], col = "seagreen")
dev.off()

jpeg(file = "analysis/fig/Fig-Calib6.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = c("cc.test.int.B", "cc.test.int.H", "cc.test.int.W"), ylim = c(0, 400),
legend = TRUE)
legend = TRUE, ylab = "Weeks", xlab = "Calibration Weeks")
x <- round(colMeans(tail(df[, c("cc.test.int.B", "cc.test.int.H", "cc.test.int.W")], 52))/52, 2)
text(2500, 280, x[1], col = "steelblue")
text(2500, 250, x[2], col = "firebrick")
Expand All @@ -92,7 +103,8 @@ dev.off()

jpeg(file = "analysis/fig/Fig-Calib7.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = c("cc.linked1m.B", "cc.linked1m.H", "cc.linked1m.W"), ylim = 0:1, legend = TRUE)
plot(sim, y = c("cc.linked1m.B", "cc.linked1m.H", "cc.linked1m.W"), ylim = 0:1, legend = TRUE,
ylab = "Proportion", xlab = "Calibration Weeks")
abline(h = c(0.62, 0.65, 0.76), col = c("steelblue", "firebrick", "seagreen"), lty = 2)
x <- round(colMeans(tail(df[, c("cc.linked1m.B", "cc.linked1m.H", "cc.linked1m.W")], 52)), 3)
text(2500, 0.59, x[1], col = "steelblue")
Expand All @@ -105,7 +117,8 @@ dev.off()

jpeg(file = "analysis/fig/Fig-Calib8.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = c("cc.vsupp.B", "cc.vsupp.H", "cc.vsupp.W"), ylim = 0:1, legend = TRUE)
plot(sim, y = c("cc.vsupp.B", "cc.vsupp.H", "cc.vsupp.W"), ylim = 0:1, legend = TRUE,
ylab = "Proportion", xlab = "Calibration Weeks")
abline(h = c(0.55, 0.60, 0.72), col = c("steelblue", "firebrick", "seagreen"), lty = 2)
x <- round(colMeans(tail(df[, c("cc.vsupp.B", "cc.vsupp.H", "cc.vsupp.W")], 52)), 3)
text(2500, 0.50, x[1], col = "steelblue")
Expand All @@ -117,7 +130,8 @@ dev.off()

jpeg(file = "analysis/fig/Fig-Calib9.jpg", width = 9, height = 5.5, units = "in", res = 250)
par(mar = c(3,3,1,1), mgp = c(2,1,0))
plot(sim, y = c("cc.vsupp.dur1y.B", "cc.vsupp.dur1y.H", "cc.vsupp.dur1y.W"), ylim = 0:1, legend = TRUE)
plot(sim, y = c("cc.vsupp.dur1y.B", "cc.vsupp.dur1y.H", "cc.vsupp.dur1y.W"), ylim = 0:1, legend = TRUE,
ylab = "Proportion", xlab = "Calibration Weeks")
colMeans(tail(df[, c("cc.vsupp.dur1y.B", "cc.vsupp.dur1y.H", "cc.vsupp.dur1y.W")], 52))
abline(h = c(0.41, 0.49, 0.63), col = c("steelblue", "firebrick", "seagreen"), lty = 2)
dev.off()
Binary file modified analysis/Fig1-data.rda
View file
Binary file not shown.
Binary file modified analysis/Fig2-data.rda
View file
Binary file not shown.
Loading

0 comments on commit b6ca092

Please sign in to comment.