1 Back to Outline

This section includes information on network diagnostics. You can go back to table of contents if you would like.

Other related documents are:

rolling_year_sum <- function(x, years = 1, avg = FALSE){
  val <- data.table::frollsum(fill(data.frame(x), "x")$x, years * 52)
  if (avg) {val <- val / (years * 52)}
  return(val)
}

if (is.null(params$sim_data)) {
  sim_loc <- "../../EpiModel/AE/sim_epimodel3/sim_sim_on_2021-06-11_at_1988.rds"
}else{
  sim_loc <- params$sim_data
}
attr_names <- EpiModelWHAMPDX::attr_names
attr_names$insurance <- NULL
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(magrittr))
suppressPackageStartupMessages(library(cowplot))
suppressPackageStartupMessages(library(ggrepel))
options(dplyr.summarise.inform = FALSE)
library(EpiModelWHAMPDX)
sim_dat <- readRDS(sim_loc)
knitr::opts_chunk$set(echo = TRUE, message = FALSE,
                      warning = FALSE, fig.width = 8)
cur_targs <- readRDS(here("Data", "EpiModelSims", "WHAMP.dx.targs.rds"))

1.1 Diagnosed HIV prevalence

diag.prev.inf <- list(
  diag.prev.prop = list(name = "prev",
                  sec_title = "Diagnosed Prevalence",
                  plot_name = "Proportion of individuals diagnosed with HIV+",
                  plot_cap = "Among all individuals, Target source: WADOH estimates of MSM living with HIV in WA",
                  plot_ylab = "Proportion",
                  plt_type = "line",
                  vars = c("num.", "diag.i.num."),
                  sum_fun = function(x, y) { y / x }
  ),
  diag.incid.rate = list(name = "newDx.rate",
                  sec_title = "Diagnosed Incidence",
                  plot_name = "Diagnosed Incidence Rate (4 year rolling average)",
                  plot_cap = "",
                  plot_ylab = "Rate (Per Year)",
                  plt_type = "line",
                  vars = c("num.", "diag.i.num.", "new.dx."),
                  sum_fun = function(x, y, z) { 52 * rolling_year_sum(z, years = 4) /
                      rolling_year_sum(x - y, years = 4) }
  )
)

print_many_plots(diag.prev.inf[1], sim_obj = sim_dat,
                 num_hash = 3, targ_df = cur_targs,
                 othr_args = "coord_cartesian(ylim = c(0, 0.2))")

1.1.1 Diagnosed Prevalence

1.1.1.1 ovr

1.1.1.2 race

1.1.1.3 region

1.1.1.4 age.grp

1.1.1.5 snap5

print_many_plots(diag.prev.inf[2], num_hash = 3, 
                 sim_obj = sim_dat, targ_df = cur_targs,
                 othr_args = "coord_cartesian(ylim = c(0, 0.02))")

1.1.2 Diagnosed Incidence

1.1.2.1 ovr

1.1.2.2 race

1.1.2.3 region

1.1.2.4 age.grp

1.1.2.5 snap5

2 Prevalence

prev.inf <- list(
  prev.prop = list(name = "true.prev",
                  sec_title = "True Prevalence",
                  plot_name = "Proportion HIV+",
                  plot_cap = "Among all individuals",
                  plot_ylab = "Proportion",
                  plt_type = "line",
                  vars = c("num.", "i.num."),
                  sum_fun = function(x, y) { y / x }
  ),
  incid.rate = list(name = "true.incidence.rate",
                  sec_title = "True Incidence",
                  plot_name = "Incidence Rate (4 year rolling average)",
                  plot_cap = "",
                  plot_ylab = "Rate (Per Year)",
                  plt_type = "line",
                  vars = c("num.", "i.num.", "incid.inf."),
                  sum_fun = function(x, y, z) { 52 * rolling_year_sum(z, years = 4) /
                      rolling_year_sum(x - y, years = 4) }
  )
)
meas_data <- make_epi_plot_data(sim_dat, prev.inf[[1]])
# print_many_plots(prev.inf[1], num_hash = 3, 
#                  othr_args = "coord_cartesian(ylim = c(0, 0.2))")

2.1 True Prevalence

2.1.1 Overall

plot_epi(meas_data, year_range = c(1980, 2030),
         targets = cur_targs, brk_across = "ovr") + 
  coord_cartesian(ylim = c(0, 0.2))

2.1.2 Race

plot_epi(meas_data, year_range = c(1943, 2030),
         targets = cur_targs, brk_across = "race")  + 
  coord_cartesian(ylim = c(0, 0.2))

2.1.3 Age Group

plot_epi(meas_data, year_range = c(1980, 2030),
         targets = cur_targs, brk_across = "age.grp")  + 
  coord_cartesian(ylim = c(0, 0.2))

2.1.4 Region

plot_epi(meas_data, year_range = c(1980, 2030),
         targets = cur_targs, brk_across = "region") + 
  coord_cartesian(ylim = c(0, 0.2))

2.1.5 SNAP5

Note here that the high proportion of HIV+ among SNAP 0 individuals is largely driven by older individuals in our population who are no longer able to form ties (see prevalence broken down by age group for more info).

plot_epi(meas_data, year_range = c(1980, 2030),
         targets = cur_targs, brk_across = "snap5") + 
  coord_cartesian(ylim = c(0, 0.2))

print_many_plots(prev.inf[2], sim_obj = sim_dat, num_hash = 2,
                 targ_df = cur_targs,
                 othr_args = "coord_cartesian(ylim = c(0, 0.02))")

2.2 True Incidence

2.2.1 ovr

2.2.2 race

2.2.3 region

2.2.4 age.grp

2.2.5 snap5