Skip to content

Commit

Permalink
Merge pull request #268 from HopkinsIDD/fix-snapshot
Browse files Browse the repository at this point in the history 
Quick fix to postprocessing automatic plots
  • Loading branch information
@jcblemai
jcblemai committed Jul 25, 2024
2 parents 6c432fe + 1c0dd44 commit 040420b
Showing 1 changed file with 3 additions and 44 deletions.
47 changes: 3 additions & 44 deletions postprocessing/postprocess_snapshot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -179,24 +179,13 @@ if("hosp" %in% model_outputs){
print(outputs_global$hosp %>%
.[, ..cols_sim] %>%
.[, date := lubridate::as_date(date)] %>%
# { if(config$subpop_setup$subpop == 'subpop'){
# .[geodata %>% .[, subpop := stringr::str_pad(subpop, width = 5, side = "left", pad = "0")], on = .(subpop)]}
# } %>%
# { if(config$subpop_setup$subpop == 'subpop'){ .[, subpop := USPS]}
# } %>%
.[, as.list(quantile(get(statistics$sim_var), c(.05, .25, .5, .75, .95), na.rm = TRUE, names = FALSE)), by = c("date", "subpop")] %>%
ggplot() +
geom_ribbon(aes(x = date, ymin = V1, ymax = V5), alpha = 0.1) +
geom_ribbon(aes(x = date, ymin = V2, ymax = V4), alpha = 0.1) +
geom_line(aes(x = date, y = V3)) +
geom_point(data = gt_data %>%
.[, ..cols_data] #%>%
# { if(config$subpop_setup$subpop == 'subpop'){
# .[geodata %>% .[, subpop := stringr::str_pad(subpop, width = 5, side = "left", pad = "0")], on = .(subpop)]}
# } %>%
# { if(config$subpop_setup$subpop == 'subpop'){ .[, subpop := USPS]}
# }
,
.[, ..cols_data],
aes(lubridate::as_date(date), get(statistics$data_var)), color = 'firebrick', alpha = 0.1) +
facet_wrap(~subpop, scales = 'free', ncol = gg_cols) +
labs(x = 'date', y = fit_stats[i], title = statistics$sim_var) +
Expand All @@ -220,11 +209,6 @@ if("hosp" %in% model_outputs){
print(outputs_global$hosp %>%
.[, ..cols_sim] %>%
.[, date := lubridate::as_date(date)] %>%
# { if(config$subpop_setup$subpop == 'subpop'){
# .[geodata %>% .[, subpop := stringr::str_pad(subpop, width = 5, side = "left", pad = "0")], on = .(subpop)]}
# } %>%
# { if(config$subpop_setup$subpop == 'subpop'){ .[, subpop := USPS]}
# } %>%
.[, csum := cumsum(get(statistics$sim_var)), by = .(subpop, slot)] %>%
.[, as.list(quantile(csum, c(.05, .25, .5, .75, .95), na.rm = TRUE, names = FALSE)), by = c("date", "subpop")] %>%
ggplot() +
Expand All @@ -233,11 +217,6 @@ if("hosp" %in% model_outputs){
geom_line(aes(x = date, y = V3)) +
geom_point(data = gt_data %>%
.[, ..cols_data] %>%
# { if(config$subpop_setup$subpop == 'subpop'){
# .[geodata %>% .[, subpop := stringr::str_pad(subpop, width = 5, side = "left", pad = "0")], on = .(subpop)]}
# } %>%
# { if(config$subpop_setup$subpop == 'subpop'){ .[, subpop := USPS]}
# } %>%
.[, csum := cumsum(replace_na(get(statistics$data_var), 0)) , by = .(subpop)]
,
aes(lubridate::as_date(date), csum), color = 'firebrick', alpha = 0.1) +
Expand Down Expand Up @@ -279,25 +258,15 @@ if("hosp" %in% model_outputs){
function(e){
high_low_hosp_llik %>%
.[, date := lubridate::as_date(date)] %>%
# { if(config$subpop_setup$subpop == 'subpop'){
# .[geodata %>% .[, subpop := stringr::str_pad(subpop, width = 5, side = "left", pad = "0")], on = .(subpop)]}
# } %>%
.[subpop == e] %>%
# { if(config$subpop_setup$subpop == 'subpop'){ .[, subpop := USPS]}
# } %>%
ggplot() +
geom_line(aes(lubridate::as_date(date), get(statistics$data_var),
group = slot, color = ll))+#, linetype = llik_bin)) +
# scale_linetype_manual(values = c(1, 2), name = "likelihood\nbin") +
scale_color_viridis_c(option = "D", name = "log\nlikelihood") +
geom_point(data = gt_data %>%
.[, ..cols_data] %>%
# { if(config$subpop_setup$subpop == 'subpop'){
# .[geodata %>% .[, subpop := stringr::str_pad(subpop, width = 5, side = "left", pad = "0")], on = .(subpop)]}
# } %>%
.[subpop == e] ,#%>%
# { if(config$subpop_setup$subpop == 'subpop'){ .[, subpop := USPS]}
# } ,
.[subpop == e] ,
aes(lubridate::as_date(date), get(statistics$data_var)), color = 'firebrick', alpha = 0.1) +
facet_wrap(~subpop, scales = 'free', ncol = gg_cols) +
labs(x = 'date', y = fit_stats[i]) + #, title = paste0("top 5, bottom 5 lliks, ", statistics$sim_var)) +
Expand Down Expand Up @@ -332,12 +301,7 @@ if("hnpi" %in% model_outputs){
function(i){
outputs_global$hnpi %>%
.[outputs_global$llik, on = c("subpop", "slot")] %>%
# { if(config$subpop_setup$subpop == 'subpop'){
# .[geodata %>% .[, subpop := stringr::str_pad(subpop, width = 5, side = "left", pad = "0")], on = .(subpop)]}
# } %>%
# .[get(config$subpop_setup$subpop) == i] %>%
# { if(config$subpop_setup$subpop == 'subpop'){ .[, subpop := USPS]}
# } %>%
.[subpop == i] %>%
ggplot(aes(modifier_name,value)) +
geom_violin() +
geom_jitter(aes(group = modifier_name, color = ll), size = 0.6, height = 0, width = 0.2, alpha = 1) +
Expand Down Expand Up @@ -435,9 +399,6 @@ if("snpi" %in% model_outputs){
snpi_plots <- lapply(node_names,
function(i){
if(!grepl(',', i)){

# i_lab <- ifelse(config$name == "USA", geodata[subpop == i, USPS], i)

outputs_global$snpi %>%
.[outputs_global$llik, on = c("subpop", "slot")] %>%
.[subpop == i] %>%
Expand All @@ -448,8 +409,6 @@ if("snpi" %in% model_outputs){
theme(axis.text.x = element_text(angle = 60, hjust = 1, size = 6)) +
scale_color_viridis_c(option = "B", name = "log\nlikelihood") +
labs(x = "parameter", title = i)
# labs(x = "parameter", title = i_lab)

}else{
nodes_ <- unlist(strsplit(i,","))
ll_across_nodes <-
Expand Down

0 comments on commit 040420b

Please sign in to comment.