## Load Harmonized Data ----
data <- read.csv("harmonized_data.csv")
head(data)
## X year month date province dengue_cases population tasmax
## 1 1 2023 1 2023-01-01 Xaisomboun 1 114000 23.89677
## 2 2 2023 1 2023-01-01 Attapu 10 166000 30.78710
## 3 3 2023 1 2023-01-01 Champasak 5 772000 30.78710
## 4 4 2023 1 2023-01-01 Xekong 3 134000 30.63548
## 5 5 2023 1 2023-01-01 Salavan 9 457000 29.26774
## 6 6 2023 1 2023-01-01 Savannakhet 15 1102000 28.32581
## tasmin tas prlr
## 1 7.970968 15.93387 8.8
## 2 20.403226 25.59516 0.8
## 3 18.535484 24.66129 32.8
## 4 16.403226 23.51935 5.0
## 5 17.719355 23.49355 19.2
## 6 15.461290 21.89355 0.7
## Load shapefile
laos<- st_read("gadm41_LAO1_cleaned.shp")
## Reading layer `gadm41_LAO1_cleaned' from data source
## `/home/akawieck/Documents/projects/DHIS2/dhis2.personal/ghrsuite_laos/gadm41_LAO1_cleaned.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 18 features and 11 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: 100.0868 ymin: 13.90968 xmax: 107.635 ymax: 22.5004
## Geodetic CRS: WGS 84
ggplot() +
geom_sf(data = laos)
# Create Adjacences Matrix
nb <- spdep::poly2nb(laos)
g <- spdep::nb2mat(nb, style = "B")
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.
# 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
Here we create covariates lagged between 1-8 months for each observation, goruping by province.
# 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)
## Rows: 1,944
## Columns: 30
## $ year <int> 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015,…
## $ month <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2, 3, 4, 5,…
## $ date <chr> "2015-01-01", "2015-02-01", "2015-03-01", "2015-04-01…
## $ province <chr> "Attapu", "Attapu", "Attapu", "Attapu", "Attapu", "At…
## $ dengue_cases <dbl> 13, 39, 36, 21, 46, 68, 166, 171, 67, 44, 13, 8, 14, …
## $ population <dbl> 166000, 166000, 166000, 166000, 166000, 166000, 16600…
## $ tasmax <dbl> 31.98065, 33.42500, 36.29032, 37.68000, 36.58710, 33.…
## $ tasmin <dbl> 17.55161, 20.41786, 24.76129, 25.89333, 26.89677, 25.…
## $ tas <dbl> 24.78387, 26.94286, 30.55484, 31.81667, 31.76129, 29.…
## $ prlr <dbl> 7.6, 0.0, 2.3, 0.7, 71.0, 353.6, 293.6, 282.7, 148.9,…
## $ year_id <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2,…
## $ month_id <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2, 3, 4, 5,…
## $ province_id <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ dengue_incidence <dbl> 7.831325, 23.493976, 21.686747, 12.650602, 27.710843,…
## $ tas.l1 <dbl> NA, 24.78387, 26.94286, 30.55484, 31.81667, 31.76129,…
## $ tas.l2 <dbl> NA, NA, 24.78387, 26.94286, 30.55484, 31.81667, 31.76…
## $ tas.l3 <dbl> NA, NA, NA, 24.78387, 26.94286, 30.55484, 31.81667, 3…
## $ tas.l4 <dbl> NA, NA, NA, NA, 24.78387, 26.94286, 30.55484, 31.8166…
## $ tas.l5 <dbl> NA, NA, NA, NA, NA, 24.78387, 26.94286, 30.55484, 31.…
## $ tas.l6 <dbl> NA, NA, NA, NA, NA, NA, 24.78387, 26.94286, 30.55484,…
## $ tas.l7 <dbl> NA, NA, NA, NA, NA, NA, NA, 24.78387, 26.94286, 30.55…
## $ tas.l8 <dbl> NA, NA, NA, NA, NA, NA, NA, NA, 24.78387, 26.94286, 3…
## $ prlr.l1 <dbl> NA, 7.6, 0.0, 2.3, 0.7, 71.0, 353.6, 293.6, 282.7, 14…
## $ prlr.l2 <dbl> NA, NA, 7.6, 0.0, 2.3, 0.7, 71.0, 353.6, 293.6, 282.7…
## $ prlr.l3 <dbl> NA, NA, NA, 7.6, 0.0, 2.3, 0.7, 71.0, 353.6, 293.6, 2…
## $ prlr.l4 <dbl> NA, NA, NA, NA, 7.6, 0.0, 2.3, 0.7, 71.0, 353.6, 293.…
## $ prlr.l5 <dbl> NA, NA, NA, NA, NA, 7.6, 0.0, 2.3, 0.7, 71.0, 353.6, …
## $ prlr.l6 <dbl> NA, NA, NA, NA, NA, NA, 7.6, 0.0, 2.3, 0.7, 71.0, 353…
## $ prlr.l7 <dbl> NA, NA, NA, NA, NA, NA, NA, 7.6, 0.0, 2.3, 0.7, 71.0,…
## $ prlr.l8 <dbl> NA, NA, NA, NA, NA, NA, NA, NA, 7.6, 0.0, 2.3, 0.7, 7…
# 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.
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.
# 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)
## List of 16
## $ : chr "tas.l1"
## $ : chr "tas.l2"
## $ : chr "tas.l3"
## $ : chr "tas.l4"
## $ : chr "tas.l5"
## $ : chr "tas.l6"
## $ : chr "tas.l7"
## $ : chr "tas.l8"
## $ : chr "prlr.l1"
## $ : chr "prlr.l2"
## $ : chr "prlr.l3"
## $ : chr "prlr.l4"
## $ : chr "prlr.l5"
## $ : chr "prlr.l6"
## $ : chr "prlr.l7"
## $ : chr "prlr.l8"
# 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)
## List of 16
## $ : chr "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
# 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)
## List of 16
## $ : chr "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2', replicate =province)"
## $ : chr "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2', replicate =province)"
cov_uni_list <- c( "tas",
"prlr",
cov_uni_l,
cov_uni_l_nl) #, cov_uni_l_nl_rep
dplyr::glimpse(cov_uni_list)
## List of 34
## $ : chr "tas"
## $ : chr "prlr"
## $ : chr "tas.l1"
## $ : chr "tas.l2"
## $ : chr "tas.l3"
## $ : chr "tas.l4"
## $ : chr "tas.l5"
## $ : chr "tas.l6"
## $ : chr "tas.l7"
## $ : chr "tas.l8"
## $ : chr "prlr.l1"
## $ : chr "prlr.l2"
## $ : chr "prlr.l3"
## $ : chr "prlr.l4"
## $ : chr "prlr.l5"
## $ : chr "prlr.l6"
## $ : chr "prlr.l7"
## $ : chr "prlr.l8"
## $ : chr "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
saveRDS(cov_uni_list, "cov_uni_list.rds")
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)
## [1] "dengue_cases ~ 1 + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [2] "dengue_cases ~ 1 + tas + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [3] "dengue_cases ~ 1 + prlr + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [4] "dengue_cases ~ 1 + tas.l1 + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [5] "dengue_cases ~ 1 + tas.l2 + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [6] "dengue_cases ~ 1 + tas.l3 + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
# transform formulas list into a GHRformulas object
cov_uni_formulas_ghr <- ghrmodel::as_GHRformulas(formulas = cov_uni_formulas)
class(cov_uni_formulas_ghr)
## [1] "GHRformulas" "list"
str(cov_uni_formulas_ghr)
## List of 4
## $ formulas: chr [1:35] "dengue_cases ~ 1 + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.mode"| __truncated__ "dengue_cases ~ 1 + tas + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scal"| __truncated__ "dengue_cases ~ 1 + prlr + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, sca"| __truncated__ "dengue_cases ~ 1 + tas.l1 + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, s"| __truncated__ ...
## $ vars :'data.frame': 35 obs. of 1 variable:
## ..$ covariate_1: chr [1:35] NA "tas" "prlr" "tas.l1" ...
## $ re : Named chr [1:3] "f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1)" "f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1)" "f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## ..- attr(*, "names")= chr [1:3] "re_1" "re_2" "re_3"
## $ outcome : chr "dengue_cases"
## - attr(*, "class")= chr [1:2] "GHRformulas" "list"
dplyr::glimpse(cov_uni_formulas_ghr$vars)
## Rows: 35
## Columns: 1
## $ covariate_1 <chr> NA, "tas", "prlr", "tas.l1", "tas.l2", "tas.l3", "tas.l4",…
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")
m_uni <- readRDS("m_uni.rds")
# 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
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)
## model_id covariate_1 waic rank_waic
## 1 m33 prlr.l6_nl_q10_rw2 14187.43 1
## 2 m32 prlr.l5_nl_q10_rw2 14192.95 2
## 3 m35 prlr.l8_nl_q10_rw2 14194.99 3
## 4 m34 prlr.l7_nl_q10_rw2 14198.99 4
## 5 m1 <NA> 14199.31 5
## 6 m23 tas.l4_nl_q10_rw2 14199.36 6
## 7 m24 tas.l5_nl_q10_rw2 14200.14 7
## 8 m27 tas.l8_nl_q10_rw2 14200.80 8
## 9 m22 tas.l3_nl_q10_rw2 14200.85 9
## 10 m20 tas.l1_nl_q10_rw2 14201.48 10
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
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)
## model_id covariate_1 crps
## 1 m4 tas.l1 5.416537
## 2 m5 tas.l2 5.434750
## 3 m8 tas.l5 5.461306
## 4 m7 tas.l4 5.462259
## 5 m11 tas.l8 5.462273
## 6 m2 tas 5.479605
## 7 m31 prlr.l4_nl_q10_rw2 5.489607
## 8 m9 tas.l6 5.492496
## 9 m12 prlr.l1 5.515304
## 10 m6 tas.l3 5.520986
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)
## model_id covariate_1 mae
## 1 m20 tas.l1_nl_q10_rw2 50.12735
## 2 m22 tas.l3_nl_q10_rw2 50.47793
## 3 m21 tas.l2_nl_q10_rw2 50.56224
## 4 m11 tas.l8 50.98238
## 5 m23 tas.l4_nl_q10_rw2 51.02828
## 6 m8 tas.l5 51.10294
## 7 m9 tas.l6 51.12154
## 8 m7 tas.l4 51.13045
This function refits (or retrieves) the specified model, generates posterior predictions, and compares these predictions to the observed data by plotting their density estimates.
# Best fitting model according to WAIC
ppc_m33<-ghrmodel::post_pred_check(models = m_uni, model_id = "m33", s = 100, predictions = TRUE)
# 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.
Spatial random effects
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"
)
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
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
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"
)
Linear coefficients
# linear coefficient of precipitation at 6 month lag
ghrmodel::plot_lin_coef(
models = m_uni,
model_id = "m17",
color = "purple"
)
# 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
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.
# 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)
## List of 64
## $ : chr [1:2] "tas.l1" "prlr.l1"
## $ : chr [1:2] "tas.l2" "prlr.l1"
## $ : chr [1:2] "tas.l3" "prlr.l1"
## $ : chr [1:2] "tas.l4" "prlr.l1"
## $ : chr [1:2] "tas.l5" "prlr.l1"
## $ : chr [1:2] "tas.l6" "prlr.l1"
## $ : chr [1:2] "tas.l7" "prlr.l1"
## $ : chr [1:2] "tas.l8" "prlr.l1"
## $ : chr [1:2] "tas.l1" "prlr.l2"
## $ : chr [1:2] "tas.l2" "prlr.l2"
## $ : chr [1:2] "tas.l3" "prlr.l2"
## $ : chr [1:2] "tas.l4" "prlr.l2"
## $ : chr [1:2] "tas.l5" "prlr.l2"
## $ : chr [1:2] "tas.l6" "prlr.l2"
## $ : chr [1:2] "tas.l7" "prlr.l2"
## $ : chr [1:2] "tas.l8" "prlr.l2"
## $ : chr [1:2] "tas.l1" "prlr.l3"
## $ : chr [1:2] "tas.l2" "prlr.l3"
## $ : chr [1:2] "tas.l3" "prlr.l3"
## $ : chr [1:2] "tas.l4" "prlr.l3"
## $ : chr [1:2] "tas.l5" "prlr.l3"
## $ : chr [1:2] "tas.l6" "prlr.l3"
## $ : chr [1:2] "tas.l7" "prlr.l3"
## $ : chr [1:2] "tas.l8" "prlr.l3"
## $ : chr [1:2] "tas.l1" "prlr.l4"
## $ : chr [1:2] "tas.l2" "prlr.l4"
## $ : chr [1:2] "tas.l3" "prlr.l4"
## $ : chr [1:2] "tas.l4" "prlr.l4"
## $ : chr [1:2] "tas.l5" "prlr.l4"
## $ : chr [1:2] "tas.l6" "prlr.l4"
## $ : chr [1:2] "tas.l7" "prlr.l4"
## $ : chr [1:2] "tas.l8" "prlr.l4"
## $ : chr [1:2] "tas.l1" "prlr.l5"
## $ : chr [1:2] "tas.l2" "prlr.l5"
## $ : chr [1:2] "tas.l3" "prlr.l5"
## $ : chr [1:2] "tas.l4" "prlr.l5"
## $ : chr [1:2] "tas.l5" "prlr.l5"
## $ : chr [1:2] "tas.l6" "prlr.l5"
## $ : chr [1:2] "tas.l7" "prlr.l5"
## $ : chr [1:2] "tas.l8" "prlr.l5"
## $ : chr [1:2] "tas.l1" "prlr.l6"
## $ : chr [1:2] "tas.l2" "prlr.l6"
## $ : chr [1:2] "tas.l3" "prlr.l6"
## $ : chr [1:2] "tas.l4" "prlr.l6"
## $ : chr [1:2] "tas.l5" "prlr.l6"
## $ : chr [1:2] "tas.l6" "prlr.l6"
## $ : chr [1:2] "tas.l7" "prlr.l6"
## $ : chr [1:2] "tas.l8" "prlr.l6"
## $ : chr [1:2] "tas.l1" "prlr.l7"
## $ : chr [1:2] "tas.l2" "prlr.l7"
## $ : chr [1:2] "tas.l3" "prlr.l7"
## $ : chr [1:2] "tas.l4" "prlr.l7"
## $ : chr [1:2] "tas.l5" "prlr.l7"
## $ : chr [1:2] "tas.l6" "prlr.l7"
## $ : chr [1:2] "tas.l7" "prlr.l7"
## $ : chr [1:2] "tas.l8" "prlr.l7"
## $ : chr [1:2] "tas.l1" "prlr.l8"
## $ : chr [1:2] "tas.l2" "prlr.l8"
## $ : chr [1:2] "tas.l3" "prlr.l8"
## $ : chr [1:2] "tas.l4" "prlr.l8"
## $ : chr [1:2] "tas.l5" "prlr.l8"
## $ : chr [1:2] "tas.l6" "prlr.l8"
## $ : chr [1:2] "tas.l7" "prlr.l8"
## $ : chr [1:2] "tas.l8" "prlr.l8"
# 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)
## List of 64
## $ : chr [1:2] "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l2, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l3, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l4, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l5, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l6, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l7, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l6, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l7, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
## $ : chr [1:2] "f(INLA::inla.group(tas.l8, method='quantile', n=10), model='rw2')" "f(INLA::inla.group(prlr.l8, method='quantile', n=10), model='rw2')"
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)
## [1] "dengue_cases ~ 1 + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [2] "dengue_cases ~ 1 + f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2') + f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2') + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [3] "dengue_cases ~ 1 + f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2') + f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2') + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [4] "dengue_cases ~ 1 + f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2') + f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2') + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [5] "dengue_cases ~ 1 + f(INLA::inla.group(tas.l4, method='quantile', n=10), model='rw2') + f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2') + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## [6] "dengue_cases ~ 1 + f(INLA::inla.group(tas.l5, method='quantile', n=10), model='rw2') + f(INLA::inla.group(prlr.l1, method='quantile', n=10), model='rw2') + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1) + f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
# 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)
## [1] "GHRformulas" "list"
str(cov_multi_nl_formulas_ghr)
## List of 4
## $ formulas: chr [1:65] "dengue_cases ~ 1 + f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.mode"| __truncated__ "dengue_cases ~ 1 + f(INLA::inla.group(tas.l1, method='quantile', n=10), model='rw2') + f(INLA::inla.group(prlr."| __truncated__ "dengue_cases ~ 1 + f(INLA::inla.group(tas.l2, method='quantile', n=10), model='rw2') + f(INLA::inla.group(prlr."| __truncated__ "dengue_cases ~ 1 + f(INLA::inla.group(tas.l3, method='quantile', n=10), model='rw2') + f(INLA::inla.group(prlr."| __truncated__ ...
## $ vars :'data.frame': 65 obs. of 2 variables:
## ..$ covariate_1: chr [1:65] NA "tas.l1_nl_q10_rw2" "tas.l2_nl_q10_rw2" "tas.l3_nl_q10_rw2" ...
## ..$ covariate_2: chr [1:65] NA "prlr.l1_nl_q10_rw2" "prlr.l1_nl_q10_rw2" "prlr.l1_nl_q10_rw2" ...
## $ re : Named chr [1:3] "f(month_id, model = 'rw1', replicate = province_id, cyclic = TRUE, constr = TRUE, scale.model = TRUE, hyper = prior_re1)" "f(year_id, model = 'rw1', constr = TRUE, scale.model = TRUE, hyper = prior_re1)" "f(province_id, model = 'bym2', graph = g, constr = TRUE, scale.model = TRUE, hyper = prior_re2)"
## ..- attr(*, "names")= chr [1:3] "re_1" "re_2" "re_3"
## $ outcome : chr "dengue_cases"
## - attr(*, "class")= chr [1:2] "GHRformulas" "list"
dplyr::glimpse(cov_multi_nl_formulas_ghr$vars)
## Rows: 65
## Columns: 2
## $ covariate_1 <chr> NA, "tas.l1_nl_q10_rw2", "tas.l2_nl_q10_rw2", "tas.l3_nl_q…
## $ covariate_2 <chr> NA, "prlr.l1_nl_q10_rw2", "prlr.l1_nl_q10_rw2", "prlr.l1_n…
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)
## | | | 0% | |= | 2%
## Model 1 of 65 total run time 0.12 minutes.
## | |== | 3%
## Model 2 of 65 total run time 0.27 minutes.
## | |=== | 5%
## Model 3 of 65 total run time 0.44 minutes.
## | |==== | 6%
## Model 4 of 65 total run time 0.61 minutes.
## | |===== | 8%
## Model 5 of 65 total run time 0.79 minutes.
## | |====== | 9%
## Model 6 of 65 total run time 0.95 minutes.
## | |======= | 11%
## Model 7 of 65 total run time 1.12 minutes.
## | |======== | 12%
## Model 8 of 65 total run time 1.29 minutes.
## | |========= | 14%
## Model 9 of 65 total run time 1.46 minutes.
## | |========== | 15%
## Model 10 of 65 total run time 1.62 minutes.
## | |=========== | 17%
## Model 11 of 65 total run time 1.8 minutes.
## | |============ | 18%
## Model 12 of 65 total run time 1.97 minutes.
## | |============= | 20%
## Model 13 of 65 total run time 2.14 minutes.
## | |============== | 22%
## Model 14 of 65 total run time 2.32 minutes.
## | |=============== | 23%
## Model 15 of 65 total run time 2.48 minutes.
## | |================ | 25%
## Model 16 of 65 total run time 2.64 minutes.
## | |================= | 26%
## Model 17 of 65 total run time 2.81 minutes.
## | |================== | 28%
## Model 18 of 65 total run time 2.98 minutes.
## | |=================== | 29%
## Model 19 of 65 total run time 3.15 minutes.
## | |==================== | 31%
## Model 20 of 65 total run time 3.31 minutes.
## | |===================== | 32%
## Model 21 of 65 total run time 3.47 minutes.
## | |====================== | 34%
## Model 22 of 65 total run time 3.66 minutes.
## | |======================= | 35%
## Model 23 of 65 total run time 3.82 minutes.
## | |======================== | 37%
## Model 24 of 65 total run time 4.01 minutes.
## | |========================= | 38%
## Model 25 of 65 total run time 4.17 minutes.
## | |========================== | 40%
## Model 26 of 65 total run time 4.35 minutes.
## | |=========================== | 42%
## Model 27 of 65 total run time 4.56 minutes.
## | |============================ | 43%
## Model 28 of 65 total run time 4.77 minutes.
## | |============================= | 45%
## Model 29 of 65 total run time 4.98 minutes.
## | |============================== | 46%
## Model 30 of 65 total run time 5.17 minutes.
## | |=============================== | 48%
## Model 31 of 65 total run time 5.36 minutes.
## | |================================ | 49%
## Model 32 of 65 total run time 5.54 minutes.
## | |================================= | 51%
## Model 33 of 65 total run time 5.71 minutes.
## | |================================== | 52%
## Model 34 of 65 total run time 5.87 minutes.
## | |=================================== | 54%
## Model 35 of 65 total run time 6.04 minutes.
## | |==================================== | 55%
## Model 36 of 65 total run time 6.2 minutes.
## | |===================================== | 57%
## Model 37 of 65 total run time 6.37 minutes.
## | |====================================== | 58%
## Model 38 of 65 total run time 6.55 minutes.
## | |======================================= | 60%
## Model 39 of 65 total run time 6.71 minutes.
## | |======================================== | 62%
## Model 40 of 65 total run time 6.91 minutes.
## | |========================================= | 63%
## Model 41 of 65 total run time 7.1 minutes.
## | |========================================== | 65%
## Model 42 of 65 total run time 7.33 minutes.
## | |=========================================== | 66%
## Model 43 of 65 total run time 7.53 minutes.
## | |============================================ | 68%
## Model 44 of 65 total run time 7.74 minutes.
## | |============================================= | 69%
## Model 45 of 65 total run time 7.95 minutes.
## | |============================================== | 71%
## Model 46 of 65 total run time 8.14 minutes.
## | |=============================================== | 72%
## Model 47 of 65 total run time 8.31 minutes.
## | |================================================ | 74%
## Model 48 of 65 total run time 8.47 minutes.
## | |================================================= | 75%
## Model 49 of 65 total run time 8.64 minutes.
## | |================================================== | 77%
## Model 50 of 65 total run time 8.81 minutes.
## | |=================================================== | 78%
## Model 51 of 65 total run time 8.99 minutes.
## | |==================================================== | 80%
## Model 52 of 65 total run time 9.16 minutes.
## | |===================================================== | 82%
## Model 53 of 65 total run time 9.35 minutes.
## | |====================================================== | 83%
## Model 54 of 65 total run time 9.53 minutes.
## | |======================================================= | 85%
## Model 55 of 65 total run time 9.73 minutes.
## | |======================================================== | 86%
## Model 56 of 65 total run time 9.94 minutes.
## | |========================================================= | 88%
## Model 57 of 65 total run time 10.14 minutes.
## | |========================================================== | 89%
## Model 58 of 65 total run time 10.36 minutes.
## | |=========================================================== | 91%
## Model 59 of 65 total run time 10.55 minutes.
## | |============================================================ | 92%
## Model 60 of 65 total run time 10.73 minutes.
## | |============================================================= | 94%
## Model 61 of 65 total run time 10.89 minutes.
## | |============================================================== | 95%
## Model 62 of 65 total run time 11.05 minutes.
## | |=============================================================== | 97%
## Model 63 of 65 total run time 11.21 minutes.
## | |================================================================ | 98%
## Model 64 of 65 total run time 11.39 minutes.
## | |=================================================================| 100%
## Model 65 of 65 total run time 11.56 minutes.
saveRDS(m_multi, "m_multi.rds")
m_multi <- readRDS("m_multi.rds")
# 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
rank_multi_waic_vs_base <- ghrmodel::rank_models(
models = m_multi,
metric = "waic_vs_base",
plot = TRUE,
n = 10,
intercept = TRUE,
ci=TRUE
)
CRPS
rank_multi_crps <- ghrmodel::rank_models(
models = m_multi,
metric = "crps",
plot = TRUE,
n = 10,
intercept = TRUE
)
MAE
rank_multi_mae <- ghrmodel::rank_models(
models = m_multi,
metric = "mae",
plot = TRUE,
n = 10,
intercept = TRUE
)
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::glimpse(m_multi_gof_best)
## Rows: 25
## Columns: 9
## $ model_id <chr> "mm58", "mm18", "mm60", "mm26", "mm19", "mm20", "mm59", "m…
## $ covariate_1 <chr> "tas.l1_nl_q10_rw2", "tas.l1_nl_q10_rw2", "tas.l3_nl_q10_r…
## $ covariate_2 <chr> "prlr.l8_nl_q10_rw2", "prlr.l3_nl_q10_rw2", "prlr.l8_nl_q1…
## $ waic <dbl> 14194.27, 14210.00, 14193.50, 14205.23, 14211.52, 14205.86…
## $ crps <dbl> 5.825668, 5.845244, 5.816415, 5.816151, 5.808012, 5.683192…
## $ mae <dbl> 49.99250, 50.07116, 50.27393, 50.29496, 50.30045, 50.40293…
## $ rank_waic <int> 12, 56, 10, 43, 58, 47, 19, 62, 22, 44, 1, 9, 8, 4, 45, 57…
## $ rank_mae <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 18, 21, 22, 23, 25, 31,…
## $ rank_crps <int> 53, 57, 52, 51, 50, 23, 60, 39, 48, 33, 16, 20, 31, 46, 6,…
This function refits (or retrieves) the specified model, generates posterior predictions, and compares these predictions to the observed data by plotting their density estimates.
ppc_mm42<-ghrmodel::post_pred_check(models = m_multi, model_id = "mm42", s = 100, predictions = TRUE)
# Plot model outputs
ghrmodel::plot_fit(
models = m_multi,
time = "date",
model_id = "mm42",
model_ref = "mm1",
area = "province",
selected_area = NULL,
title = "Fitted vs Observed"
)
Pretty similar to the only random effect model.
Spatial random effects
ghrmodel::plot_re_sp(
models = m_multi,
model_id = "mm42",
model_ref = "mm1",
# map = MS_map,
# map_area = "code",
re_id = "province_id",
label_model = NULL,
title = "Spatial Random Effects"
)
* Map plot
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
ghrmodel::plot_re_t(
models = m_multi,
model_ids = c("mm42"),
model_ref = "mm1",
re_id = "year_id",
label_model = NULL,
title = "Yearly Random Effects"
)
Monthly random effects
ghrmodel::plot_re_t(
models = m_multi,
model_ids = c("mm42"),
model_ref = "mm1",
re_id = "month_id",
replicated_id = "province_id",
label_model = NULL,
title = "Monthly Random Effects"
)