### Final Models

#### Call libraries ####

library(tidyverse)
library(INLA)
library(lubridate)
library(here)
library(spdep)
library(sf)
library(tmap)
library(colorspace)
library(cowplot)

#### Read in Data #####

shape = st_read(here("Data","comb","combined.shp"))

DATA = read_csv(here("Data","DATA.csv"))

temp = poly2nb(shape)
nb2INLA("MBINLA", temp)
MB.adj = paste(getwd(), "/MBINLA",sep="")

DATA = DATA %>%
  mutate(flag = 1) %>%
  group_by(rhad) %>%
  mutate(t1 = cumsum(flag)) %>%
  ungroup() %>%
  group_by(Year) %>%
  mutate(r1 = cumsum(flag)) %>%
  ungroup() %>%
  mutate(t2 = t1,
         t3 = t1,
         r2 = r1) %>%
  select(-flag)


#### Final S-T Models ####

# Define uniform hyper-prior for sensitivity analysis
UN.prior = "expression:
  log_dens = 0 - log(2) - theta / 2;
  return(log_dens);
"

# S-T model definitions

form_final = list(
  
  Y ~ f(r1, model = "bym", graph = MB.adj,scale.model=T) +
    f(t1, model = "iid") +
    f(t2, model = "rw2",scale.model=T),
  
  Y ~ f(r1, model = "bym", graph = MB.adj,scale.model=T) +
    f(t1, model = "iid") +
    f(t2, model = "rw2",scale.model=T) +
    f(r2, model = "iid",
      group = t3,
      control.group = list(model = "rw2",scale.model=T)),
  
  Y ~ f(r1, model = "bym", graph = MB.adj,scale.model=T,
        hyper = list(
          prec.unstruct = list(UN.prior),
          prec.spatial = list(UN.prior
          )
        )
        ) +
    f(t1, model = "iid") +
    f(t2, model = "rw2",scale.model=T) +
    f(r2, model = "iid",
      group = t3,
      control.group = list(model = "rw2",scale.model=T))
  
)

# Run models

model_final = vector(length = 3, mode = "list")

for (i in 1:3){
  model_final[[i]] = inla(form_final[[i]], family="poisson", 
                          data=DATA, 
                          E=E,
                          control.compute=list(dic=T,cpo=T))
}

# Create Model Output

DIC = vector(length = 3, mode = "list")

for (i in 1:3){
  DIC[[i]] = model_final[[i]]$dic$dic
}

DIC = unlist(DIC)

DIC = tibble(dic = DIC,
             mod = c("temp","spacetime", "spacetime_sens"))



CPO = vector(length = 3, mode = "list")

for (i in 1:3){
  CPO[[i]] = sum(log(model_final[[i]]$cpo$cpo))
}

CPO = unlist(CPO)

CPO = tibble(cpo = CPO,
             mod = c("temp","spacetime", "spacetime_sens"))

#Calculate variance proportions

marg_hyper = inla.hyperpar.sample(100000, model_final[[1]])
marg_hyperst = inla.hyperpar.sample(100000, model_final[[2]])

var_prop = tibble(`Random Effects Term` = c("Unstructured Spatial",
                                            "Structured Spatial",
                                            "Unstructured Temporal",
                                            "Structured Temporal",
                                            "Space-Time Interaction"),
                  `Model With no Interaction` = c(mean(1/marg_hyper[,1]/(1/marg_hyper[,1]+1/marg_hyper[,2]+1/marg_hyper[,3]+1/marg_hyper[,4])),
                                                  mean(1/marg_hyper[,2]/(1/marg_hyper[,1]+1/marg_hyper[,2]+1/marg_hyper[,3]+1/marg_hyper[,4])),
                                                  mean(1/marg_hyper[,3]/(1/marg_hyper[,1]+1/marg_hyper[,2]+1/marg_hyper[,3]+1/marg_hyper[,4])),
                                                  mean(1/marg_hyper[,4]/(1/marg_hyper[,1]+1/marg_hyper[,2]+1/marg_hyper[,3]+1/marg_hyper[,4])),
                                                  NA),
                  `Model With Interaction` = c(mean(1/marg_hyperst[,1]/(1/marg_hyperst[,1]+1/marg_hyperst[,2]+1/marg_hyperst[,3]+1/marg_hyperst[,4]+1/marg_hyperst[,5])),
                                               mean(1/marg_hyperst[,2]/(1/marg_hyperst[,1]+1/marg_hyperst[,2]+1/marg_hyperst[,3]+1/marg_hyperst[,4]+1/marg_hyperst[,5])),
                                               mean(1/marg_hyperst[,3]/(1/marg_hyperst[,1]+1/marg_hyperst[,2]+1/marg_hyperst[,3]+1/marg_hyperst[,4]+1/marg_hyperst[,5])),
                                               mean(1/marg_hyperst[,4]/(1/marg_hyperst[,1]+1/marg_hyperst[,2]+1/marg_hyperst[,3]+1/marg_hyperst[,4]+1/marg_hyperst[,5])),
                                               mean(1/marg_hyperst[,5]/(1/marg_hyperst[,1]+1/marg_hyperst[,2]+1/marg_hyperst[,3]+1/marg_hyperst[,4]+1/marg_hyperst[,5]))))

var_prop = var_prop %>%
  mutate(`Model With no Interaction` = round(`Model With no Interaction`*100,3),
         `Model With Interaction` = round(`Model With Interaction`*100,3))

DC = tibble(`Random Effects Term` = c("DIC",
                                      "CPO"),
            `Model With no Interaction` = c(DIC$dic[1],
                                            CPO$cpo[1]),
            `Model With Interaction` = c(DIC$dic[2],
                                         CPO$cpo[2]))

var_prop = rbind(var_prop,DC)

write_csv(var_prop,here("Output","st_model_fit.csv"))

# Check model against model with uniform hyper-prior
round(model_final[[2]]$summary.fixed,3);round(model_final[[3]]$summary.fixed,3)

#### Spatial Models ####

listw = nb2listw(temp)

spat_dat = DATA %>%
  filter(Year == 2015) %>%
  select(-c(Year,t1,t2,t3,r2))

#Conduct Moran's I test for spatial correlation
moran.test(x = spat_dat$Y/spat_dat$E, listw = listw)

# Define spatial models (without covariates, univariable models and multivariable model, and sensitivity analysis)
form_spat = list(
  Y ~ f(r1, model = "bym", graph = MB.adj),
  
  Y ~ IND + 
    f(r1, model = "bym", graph = MB.adj),
  
  Y ~ SEFI +
    f(r1, model = "bym", graph = MB.adj),
  
  Y ~ IND + SEFI +
    f(r1, model = "bym", graph = MB.adj),
  
  Y ~ IND + SEFI +
    f(r1, model = "bym", graph = MB.adj,
      hyper = list(
        prec.unstruct = list(
          UN.prior
        ),
        prec.spatial = list(
          UN.prior
        )
      ))
)

# Run models
model_spat = vector(length = 5, mode = "list")

for (i in 1:5){
  model_spat[[i]] = inla(form_spat[[i]], family="poisson", 
                         data=spat_dat, 
                         E=E,
                         control.compute=list(dic=T,cpo=T))
}

# Model output
DICs = vector(length = 5, mode = "list")

for (i in 1:5){
  DICs[[i]] = model_spat[[i]]$dic$dic
}

DICs = unlist(DICs)

DICs = tibble(dic = DICs,
              mod = c("none","ind","sefi","both","both_sens"))



CPOs = vector(length = 5, mode = "list")

for (i in 1:5){
  CPOs[[i]] = sum(log(model_spat[[i]]$cpo$cpo))
}

CPOs = unlist(CPOs)

CPOs = tibble(cpo = CPOs,
              mod = c("none","ind","sefi","both","both_sens"))

# Check model against model with uniform hyper-prior
round(model_spat[[4]]$summary.fixed,3);round(model_spat[[5]]$summary.fixed,3)


#Calculate proportion of varaince for each component
marg_hyper_spat = inla.hyperpar.sample(100000, model_spat[[1]])
marg_hyper_spat_ind = inla.hyperpar.sample(100000, model_spat[[2]])
marg_hyper_spat_sefi = inla.hyperpar.sample(100000, model_spat[[3]])
marg_hyper_spat_both = inla.hyperpar.sample(100000, model_spat[[4]])

var_prop_spat = tibble(`Random Effects Term` = c("Unstructured Spatial",
                                            "Structured Spatial"),
                       `Model no Covariates` = c(mean(1/marg_hyper_spat[,1]/(1/marg_hyper_spat[,1]+1/marg_hyper_spat[,2])),
                                            mean(1/marg_hyper_spat[,2]/(1/marg_hyper_spat[,1]+1/marg_hyper_spat[,2]))
                       ),
                  `Model with Ind` = c(mean(1/marg_hyper_spat_ind[,1]/(1/marg_hyper_spat_ind[,1]+1/marg_hyper_spat_ind[,2])),
                                       mean(1/marg_hyper_spat_ind[,2]/(1/marg_hyper_spat_ind[,1]+1/marg_hyper_spat_ind[,2]))
                                       ),
                  `Model with Sefi` = c(mean(1/marg_hyper_spat_sefi[,1]/(1/marg_hyper_spat_sefi[,1]+1/marg_hyper_spat_sefi[,2])),
                                       mean(1/marg_hyper_spat_sefi[,2]/(1/marg_hyper_spat_sefi[,1]+1/marg_hyper_spat_sefi[,2]))
                                       ),
                  `Model with Both` = c(mean(1/marg_hyper_spat_both[,1]/(1/marg_hyper_spat_both[,1]+1/marg_hyper_spat_both[,2])),
                                       mean(1/marg_hyper_spat_both[,2]/(1/marg_hyper_spat_both[,1]+1/marg_hyper_spat_both[,2]))
                                       )
                  )

#### Crude Data ####

crude = read_csv(here("Data","IHD.csv")) %>% select(-urbanicity)

`%notin%` <- Negate(`%in%`)

crude = crude %>%
  pivot_longer(cols = count_1998:ht_srr_2015, names_to = "var", values_to = "cnt") %>%
  filter(str_sub(var,1,1) %notin% c("E","h")) %>%
  mutate(Year = as.numeric(ifelse(str_sub(var,1,2) == "co", str_sub(var,7,10),str_sub(var,5,8))),
         var = ifelse(str_sub(var,1,1) == "c", "Y", "N"),
         cnt = round(cnt,0)) %>%
  select(rhad,Year,var,cnt) %>%
  pivot_wider(names_from = "var", values_from = "cnt") %>%
  mutate(P = round(Y/N,6),
         Region = str_sub(rhad,1,4))


crude_y = crude %>%
  group_by(Year) %>%
  summarize(Y = sum(Y),
            N = sum(N)) %>%
  ungroup() %>%
  mutate(P = round(Y/N,4))


CRUDE = crude %>% 
  mutate(Prevalence = paste0(round(P*100,2),"%")) %>% 
  select(Year, rhad, Prevalence) %>% 
  arrange(Year, rhad) %>% 
  rename(RHAD = rhad)

CRUDE_Yearly = crude_y %>% 
  mutate(Prevalence = paste0(round(P*100,2),"%")) %>% 
  select(Year, Prevalence) %>% 
  arrange(Year)



## Create Figures

plot_theme = theme(legend.background = element_rect(fill = "white",
                                                    color = "white"),
                   legend.title = element_blank(),
                   legend.box.background = element_rect(fill = "white",
                                                        color = "white"),
                   panel.background = element_rect(fill = "white",
                                                   color = "white"),
                   panel.grid.major = element_line(color = "#D3D3D3"),
                   plot.background = element_rect(fill = "white",
                                                  color = "white"))

fig1 = ggplot(crude_y,
              aes(x = Year,
                  y = P*100)) +
  geom_point()+
  geom_line()+
  coord_cartesian(ylim = c(0,14)) +
  scale_y_continuous(breaks = seq(0,100,1))+
  labs(title = "Manitoba IHD Prevalence Over Time",
       subtitle = "Aggregated by Year",
       y = "Crude Prevalence (%)")+
  plot_theme





shape = st_read(here("Data","comb","combined.shp"))

map_data = left_join(shape, crude %>% filter(Year == 2015))
map_data = left_join(map_data, DATA %>% filter(Year == 2015) %>% select(rhad,E,IND,SEFI), by=c("Region"="rhad"))

map_data = map_data %>%
  mutate(RR = round(Y/E,3),
         P = P*100)

sf_use_s2(F)

mb_crude = tm_shape(map_data) +
  tm_polygons("P",
              breaks = c(0,5,9,11,13,17,25),
              palette = sequential_hcl(12, "Sunset", rev=T)) +
  tm_compass()+
  tm_scale_bar(position = c("left","BOTTOM"))+
  tm_layout(title = "Manitoba",
            legend.show = F,
            frame = F,
            compass.type = "arrow")

wpg_crude = tm_shape(map_data %>% filter(str_sub(Region,1,1) == "W" & str_sub(Region,2,2) %notin% c("P","E"))) +
  tm_polygons("P",
              breaks = c(0,5,9,11,13,17,25),
              palette = sequential_hcl(12, "Sunset", rev=T),
              title = "Crude Prevance (%)") +
  tm_scale_bar(position = c("right","BOTTOM"))+
  tm_layout(title = "Winnipeg",
            legend.position = c("LEFT","bottom"),
            frame = F)

fig2 = tmap_arrange(mb_crude,wpg_crude)



tiff(filename = "Output/Fig1_MBCrudePrevalence_Temporal.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig1
dev.off()

tiff(filename = "Output/Fig2_CrudePrevalence_Map2015.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig2
dev.off()


map_data = map_data %>%
  mutate(IND = IND*100)


ind_mb = tm_shape(map_data) +
  tm_polygons("IND",
              breaks = c(0,13,27,44,67,100),
              palette = sequential_hcl(12, "Greens", rev=T),
              title = "Population Percentage (%)")+
  tm_compass()+
  tm_scale_bar(position = c("left","BOTTOM"))+
  tm_layout(title = "Manitoba",
            legend.show = F,
            frame = F,
            compass.type = "arrow")

ind_wpg = tm_shape(map_data %>% filter(str_sub(Region,1,1) == "W" & str_sub(Region,2,2) %notin% c("P","E"))) +
  tm_polygons("IND",
              breaks = c(0,13,27,44,67,100),
              palette = sequential_hcl(12, "Greens",rev=T),
              title = "Population Percentage (%)") +
  tm_scale_bar(position = c("right","BOTTOM"))+
  tm_layout(title = "Winnipeg",
            legend.position = c("left","bottom"),
            frame = F)

fig3 = tmap_arrange(ind_mb,ind_wpg)

tiff(filename = "Output/Fig3_IndProp_Map.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig3
dev.off()




sefi_mb = tm_shape(map_data) +
  tm_polygons("SEFI",
              breaks = c(-1.4,-0.5,0,0.9,1.9,3.1),
              palette = diverging_hcl(12, "Blue-Red"),
              title = "Index Values")+
  tm_compass()+
  tm_scale_bar(position = c("left","BOTTOM"))+
  tm_layout(title = "Manitoba",
            legend.show = F,
            frame = F,
            compass.type = "arrow")

sefi_wpg = tm_shape(map_data %>% filter(str_sub(Region,1,1) == "W" & str_sub(Region,2,2) %notin% c("P","E"))) +
  tm_polygons("SEFI",
              breaks = c(-1.4,-0.5,0,0.9,1.9,3.1),
              palette = diverging_hcl(12, "Blue-Red"),
              title = "Index Values") +
  tm_scale_bar(position = c("right","BOTTOM"))+
  tm_layout(title = "Winnipeg",
            legend.position = c("left","bottom"),
            frame = F)

fig4 = tmap_arrange(sefi_mb,sefi_wpg)

tiff(filename = "Output/Fig4_SEFI_Map.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig4
dev.off()


exc <- sapply(model_spat[[2]]$marginals.fitted.values,
              FUN = function(marg){1 - inla.pmarginal(q = 1, marginal = marg)})

exc = round(as.numeric(exc),4)


map_data = map_data %>%
  mutate(fitted = model_spat[[2]]$summary.fitted.values$`0.5quant`,
         fitted_nocov = model_spat[[1]]$summary.fitted.values$`0.5quant`,
         LL = model_spat[[2]]$summary.fitted.values$`0.025quant`,
         UL = model_spat[[2]]$summary.fitted.values$`0.975quant`,
         EP = exc)



mb_fit = tm_shape(map_data) +
  tm_polygons("fitted",
              breaks = c(0,0.8,1,1.2,1.3,1.9),
              palette = sequential_hcl(12, "Reds", rev=T),
              title = "Risk Ratio")+
  tm_compass()+
  tm_scale_bar(position = c("left","BOTTOM"))+
  tm_layout(title = "Manitoba",
            legend.show = F,
            frame = F,
            compass.type = "arrow")


wpg_fit = tm_shape(map_data %>% filter(str_sub(Region,1,1) == "W" & str_sub(Region,2,2) %notin% c("P","E"))) +
  tm_polygons("fitted",
              breaks = c(0,0.8,1,1.2,1.3,1.9),
              palette = sequential_hcl(12, "Reds",rev=T),
              title = "Risk Ratio") +
  tm_scale_bar(position = c("right","BOTTOM"))+
  tm_layout(title = "Winnipeg",
            legend.position = c("left","bottom"),
            frame = F)


fig5 = tmap_arrange(mb_fit,wpg_fit)

tiff(filename = "Output/Fig5_SpatialModel_RR_Output.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig5
dev.off()




mb_exc = tm_shape(map_data) +
  tm_polygons("EP",
              breaks = c(0,0.5,0.8,0.9,0.95,0.99,1),
              palette = sequential_hcl(12, "Purples", rev=T),
              title = "Exceedance Probability")+
  tm_compass()+
  tm_scale_bar(position = c("left","BOTTOM"))+
  tm_layout(title = "Manitoba",
            legend.show = F,
            compass.type = "arrow",
            frame = F)


wpg_exc = tm_shape(map_data %>% filter(str_sub(Region,1,1) == "W" & str_sub(Region,2,2) %notin% c("P","E"))) +
  tm_polygons("EP",
              breaks = c(0,0.5,0.8,0.9,0.95,0.99,1),
              palette = sequential_hcl(12, "Purples", rev=T),
              title = "Exceedance \nProbability") +
  tm_scale_bar(position = c("right","BOTTOM"))+
  tm_layout(title = "Winnipeg",
            legend.position = c("LEFT","bottom"),
            frame = F)

fig6 = tmap_arrange(mb_exc,wpg_exc)

tiff(filename = "Output/Fig6_SpatialModel_Output_ExccedanceProb.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig6
dev.off()

fig7 = map_data %>% 
  arrange(fitted) %>% 
  mutate(x = 1:96,
         color = if_else(UL <= 1 , "gr",
                         if_else(LL >= 1, "rd", "yl"))) %>% 
ggplot()+
  geom_linerange(aes(ymin = LL,
                     ymax = UL,
                     x = x,
                     color = color))+
  geom_line(aes(x = x,
                y = fitted))+
  plot_theme+
  theme(legend.position = "none",
        panel.grid.major.x = element_blank())+
  labs(x = "Ranked RHAD's",
       y = "Model Fitted RR",
       title = "Model Fitted RR (black line) and 95% Credible Intervals",
       subtitle = "By RHAD")+
  scale_color_manual(values = c("#009B95", "red", "#4B0055"))+
  geom_hline(yintercept = 1)

tiff(filename = "Output/Fig7_SpatialModel_UncertaintyPlot.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig7
dev.off()


DATA = DATA %>%
  mutate(fitted = model_final[[2]]$summary.fitted.values$`0.5quant`,
         LL = model_final[[2]]$summary.fitted.values$`0.025quant`,
         UL = model_final[[2]]$summary.fitted.values$`0.975quant`) %>%
  select(rhad,Year,fitted,LL,UL) %>%
  group_by(rhad) %>%
  mutate(trend = case_when(first(fitted) > 1.5*last(fitted) ~ "decrease",
                           1.4*first(fitted) < last(fitted) ~ "increase")) %>%
  ungroup()  %>%
  left_join(
    crude %>% 
      mutate(Region = str_sub(rhad,1,4)) %>% 
      rename(label = rhad) %>% 
      select(label,Region) %>% 
      distinct(label,Region), 
    by = c("rhad"="Region"))

DATA = shape %>% 
  full_join(DATA, by = c("Region"="rhad"))


fig8 = tm_shape(DATA %>% filter(Year %in% c(2015,2012,2009,2006,2003,2000)))+
  tm_polygons("fitted",
              palette = sequential_hcl(12, "Reds",rev=T),
              breaks = c(0,0.9,1,1.3,1.4,1.8, 2.6),
              title = "Risk Ratio - MB")+
  tm_facets(by="Year")


fig9 = tm_shape(DATA %>% filter(Year %in% c(2015,2012,2009,2006,2003,2000),
                                str_sub(Region,1,1) == "W" & str_sub(Region,2,2) %notin% c("P","E")))+
  tm_polygons("fitted",
              palette = sequential_hcl(12, "Reds",rev=T),
              breaks = c(0,0.9,1,1.3,1.4,1.8, 2.6),
              title = "Risk Ratio - WPG")+
  tm_facets(by="Year")

tiff(filename = "Output/Fig8_STModel_MB_Fitted.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig8
dev.off()

tiff(filename = "Output/Fig9_STModel_WPG_Fitted.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig9
dev.off()


DATA_OUT = DATA %>%
  filter(trend %in% c("increase","decrease")) %>%
  mutate(trend = factor(trend))
  
  
fig10 = ggplot(DATA_OUT %>% mutate(label = factor(label,levels = c("W04A St. Vital N",
                                                                   "NO27 Z2 Cross Lake/Cross Lake FN",
                                                                   "WE15 N Dauphin",
                                                                   "WP21 Churchill",
                                                                   "SO46 E Rural East",
                                                                   "NO16 Z1 Gillam, Fox Lake Cree Nation"),
                                                  ordered = T)))+
  geom_line(aes(x = Year,
                y = fitted))+
  geom_point(aes(x = Year,
                 y = fitted)) +
  geom_ribbon(aes(x = Year,
                  ymin = LL,
                  ymax = UL),
              alpha = 0.2)+
  geom_hline(yintercept = 1) +
  facet_wrap(~label) +
  labs(y = "Fitted RR",
       title = "Temporal Trends in Fitted RR")+
  plot_theme


tiff(filename = "Output/Fig10_STModel_TempPlots.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
fig10
dev.off()


## Create Supplementary Figures and Tables

sfig1 = ggplot(map_data)+
  geom_point(aes(x = fitted_nocov,
                 y = fitted))+
  geom_abline(slope = 1,
              intercept = 0)+
  plot_theme+
  labs(y = "Model fitted RR from model with Indigenous population covariate",
       x = "Model fitted RR from model with no covariates",
       title = "Fitted Values for Spatial Models",
       subtitle = "Model with no covariates vs model with Indigenous population proportion covariate",
       caption = "Each point represents a RHAD.")

sfig2 = ggplot(map_data)+
  geom_point(aes(x = fitted,
                 y = EP))+
  scale_x_continuous(breaks = seq(0.6,2,0.2))+
  plot_theme+
  geom_vline(xintercept = 1)+
  labs(x = "Model Fitted RR",
       y = "Exceedance Probabilities",
       title = "Fitted Values vs Exceedance Probabilities",
       subtitle = "Calculated by Spatial Model",
       caption = "Each point represents a RHAD.")


tiff(filename = "Output/Supplementary_FiguresTables/SupplementFig1.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
sfig1
dev.off()

tiff(filename = "Output/Supplementary_FiguresTables/SupplementFig2.tiff",
     width = 174,
     height = 174,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
sfig2
dev.off()



sfig3 = tm_shape(DATA)+
  tm_polygons("fitted",
              palette = sequential_hcl(12, "Reds",rev=T),
              breaks = c(0,0.9,1,1.3,1.4,1.8, 2.6),
              title = "Risk Ratio - MB")+
  tm_facets(by="Year")


sfig4 = tm_shape(DATA %>% filter(str_sub(Region,1,1) == "W" & str_sub(Region,2,2) %notin% c("P","E")))+
  tm_polygons("fitted",
              palette = sequential_hcl(12, "Reds",rev=T),
              breaks = c(0,0.9,1,1.3,1.4,1.8, 2.6),
              title = "Risk Ratio - WPG")+
  tm_facets(by="Year")

tiff(filename = "Output/Supplementary_FiguresTables/SupplementFig3.tiff",
     width = 174,
     height = 174*2,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
sfig3
dev.off()

tiff(filename = "Output/Supplementary_FiguresTables/SupplementFig4.tiff",
     width = 174,
     height = 174*2,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
sfig4
dev.off()



sfig5 = ggplot(DATA)+
  geom_line(aes(x = Year,
                y = fitted))+
  geom_point(aes(x = Year,
                 y = fitted)) +
  geom_ribbon(aes(x = Year,
                  ymin = LL,
                  ymax = UL),
              alpha = 0.2)+
  geom_hline(yintercept = 1) +
  facet_wrap(~label, nrow = 12) +
  labs(y = "Fitted RR",
       title = "Temporal Trends in Fitted RR")+
  plot_theme

tiff(filename = "Output/Supplementary_FiguresTables/SupplementFig5.tiff",
     width = 174*2,
     height = 174*3,
     units = "mm",
     pointsize =12,
     bg = "white",
     res = 220)
sfig5
dev.off()


data_out = DATA %>% 
  st_drop_geometry() %>% 
  select(label,
         Year,
         LL,
         fitted,
         UL) %>% 
  mutate(fitted = round(fitted,3),
         UL = round(UL, 3),
         LL = round(LL, 3)) %>% 
  rename(RHAD = label,
         `0.025 Quantile for Fitted RR` = LL,
         `0.5 Quantile for Fitted RR` = fitted,
         `0.975 Quantile for Fitted RR` = UL)


write_csv(data_out, "Output/Supplementary_FiguresTables/SpatioTemporal_ModelOutput.csv")