---
title: "Loaloa prevalence with FEM Matérn"
author: "Patrick Brown"
date: "`r Sys.Date()`"
output:
  rmarkdown::html_vignette:
    toc: true
vignette: >
  %\VignetteIndexEntry{Loaloa prevalence with FEM Matérn}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 5
)
has_geostatsp <- requireNamespace("geostatsp", quietly = TRUE) &&
  requireNamespace("terra", quietly = TRUE)
```

```{r pkgs}
library(adlaplace)
library(adlaplaceGrf)
```

This vignette fits a binomial geostatistical model for loaloa prevalence
using a village-level IID effect and a FEM Matérn spatial field
(`shape = 2`, ν = 2), matching the Matérn shape used in geostatsp
examples. When **INLA** is available, the same model is also fit with
`geostatsp::glgm` for comparison.

```{r skip-check, echo=FALSE}
if (!has_geostatsp) {
  knitr::knit_exit()
}
```

## Data

```{r data}
data("loaloa", package = "geostatsp")

loaloa <- terra::unwrap(loaloa)
elev_r <- terra::unwrap(elevationLoa)
evi_r <- terra::unwrap(eviLoa)

elev_s_r <- (elev_r - 500) / 100
evi_s_r <- (
  evi_r - mean(terra::values(evi_r), na.rm = TRUE)
) / sd(terra::values(evi_r), na.rm = TRUE)

loaloa_for_fit <- geostatsp:::gm.dataSpatial(
  formula = y ~ elev + evi,
  data = loaloa,
  covariates = list(elev = elev_s_r, evi = evi_s_r),
  grid = geostatsp::squareRaster(loaloa, cells = 200, buffer = 1e4)
)
```

## Knot lines

Use a coarse knot raster over a buffered region around the villages; pass it
directly as `knots` to `matern()` (extent endpoints plus interior cell centers; see
`knots_from_spatraster()`).
(`geostatsp` / `terra` may mask `matern`, so call it with `::`.)



## Fit

geostatsp Matérn **shape = 2** is ν = 2 (SPDE α = 3 in 2D), so we pass
`shape = 2` to `matern()` (cubic B-splines / `random_fem_ssq_3`). Locations come
from the `geometry` column (WKT) in the model data frame.

```{r model_setup, cache=FALSE}
knots_grid <- geostatsp::squareRaster(loaloa, cells = 6, buffer = 300 * 1000)
loaloa_df <- as.data.frame(loaloa_for_fit$data, geom = "WKT")

loaloa_model <- adlaplace::binomial(y, size = N) ~
  elev + evi +
  adlaplace::iid(villageID, init = 0.2) +
  adlaplaceGrf::matern(
    geometry,
    knots = knots_grid,
    shape = 2L,
    # range = practical rho = sqrt(8*nu)/kappa (m); sd = field SD
    init = c(100 * 1000, 0.2),
    lower = c(1 * 1000, 0.001)
  )
```



```{r fit}
fit <- adlaplace::adlaplace(
  loaloa_model,
  data = loaloa_df,
  num_shards = 20L,
  control = list(maxit = 200, trace = 3, REPORT = 1),
  config = list(num_threads = 2L),
  verbose = FALSE
)
fit$optim$convergence
coef(fit)
```

```{r fit-glgm}
loaFit <- geostatsp::glgm(
  y ~ elev_s + evi_s +
    f(
      villageID,
      prior = "pc.prec",
      param = c(1, 0.5),
      model = "iid"
    ),
  loaloa,
  grid = 100,
  covariates = list(elev_s = elev_s_r, evi_s = evi_s_r),
  family = "binomial",
  Ntrials = loaloa$N,
  shape = 2,
  buffer = 25000,
  prior = list(sd = 1, range = 500 * 1000),
  control.inla = list(strategy = "gaussian")
)
```

## Summary

```{r summary}
logLik(fit)

cf <- coef(fit)
ad_pars <- c(
  intercept = unname(cf[["intercept"]]),
  elev = unname(cf[["elev_linear"]]),
  evi = unname(cf[["evi_linear"]]),
  village_sd = unname(cf[["villageID_iid"]]),
  # matern: practical range rho = sqrt(8*nu)/kappa (m); sd = field SD
  range = unname(cf[["geometry_matern_log_range"]]),
  sd = unname(cf[["geometry_matern_log_sd"]])
)
ad_pars
```

```{r summary-compare}
if (length(loaFit$parameters)) {
  glgm_sum <- loaFit$parameters$summary
  knitr::kable(glgm_sum[, c("mean", "0.025quant", "0.975quant")], digits = 3)

  # Map ad_pars names to rows of loaFit$parameters$summary
  row_for <- function(...) {
    pats <- c(...)
    hits <- unique(unlist(lapply(pats, function(p) {
      grep(p, rownames(glgm_sum), ignore.case = TRUE)
    })))
    if (!length(hits)) {
      return(NA_character_)
    }
    rownames(glgm_sum)[hits[1L]]
  }
  map <- c(
    intercept = row_for("^\\(Intercept\\)$", "^Intercept$"),
    elev = row_for("^elev"),
    evi = row_for("^evi"),
    village_sd = row_for("^sd villageID$", "sd.?villageID", "villageID.*[Ss]d"),
    range = row_for("^range/1000$", "^range$"),
    sd = row_for("^sd$", "SD for space")
  )

  glgm_pars <- setNames(
    vapply(map, function(nm) {
      if (is.na(nm)) {
        return(NA_real_)
      }
      as.numeric(glgm_sum[nm, "mean"])
    }, numeric(1)),
    names(map)
  )
  # summary may store range in km as "range/1000"
  if (!is.na(map[["range"]]) && identical(map[["range"]], "range/1000")) {
    glgm_pars[["range"]] <- glgm_pars[["range"]] * 1000
  }

  compare <- rbind(
    adlaplace = ad_pars[names(map)],
    glgm = glgm_pars
  )
  knitr::kable(compare, digits = 3)
}
```

## Estimated field

```{r est}
my_sim <- matern_est(fit, loaloa_for_fit$grid, n = 10)
```

Posterior mean and SD of the spatial field from both fits (glgm when available):

```{r plot-surfaces-setup, include=FALSE}
my_col <- mapmisc::colourScale(
  my_sim[[grep("sd", names(my_sim), invert = TRUE)]],
  style = "equal", digits = 2, breaks = 9, col = "Spectral"
)
sd_col <- mapmisc::colourScale(
  my_sim[[grep("sd", names(my_sim))]],
  style = "equal", digits = 2, breaks = 9
)
plot_compare <- exists("loaFit") && length(loaFit$parameters)
plot_alone <- !plot_compare
```

```{r plot-surfaces-compare, fig.width=8, fig.height=8, fig.cap="Posterior mean and SD of the spatial field (glgm vs adlaplace)."}
data("worldMap", package = "mapmisc")
worldMap <- terra::unwrap(worldMap)
worldMap <- terra::crop(worldMap, terra::ext(c(-2, 10, -10, 5) * 1e6))
worldMapT <- terra::project(worldMap, loaloa)
mapmisc::map.new(loaloa)
if (plot_compare) {
  terra::plot(
    loaFit$raster[["random.mean"]],
    add = TRUE, col = my_col$col, breaks = my_col$breaks, legend = FALSE
  )
}
terra::plot(worldMapT, add = TRUE)
mapmisc::legendBreaks("right", my_col)

mapmisc::map.new(loaloa)
terra::plot(
  my_sim[["mean"]],
  add = TRUE, col = my_col$col, breaks = my_col$breaks, legend = FALSE
)
terra::plot(worldMapT, add = TRUE)
mapmisc::legendBreaks("right", my_col)

mapmisc::map.new(loaloa)
if (plot_compare) {
  terra::plot(
    loaFit$raster[["random.sd"]],
    add = TRUE, col = sd_col$col, breaks = sd_col$breaks, legend = FALSE
  )
}
terra::plot(worldMapT, add = TRUE)
mapmisc::legendBreaks("right", sd_col)

mapmisc::map.new(loaloa)
terra::plot(
  my_sim[["sd"]],
  add = TRUE, col = sd_col$col, breaks = sd_col$breaks, legend = FALSE
)
terra::plot(worldMapT, add = TRUE)
mapmisc::legendBreaks("right", sd_col)
```




Four posterior draws of the adlaplace Matérn field:

```{r plot-sims, fig.width=8, fig.height=8}
sim_layers <- paste0("sim", 1:6)
terra::plot(my_sim[[sim_layers]], nc = 2, col = my_col$col, breaks = my_col$breaks, legend = FALSE)
mapmisc::legendBreaks("right", my_col, bty = "n")
```
