## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment  = "#>",
  eval     = FALSE
)


## -----------------------------------------------------------------------------
library(inlabru)
library(inlaops)
library(vetiver)
library(pins)
library(purrr)
library(dplyr)
library(scoringRules)


## -----------------------------------------------------------------------------
# Versioned, so every vetiver_pin_write() keeps the earlier versions.
board <- board_temp(versioned = TRUE)


## -----------------------------------------------------------------------------
set.seed(42)
n_stations <- 120

year1 <- data.frame(
  station  = seq_len(n_stations),
  habitat  = sample(c("forest", "open"), n_stations, replace = TRUE),
  effort   = runif(n_stations, 0.5, 2.0)
)
year1$habitat_open <- as.integer(year1$habitat == "open")
log_mu        <- 0.8 + 0.6 * year1$habitat_open + log(year1$effort)
year1$counts  <- rpois(n_stations, exp(log_mu))


## -----------------------------------------------------------------------------
set.seed(1)
val_idx   <- sample(n_stations, 20L)
val_data  <- year1[val_idx, ]
train_y1  <- year1[-val_idx, ]


## -----------------------------------------------------------------------------
fit_v1 <- bru(
  counts ~ Intercept(1) + habitat_open + effort,
  family  = "poisson",
  data    = train_y1,
  options = bru_options(
    control.compute = list(config = TRUE, dic = TRUE, waic = TRUE)
  )
)

scores_v1 <- bru_score(
  fit_v1,
  newdata      = val_data,
  # Poisson Y-samples: bru_score does not inject family-aware observation
  # noise — the user writes the rpois call. length(habitat_open) is the
  # observation count for the per-sample r*() (latent fields are scalars).
  pred_formula = ~ rpois(
    length(habitat_open),
    exp(Intercept + habitat_open + effort)
  ),
  y_col        = "counts",
  n_samples    = 1000L
)

v1 <- vetiver_model(
  fit_v1, "wildlife_counts",
  metadata = list(
    pred_formula  = "~ exp(Intercept + habitat_open + effort)",
    n_samples     = 500L,
    model_year    = 1L,
    training_rows = nrow(train_y1),
    dic           = fit_v1$dic$dic,
    waic          = fit_v1$waic$waic,
    mean_crps     = mean(scores_v1$crps),
    mean_logs     = mean(scores_v1$logs)
  )
)

vetiver_pin_write(board, v1)

pin_versions(board, "wildlife_counts")


## -----------------------------------------------------------------------------
set.seed(99)
year2 <- year1
log_mu2       <- 0.9 + 0.5 * year2$habitat_open + log(year2$effort)
year2$counts  <- rpois(n_stations, exp(log_mu2))

train_y2 <- year2[-val_idx, ]
val_y2   <- year2[ val_idx, ]


## -----------------------------------------------------------------------------
fit_v2 <- bru(
  counts ~ Intercept(1) + habitat_open + effort,
  family  = "poisson",
  data    = train_y2,
  options = bru_options(
    control.compute = list(config = TRUE, dic = TRUE, waic = TRUE)
  )
)

scores_v2 <- bru_score(
  fit_v2,
  newdata      = val_y2,
  pred_formula = ~ rpois(
    length(habitat_open),
    exp(Intercept + habitat_open + effort)
  ),
  y_col        = "counts",
  n_samples    = 1000L
)

v2 <- vetiver_model(
  fit_v2, "wildlife_counts",
  metadata = list(
    pred_formula  = "~ exp(Intercept + habitat_open + effort)",
    n_samples     = 500L,
    model_year    = 2L,
    training_rows = nrow(train_y2),
    dic           = fit_v2$dic$dic,
    waic          = fit_v2$waic$waic,
    mean_crps     = mean(scores_v2$crps),
    mean_logs     = mean(scores_v2$logs)
  )
)

vetiver_pin_write(board, v2)

pin_versions(board, "wildlife_counts")


## -----------------------------------------------------------------------------
# Newest first. pin_versions() does not promise an order, so sort.
versions <- pin_versions(board, "wildlife_counts") |> arrange(desc(created))

quality <- map_dfr(versions$version, function(ver) {
  meta <- pin_meta(board, "wildlife_counts", version = ver)
  tibble(
    version       = ver,
    created       = meta$created,
    training_rows = meta$user$training_rows,
    waic          = meta$user$waic,
    dic           = meta$user$dic,
    mean_crps     = meta$user$mean_crps,
    mean_logs     = meta$user$mean_logs
  )
})

quality


## -----------------------------------------------------------------------------
y_formula <- ~ rpois(
  length(habitat_open),
  exp(Intercept + habitat_open + effort)
)
scores_v1_now <- bru_score(
  fit_v1,
  newdata      = val_y2,
  pred_formula = y_formula,
  y_col        = "counts",
  n_samples    = 1000L
)

# Match scores to versions through the model_year stored in each pin, not
# through row order: timestamps can tie, and the board may hold more versions.
crps_now <- c(`1` = mean(scores_v1_now$crps), `2` = mean(scores_v2$crps))
head_to_head <- tibble(
  version    = versions$version,
  model_year = map_int(version, function(ver) {
    pin_meta(board, "wildlife_counts", version = ver)$user$model_year
  }),
  mean_crps  = unname(crps_now[as.character(model_year)])
)
head_to_head


## -----------------------------------------------------------------------------
prod_board <- board_temp(versioned = TRUE)

# Load the winning version from the staging board. vetiver_pin_read()
# returns a fully-formed vetiver_model (description + prototype + metadata
# intact), so we can re-pin it directly to production. Wrapping it again
# in vetiver_model() would error — there is no method to create a
# description from a vetiver_model object.
best_version <- head_to_head$version[which.min(head_to_head$mean_crps)]
v_winning <- vetiver_pin_read(board, "wildlife_counts",
                               version = best_version)

vetiver_pin_write(prod_board, v_winning)


## -----------------------------------------------------------------------------
# Re-read versions in case the board state has changed since section 3,
# newest first.
versions_now <- pin_versions(board, "wildlife_counts") |>
  arrange(desc(created))
stopifnot(
  "Need at least 2 pinned versions to demonstrate rollback" =
    nrow(versions_now) >= 2L
)

# Roll back to the newest version other than the one in production.
previous_version <- setdiff(versions_now$version, best_version)[1]

v_rollback <- vetiver_pin_read(board, "wildlife_counts",
                                version = previous_version)
vetiver_pin_write(prod_board, v_rollback)

message("Rolled back to version: ", previous_version)


## -----------------------------------------------------------------------------
library(ggplot2)

quality |>
  mutate(created = as.POSIXct(created)) |>
  ggplot(aes(x = created)) +
  geom_line(aes(y = mean_crps, colour = "CRPS")) +
  geom_point(aes(y = mean_crps, colour = "CRPS"), size = 2) +
  geom_line(aes(y = waic / 1000, colour = "WAIC / 1000"), linetype = "dashed") +
  labs(
    x      = "Version date",
    y      = "Score (lower is better)",
    colour = NULL,
    title  = "Model quality across versions"
  ) +
  theme_minimal()


## -----------------------------------------------------------------------------
library(plumber)

# vetiver_pin_read() returns the full vetiver model, including the
# prototype and the pred_formula in its metadata.
v_prod <- vetiver_pin_read(prod_board, "wildlife_counts")

pr() |>
  vetiver_api(v_prod) |>
  pr_run(port = 8088)


## -----------------------------------------------------------------------------
library(httr2)

new_stations <- data.frame(
  habitat_open = c(0L, 1L),
  effort       = c(1.0, 1.5)
)

resp <- request("http://127.0.0.1:8088/predict") |>
  req_body_raw(
    jsonlite::toJSON(new_stations, dataframe = "rows"),
    type = "application/json"
  ) |>
  req_perform()

tibble::as_tibble(resp_body_json(resp, simplifyVector = TRUE))


## -----------------------------------------------------------------------------
Sys.setenv(
  CONNECT_SERVER = "https://connect.example.com/",
  CONNECT_API_KEY = "..."   # set in your deploy environment, never commit
)

prod_board <- board_connect()
vetiver_pin_write(prod_board, v_winning)


## -----------------------------------------------------------------------------
prod_board <- board_s3(
  bucket = "my-org-models",
  prefix = "wildlife_counts/"
)

vetiver_pin_write(prod_board, v_winning)


## -----------------------------------------------------------------------------
# At the top of plumber.R
library(inlaops)  # provides the methods that serve bru fits

prod_board <- if (Sys.getenv("CONNECT_API_KEY") != "") {
  pins::board_connect()
} else if (Sys.getenv("AWS_ACCESS_KEY_ID") != "") {
  pins::board_s3(bucket = Sys.getenv("MODEL_BUCKET"),
                 prefix = Sys.getenv("MODEL_PREFIX"))
} else {
  pins::board_folder(Sys.getenv("MODEL_DIR", "./model-store"))
}

v_prod <- vetiver::vetiver_pin_read(prod_board, "wildlife_counts")