## ----setup, include = FALSE---------------------------------------------------
# Evaluated wherever INLA and the serving stack are installed (CI and
# development machines); rendered as static code elsewhere.
knitr::opts_chunk$set(
  collapse = TRUE,
  comment  = "#>",
  eval     = all(vapply(
    c("INLA", "vetiver", "pins", "plumber", "callr", "httr2", "yardstick"),
    requireNamespace, logical(1), quietly = TRUE
  ))
)


## ----message = FALSE----------------------------------------------------------
library(inlabru)
library(vetiver)
library(pins)
library(plumber)
library(inlaops)


## -----------------------------------------------------------------------------
set.seed(42)
n   <- 200
dat <- data.frame(
  x1 = rnorm(n),
  x2 = rnorm(n)
)
dat$y <- 2 + 0.8 * dat$x1 - 0.4 * dat$x2 + rnorm(n, sd = 0.5)

fit <- bru(
  y ~ Intercept(1) + x1 + x2,
  family  = "gaussian",
  data    = dat,
  options = bru_options(
    control.compute = list(config = TRUE, dic = TRUE, waic = TRUE)
  )
)


## -----------------------------------------------------------------------------
v <- vetiver_model(
  fit, "gaussian_glm",
  metadata = list(
    pred_formula = "~ Intercept + x1 + x2",
    n_samples    = 200L,   # posterior samples per request; 200 is the default
    waic         = fit$waic$waic,
    dic          = fit$dic$dic
  )
)
v
v$prototype


## ----eval = FALSE-------------------------------------------------------------
# fit_p <- bru_reg(family = "gaussian") |>
#   parsnip::set_engine("inlabru") |>
#   parsnip::fit(y ~ Intercept(1) + x1 + x2, data = dat)
# 
# v_parsnip <- vetiver_model(
#   fit_p$fit, "gaussian_glm",   # note: fit_p$fit
#   metadata = list(pred_formula = "~ Intercept + x1 + x2")
# )


## -----------------------------------------------------------------------------
board <- board_temp()   # swap for board_s3(), board_connect(), etc.
vetiver_pin_write(board, v)

pin_versions(board, "gaussian_glm")


## ----eval = FALSE-------------------------------------------------------------
# pr() |>
#   vetiver_api(v) |>
#   pr_run(port = 8088)


## -----------------------------------------------------------------------------
port <- httpuv::randomPort()

server <- callr::r_bg(
  function(board_path, port) {
    library(inlaops)
    v <- vetiver::vetiver_pin_read(pins::board_folder(board_path), "gaussian_glm")
    plumber::pr() |> vetiver::vetiver_api(v) |> plumber::pr_run(port = port)
  },
  args = list(board_path = board$path, port = port)
)

# Wait until the API answers its health check.
for (i in 1:60) {
  up <- tryCatch(
    {
      httr2::request(sprintf("http://127.0.0.1:%d/ping", port)) |>
        httr2::req_perform()
      TRUE
    },
    error = function(e) FALSE
  )
  if (up || !server$is_alive()) break
  Sys.sleep(1)
}
stopifnot(up)


## -----------------------------------------------------------------------------
endpoint <- vetiver_endpoint(sprintf("http://127.0.0.1:%d/predict", port))

new_obs <- data.frame(x1 = c(0.5, -1.2), x2 = c(1.0, 0.3))
predict(endpoint, new_obs)


## -----------------------------------------------------------------------------
try(predict(endpoint, data.frame(x1 = 0.5)))


## -----------------------------------------------------------------------------
server$kill()


## -----------------------------------------------------------------------------
versions <- pin_versions(board, "gaussian_glm")

do.call(rbind, lapply(versions$version, function(ver) {
  meta <- pin_meta(board, "gaussian_glm", version = ver)
  data.frame(version = ver, waic = meta$user$waic, dic = meta$user$dic)
}))


## -----------------------------------------------------------------------------
monitoring_data <- dat  # in production: observations collected since deployment
monitoring_data$.pred <- inlabru::generate(
  fit, newdata = monitoring_data,
  formula = ~ Intercept + x1 + x2, n.samples = 500
) |> rowMeans()

# Synthetic timestamps for the example. Replace with real collection times.
monitoring_data$obs_date <- seq.Date(
  from       = as.Date("2026-01-01"),
  by         = "day",
  length.out = nrow(monitoring_data)
)

metrics_board <- board_temp()

new_metrics <- vetiver_compute_metrics(
  monitoring_data,
  date_var = obs_date,
  period   = "week",
  truth    = y,
  estimate = .pred
)

# vetiver_pin_metrics() appends to an existing metrics pin — the first time
# you record metrics, write the pin directly with pins::pin_write(). On
# subsequent runs (e.g. weekly cron jobs), use vetiver_pin_metrics() so each
# new window's rows are appended without overwriting history.
if ("gaussian_glm_metrics" %in% pins::pin_list(metrics_board)) {
  vetiver_pin_metrics(metrics_board, new_metrics, "gaussian_glm_metrics")
} else {
  pins::pin_write(metrics_board, new_metrics, "gaussian_glm_metrics")
}

head(pins::pin_read(metrics_board, "gaussian_glm_metrics"))


## ----eval = FALSE-------------------------------------------------------------
# v <- vetiver_model(
#   fit,
#   "multi_lhood_model",
#   save_prototype = tibble::tibble(x1 = 0, x2 = 0)
# )