Testing Module Diagnostics

Comparison of Hazards

### Hazards based on Model
pred_dat <- readRDS("../../Data/Intermediate/coxdata.RDS")
pred_dat <- pred_dat %>% filter(!(never_tested == "T" & age > 45))
covardf <- with(pred_dat, expand.grid(
  age.young = unique(age.young),
  race2 = unique(race2),
  region.ewa = unique(region.ewa),
  snap.grp3 = unique(snap.grp3)))
# define the survival object in weeks
sdfwk <- with(pred_dat, Surv(mlt*4, tested))
# fit model
fit_gomp_scalewk <- flexsurvreg(sdfwk ~
                                  age.young + 
                                  race2 +
                                  region.ewa + 
                                  snap.grp3,
                                anc = list(shape =~ age.young),
                                data = pred_dat,
                                weights = ego.wawt,
                                dist = "gompertz")

haz_gompwk <- summary(fit_gomp_scalewk, newdata = covardf, 
                      type = "hazard", tidy = TRUE)

pred_haz <- haz_gompwk %>% 
  select(age.young, race = race2, snap.grp3, region.ewa, wlt = time, 
         prop = est) %>%
  mutate(num = NA, num_tested = NA, type = "Predicted")

### Hazards based on the simulated data
dat <- readRDS("../../EpiModel/AE/sim_epimodel3/sim_at_2013_2021-01-12.rds")

## Registered S3 method overwritten by 'tergm':
##   method                   from
##   simulate_formula.network ergm

haz_check <- dat$temp$check_haz %>% mutate(prop = num_tested / num, 
                                           type = "Observed")

### Combing Data
all_dat <- bind_rows(pred_haz, haz_check)

Observed hazards within subgroups

Age.Young

all_dat %>% ggplot(aes(x = wlt, y = prop, color = age.young, 
                       linetype = type)) + geom_smooth(se = FALSE) + 
  facet_grid(race ~ snap.grp3) + coord_cartesian(xlim = c(0, 500)) + 
  theme(legend.position = "bottom") + 
  guides(linetype = guide_legend(override.aes = list(color = "black")))

## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

Race

all_dat %>% ggplot(aes(x = wlt, y = prop, color = race, 
                       linetype = type)) + geom_smooth(se = FALSE) + 
  facet_grid(age.young ~ snap.grp3) + coord_cartesian(xlim = c(0, 500)) + 
  theme(legend.position = "bottom") + 
  guides(linetype = guide_legend(override.aes = list(color = "black")))

## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

Region

all_dat %>% ggplot(aes(x = wlt, y = prop, color = region.ewa, 
                       linetype = type)) + geom_smooth(se = FALSE) + 
  facet_grid(race ~ snap.grp3) + coord_cartesian(xlim = c(0, 500)) + 
  theme(legend.position = "bottom") + 
  guides(linetype = guide_legend(override.aes = list(color = "black")))

## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

Snap.grp3

all_dat %>% ggplot(aes(x = wlt, y = prop, color = snap.grp3, 
                       linetype = type)) + geom_smooth(se = FALSE) + 
  facet_grid(race ~ age.young) + coord_cartesian(xlim = c(0, 500)) + 
  theme(legend.position = "bottom") + 
  guides(linetype = guide_legend(override.aes = list(color = "black")))

## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'