---
title: "ghrmodel_laos"
output:
  html_document: default
  pdf_document:
    latex_engine: xelatex
date: "2025-03-03"
---
## Load

```{r load packages, warning=FALSE, message=FALSE, echo=FALSE }
## Load packages ----
packages <- c("ggplot2", "dplyr", "tidyr", "lubridate", "sf","scales", 
              "cowplot",
              "grDevices",
              "magrittr",
              "rlang", 
              "INLA")

invisible(lapply(packages, require, character.only = TRUE))  # Suppress output

## Load GHRmodel package ----

path_to_package <- "/home/akawieck/Documents/projects/IDExtremes/GHRmodel/ghrmodel_0.0.0.9000.tar.gz"

install.packages(path_to_package , 
                 repos = NULL, type = "source", INSTALL_opts = c("--no-multiarch", "--no-test-load"))


library(ghrmodel)

## Load GHRexplore package ----

path_to_package <- "/home/akawieck/Documents/projects/IDExtremes/GHRexplore/ghrexplore_0.0.0.9000.tar.gz"

install.packages(path_to_package , 
                 repos = NULL, type = "source", INSTALL_opts = c("--no-multiarch", "--no-test-load"))


library(ghrexplore)

```


```{r load data}
## Load Harmonized Data ----
data <- read.csv("harmonized_data.csv")
head(data)

## Load shapefile
laos<- st_read("gadm41_LAO1_cleaned.shp")

ggplot() +
  geom_sf(data = laos)


```

```{r Adjacences Matrix}
# Create Adjacences Matrix
nb <- spdep::poly2nb(laos)
g <- spdep::nb2mat(nb, style = "B")
```


# GHRmodel description


# Model dengue in Laos

We learned from the exploration of the data that precipitation, minimum temperature and average temperature might be the most relevant variables affecting dengue incidence. We can also observe that there may be a relationship between 
dengue outbreaks and increased average temperatures several months before. 

## Prepare data for modeling in INLA

```{r numeric variables }
# Assign numeric IDs to non-numeric variables for INLA modeling

data<- data %>%
  dplyr::mutate(dplyr::across(c("year", "month", "province"), 
                ~ as.numeric(as.factor(.)), 
                .names = "{.col}_id"), 
         dplyr::across(c("dengue_cases", "population", 
"tasmax", "tasmin", "tas", "prlr"), 
                ~ as.numeric(.))) %>%
  dplyr::select(-X) %>%
  # person time = 100000 person-month
  mutate(dengue_incidence=(dengue_cases / population) * 100000 ) # calculate incidence
```

## Create lagged covariates

Here we create covariates lagged between 1-8 months for each observation, 
goruping by province.

```{r lagged covariates}

# Lag covariates and attach to the original data
data <- ghrmodel::lag_cov(data = data,
                var = c("tas", "prlr"),
                time = "date",
                lag = c(8),
                group = "province",
                full = TRUE) # Merge = TRUE the matrix is merged to the data

dplyr::glimpse(data)
```
## Explore non-linear effects

```{r Explore non-linear effects}

```

## Priors

```{r priors}
# Write  formulas with 3 random effects with customized prior
prior_re1 <- list(prec = list(prior = 'loggamma', param = c(0.01, 0.01)))
prior_re2 <- list(prec = list( prior = 'pc.prec', param = c(0.5 / 0.31, 0.01)),
                  phi = list( prior = 'pc', param = c(0.5, 2 / 3)))
```

| Prior            | Type                        | Parameters         | Meaning  |
|-----------------|---------------------------|-------------------|---------------------------|
| `prior_re1`     | Log-Gamma                  | `(0.01, 0.01)`    | Weak prior on precision, allowing large variance. |
| `prior_re2$prec` | PC Prior for Precision     | `(0.5 / 0.31, 0.01)` | Shrinks precision toward a reasonable range, avoiding overfitting. |
| `prior_re2$phi`  | PC Prior for Spatial Dependency | `(0.5, 2/3)`  | Encourages structured spatial correlation. |

**prior_re1: Log-Gamma Prior**

The loggamma(0.01, 0.01) prior (shape = 0.01, rate = 0.01 ) is commonly used as a weakly informative prior, ensuring flexibility in the variance structure without forcing a strong assumption.

**prior_re2: PC Prior for Precision**

0.5 / 0.31 ≈ 1.61 sets the prior on precision.

0.01 is the probability that the standard deviation (σ = sqrt(1/precision)) exceeds a given threshold.

The Penalized Complexity (PC) prior is designed to avoid overfitting by shrinking unnecessary complexity. This implies a preference for a moderate variance but allows the data to override it if needed.

**prior_re2: Spatial Dependency (phi)**

0.5: The median of phi (controls spatial dependency balance).

2 / 3 ≈ 0.67: Probability that phi > 0.5.

phi is a mixing parameter that controls the balance between the structured spatial effect (neighbor-dependent) or unstructured spatial effect (independent random noise).
A prior that favors phi > 0.5 encourages spatial smoothing, meaning that neighboring areas share more information.

## Univariate predictors

First we will test the models with univariable predictors, to determine whether
we should include linear or non-linear predictors in our model based on 
goodness of fit. 


### Write univariate model functions

```{r lists of univariate covariates linear and non linear}

# Create a list of linear lagged univariable predictors. 
# Includes all covariates that include the pattern tas.l and prlr.l 

cov_uni_l <- ghrmodel::extract_covariates(data=data, 
                                           pattern= c("tas.l", 
                                                      "prlr.l"))

dplyr::glimpse(cov_uni_l)

# Create a list of non linear lagged univariable predictors not replicated
cov_uni_l_nl <- ghrmodel::non_linear_covariates(covariates = cov_uni_l,
                                      method = "quantile",
                                      pattern = c("tas", "prlr"),
                                      n = 10)
dplyr::glimpse(cov_uni_l_nl)

# Create a list of non linear lagged univariable predictors replicated by province
cov_uni_l_nl_rep <- ghrmodel::non_linear_covariates(covariates = cov_uni_l,
                                      method = "quantile",
                                      pattern = c("tas", "prlr"),
                                      n = 10,
                                      replicate = "province")

dplyr::glimpse(cov_uni_l_nl_rep)

```

```{r univariate list}


cov_uni_list <- c( "tas",
                     "prlr",
                      cov_uni_l, 
                      cov_uni_l_nl) #, cov_uni_l_nl_rep

dplyr::glimpse(cov_uni_list)

saveRDS(cov_uni_list, "cov_uni_list.rds")
```


### Write univariate model formulas

```{r univariate model formulas }
cov_uni_formulas <- write_inla_formulas(outcome = "dengue_cases",
                                        covariates = cov_uni_list ,
                                        re1 = list(id ="month_id",
                                                   re ="rw1", cyclic = TRUE,
                                                   hyper = "prior_re1",
                                                   replicate = "province_id" ),
                                        re2 = list(id = "year_id",
                                                   re = "rw1",
                                                   hyper = "prior_re1"),
                                        re3 = list(id = "province_id",
                                                   re = "bym2",
                                                   graph = "g", 
                                                   hyper = "prior_re2"),
                                                   baseline = TRUE)

head(cov_uni_formulas)
```

```{r univariate GHRformulas object}

# transform formulas list into a GHRformulas object

cov_uni_formulas_ghr <- ghrmodel::as_GHRformulas(formulas = cov_uni_formulas)

class(cov_uni_formulas_ghr)
str(cov_uni_formulas_ghr)
dplyr::glimpse(cov_uni_formulas_ghr$vars)
```

### Fit univariate models 

```{r Fit univariate models, eval = FALSE }

m_uni <- ghrmodel::fit_models(formulas = cov_uni_formulas_ghr  ,
                           data = data,
                           family = "nbinomial",      # specify family
                           name = "m",
                           offset = "population",
                           config = TRUE,
                           pb = TRUE, 
                           nthreads = 8)


saveRDS(m_uni, "m_uni.rds")

```

```{r read in m_uni}
m_uni <- readRDS("m_uni.rds")
```


### Rank univariate models 

```{r  goodness of fit dataframe}
# goodness of fit metrics in a dataframe
m_uni_gof <- m_uni$mod.gof

m_uni_gof <- m_uni_gof %>%
  dplyr::arrange(waic)%>%
  dplyr::mutate(rank_waic = dense_rank(waic)) %>%
  dplyr::arrange(crps)%>%
  dplyr::mutate(rank_crps = dense_rank(crps))%>%
  dplyr::arrange(mae)%>%
  dplyr::mutate(rank_mae = dense_rank(mae))

```

**WAIC**
```{r rank_uni_waic}

rank_uni_waic_vs_base <- ghrmodel::rank_models(
  models = m_uni,
  metric = "waic_vs_base",
  plot = TRUE,
  n = 10, 
  intercept = TRUE,
  ci = TRUE
)


m_uni_gof %>%
  dplyr::filter(model_id %in% rank_uni_waic_vs_base)%>%
  dplyr::select(model_id, covariate_1, waic, rank_waic)%>%
  dplyr::arrange(waic)
```

Best fitting models for precipitation have non linear precipitation terms. 
Lags 5-8 fit better that the base model but not significantly so. 

Non-linear temperature measures also fit better, but these terms do not improve
the model over the base model. 


**CRPS**
```{r rank_uni_crps}
rank_uni_crps <- ghrmodel::rank_models(
  models = m_uni,
  metric = "crps",
  plot = TRUE,
  n = 10, 
  intercept = TRUE
)

m_uni_gof %>%
  dplyr::filter(model_id %in% rank_uni_crps)%>%
  dplyr::select(model_id, covariate_1, crps)%>%
  dplyr::arrange(crps)
```

**MAE**
```{r rank_uni_mae}
rank_uni_mae <- ghrmodel::rank_models(
  models = m_uni,
  metric = "mae",
  plot = TRUE,
  n = 8, 
  intercept = TRUE
)


m_uni_gof %>%
  dplyr::filter(model_id %in% rank_uni_mae)%>%
  dplyr::select(model_id, covariate_1, mae)%>%
  dplyr::arrange(mae)
```

### Posterior prediction check of univariate models

This function refits (or retrieves) the specified model, generates posterior predictions, and compares these predictions to the observed data by plotting their density estimates.

```{r post pred check univariate}

# Best fitting model according to WAIC 
ppc_m33<-ghrmodel::post_pred_check(models = m_uni, model_id = "m33", s = 100, predictions = TRUE)



```


### Fit vs. Observed plots for univariate models

```{r plot fit univariate models }
# Plot model outputs
ghrmodel::plot_fit(
  models = m_uni,
  time = "date", 
  model_id = "m33",
  model_ref = "m1",
  #area = "province",
  selected_area = NULL,
  title = "Fitted (non-linear precipitation lag 6) vs Observed"
)

```

Pretty similar to the only random effect model. 

### Plot random effects for univariate models 

**Spatial random effects**

 * Coeffecient plot 
 
```{r univariate spatial re coefficient }
ghrmodel::plot_re_sp(
  models = m_uni,
  model_id = "m33",
  model_ref = "m1",
 # map = MS_map,
 #  map_area = "code",
  re_id = "province_id",
  label_model = NULL,
  title = "Spatial Random Effects"
)
```
 
 * Map plot 
 
```{r univariate spatial re map }
ghrmodel::plot_re_sp(
  models = m_uni,
  model_id = "m33",
  model_ref = "m1",
  map = laos,
  map_area = "NAME_1",
  re_id = "province_id",
  label_model = NULL,
  title = "Spatial Random Effects"
)
```


**Yearly random effects**

```{r univariate yearly re }
ghrmodel::plot_re_t(
  models = m_uni,
  model_ids = c("m33", "m4", "m20"),
  model_ref = "m1",
  re_id = "year_id",
  label_model = NULL,
  title = "Yearly Random Effects"
)
```
**Monthly random effects**

```{r univariate monthly re }
ghrmodel::plot_re_t(
  models = m_uni,
  model_ids = c("m33", "m4", "m20"),
  model_ref = "m1",
  re_id = "month_id",
  replicated_id = "province_id",
  label_model = NULL,
  title = "Monthly Random Effects"
)
```



### Plot fixed effects for univariate models

**Linear coefficients**

```{r univariate linear coefficients}
# linear coefficient of precipitation at 6 month lag
ghrmodel::plot_lin_coef(
  models = m_uni,
  model_id = "m17",
  color = "purple"
)
```

```{r univariate non-linear coefficients}
# non- linear coefficient of precipitation at 6 month lag

ghrmodel::plot_nl_coef(
  models = m_uni,
  model_id = "m33",
  var = "prlr.l6",
  title = "Exposure - Response",
  var_label = "Precipitation lag 6",
  color = "blue", 
  show_hist = TRUE
)

```
This suggests that when there were small amounts of precipitation 6 months previously, 
this can lead to an increase in dengue incidence




## Multivariate predictors

From the univariate models we learned that non-linear precipitation lagged at 5-8 months fits the model well, as well as linear and non-linear average temperature lagged 0-8 months, so we will test models with combinations of these covariates.

### Write multivariate model functions

```{r lists of multivariate covariates linear and non linear}

# Create a list of combined multivariate predictors
cov_multi_list <- ghrmodel::combine_covariates(covariates = cov_uni_l,
                                    pattern=c("tas.l",
                                              "prlr.l"))

dplyr::glimpse(cov_multi_list)


# Create a list of combined multivariate predictors, with non-linear precipitation

cov_multi_nl_list <- ghrmodel::non_linear_covariates(covariates = cov_multi_list,
                                           method = "quantile",
                                           pattern = c("prlr.l", "tas.l"),
                                           n = 10)
dplyr::glimpse(cov_multi_nl_list)


```

### Write multivariate model formulas

```{r multivariate model formulas }
cov_multi_nl_formulas <- write_inla_formulas(outcome = "dengue_cases",
                                        covariates = cov_multi_nl_list ,
                                        re1 = list(id ="month_id",
                                                   re ="rw1", cyclic = TRUE,
                                                   hyper = "prior_re1",
                                                   replicate = "province_id" ),
                                        re2 = list(id = "year_id",
                                                   re = "rw1",
                                                   hyper = "prior_re1"),
                                        re3 = list(id = "province_id",
                                                   re = "bym2",
                                                   graph = "g", 
                                                   hyper = "prior_re2"),
                                                   baseline = TRUE)

head(cov_multi_nl_formulas)
```

```{r multivariate GHRformulas object}

# transform formulas list into a GHRformulas object

cov_multi_nl_formulas_ghr <- ghrmodel::as_GHRformulas(formulas = cov_multi_nl_formulas)

class(cov_multi_nl_formulas_ghr)
str(cov_multi_nl_formulas_ghr)
dplyr::glimpse(cov_multi_nl_formulas_ghr$vars)

```

### Fit multivariate models 


```{r Fit multivariate models}

m_multi <- ghrmodel::fit_models(formulas = cov_multi_nl_formulas_ghr  ,
                           data = data,
                           family = "nbinomial",      # specify family
                           name = "mm",
                           offset = "population",
                           config = TRUE,
                           pb = TRUE, 
                           nthreads = 8)



saveRDS(m_multi, "m_multi.rds")

```


```{r read in m_multi}
m_multi <- readRDS("m_multi.rds")
```

### Rank multivariate models 

```{r m_multi goodness of fit dataframe}
# goodness of fit metrics in a dataframe
m_multi_gof <- m_multi$mod.gof

m_multi_gof <- m_multi_gof %>%
  dplyr::arrange(waic)%>%
  dplyr::mutate(rank_waic = dense_rank(waic)) %>%
  dplyr::arrange(crps)%>%
  dplyr::mutate(rank_crps = dense_rank(crps))%>%
  dplyr::arrange(mae)%>%
  dplyr::mutate(rank_mae = dense_rank(mae))

```


**WAIC**
```{r rank_multi_waic}

rank_multi_waic_vs_base <- ghrmodel::rank_models(
  models = m_multi,
  metric = "waic_vs_base",
  plot = TRUE,
  n = 10, 
  intercept = TRUE,
  ci=TRUE
)

```

**CRPS**
```{r rank_multi_crps}
rank_multi_crps <- ghrmodel::rank_models(
  models = m_multi,
  metric = "crps",
  plot = TRUE,
  n = 10, 
  intercept = TRUE
)


```

**MAE**
```{r rank_multi_mae}
rank_multi_mae <- ghrmodel::rank_models(
  models = m_multi,
  metric = "mae",
  plot = TRUE,
  n = 10, 
  intercept = TRUE
)


```

```{r dataframe of 30 best models according to different gof metrics }
m_multi_gof_best <- m_multi_gof %>%
  dplyr::filter(model_id %in% rank_multi_waic_vs_base |
                model_id %in% rank_multi_crps |
                model_id %in% rank_multi_mae)%>%
  dplyr::select(model_id, covariate_1, covariate_2, waic, crps, mae,
                rank_waic, rank_mae, rank_crps)%>%
  dplyr::mutate(
    avg_rank = rowMeans(across(c(rank_waic, rank_mae, rank_crps)), na.rm = TRUE)
  )%>%
  dplyr::arrange(avg_rank)

m_best<- m_multi_gof_best[1, c("model_id")]

dplyr::glimpse(m_multi_gof_best)
```

### Posterior prediction check of multivariate models

This function refits (or retrieves) the specified model, generates posterior predictions, and compares these predictions to the observed data by plotting their density estimates.

```{r post pred check multivariate}

ppc_mm42<-ghrmodel::post_pred_check(models = m_multi, model_id = m_best, s = 100, predictions = TRUE)


```


### Fit vs. Observed plots for multivariate models

```{r plot fit multivariate models }
# Plot model outputs
ghrmodel::plot_fit(
  models = m_multi,
  time = "date", 
  model_id = m_best,
  model_ref = "mm1",
  area = "province",
  selected_area = NULL,
  title = "Fitted vs Observed"
)

```

Pretty similar to the only random effect model. 

### Plot random effects for multivariate models 

**Spatial random effects**

 * Coeffecient plot 
 
```{r multivariate spatial re coefficient }
ghrmodel::plot_re_sp(
  models = m_multi,
  model_id = m_best,
  model_ref = "mm1",
 # map = MS_map,
 #  map_area = "code",
  re_id = "province_id",
  label_model = NULL,
  title = "Spatial Random Effects"
)
```
 * Map plot 
```{r multivariate spatial re map }
ghrmodel::plot_re_sp(
  models = m_multi,
  model_id = "mm42",
  model_ref = "mm1",
  map = laos,
  map_area = "NAME_1",
  re_id = "province_id",
  label_model = NULL,
  title = "Spatial Random Effects"
)
```


**Yearly random effects**

```{r multivariate yearly re }
ghrmodel::plot_re_t(
  models = m_multi,
  model_ids = m_best,
  model_ref = "mm1",
  re_id = "year_id",
  label_model = NULL,
  title = "Yearly Random Effects"
)
```
**Monthly random effects**

```{r multivariate monthly re }
ghrmodel::plot_re_t(
  models = m_multi,
  model_ids = m_best,
  model_ref = "mm1",
  re_id = "month_id",
  replicated_id = "province_id",
  label_model = NULL,
  title = "Monthly Random Effects"
)
```


### Plot fixed effects for multivariate models


```{r multivariate non-linear coefficient prlr }
# non- linear coefficient of precipitation at 6 month lag

ghrmodel::plot_nl_coef(
  models = m_multi,
  model_id = m_best,
  var = "prlr.l6",
  title = "Exposure - Response",
  var_label = "Precipitation 6 month lag",
  color = "blue", 
  show_hist = TRUE
)

```


```{r multivariate non-linear coefficients temp }
# non- linear coefficient of precipitation at 6 month lag

ghrmodel::plot_nl_coef(
  models = m_multi,
  model_id = m_best,
  var = "tas.l4",
  title = "Exposure - Response",
  var_label = "Non-linear Avg- Temp lag 4",
  color = "blue", 
  show_hist = TRUE
)

```


### All models

```{r merge models into one ghrmodel object}
m_all <- c(m_uni, m_multi)
class(m_all ) <- class(m_all)  # or class(m_uni), they should be the same

m_all_mod.gof<- m_all$mod.gof
```

