inst/doc/v01-getting-started.R

In stLMM: Bayesian Spatial and Space-Time Linear Mixed Models

## ----setup--------------------------------------------------------------------
#| code-fold: true
#| code-summary: "Show preliminaries"
library(stLMM)
library(ggplot2)

source(file.path(dirname(knitr::current_input(dir = TRUE)), "utils.R"))

set.seed(1)


## ----plot-theme, include=FALSE------------------------------------------------
theme_set(theme_bw(base_size = 12))


## ----fixed-data---------------------------------------------------------------
n <- 50
dat <- data.frame(x = seq(-1, 1, length.out = n))

beta <- c(0.5, -0.5)
tau_sq <- 0.2^2

mu <- beta[1] + beta[2] * dat$x
epsilon <- rnorm(n, sd = sqrt(tau_sq))
dat$y <- mu + epsilon


## ----fixed-data-plot, fig.width=6, fig.height=4-------------------------------
#| code-fold: true
#| code-summary: "Show plotting code"
ggplot(dat, aes(x, y)) +
  geom_point(
    color = stlmm_color("primary"),
    size = 2
  ) +
  labs(x = "x", y = "response")


## ----fixed-fit----------------------------------------------------------------
fit <- stLMM(
  y ~ x,
  data = dat,
  priors = list(resid = list(tau_sq = half_t(df = 3, scale = 0.5))),
  n_samples = 250,
  verbose = FALSE
)

summary(fit)


## ----fixed-fitted-------------------------------------------------------------
mu_hat <- fitted(fit)

head(mu_hat)


## ----fixed-fitted-plot, fig.width=6, fig.height=4-----------------------------
#| code-fold: true
#| code-summary: "Show plotting code"
plot_dat <- data.frame(
  x = dat$x,
  y = dat$y,
  fitted = as.numeric(mu_hat)
)

ggplot(plot_dat, aes(x, y)) +
  geom_point(
    color = stlmm_color("primary"),
    size = 2
  ) +
  geom_line(
    aes(y = fitted),
    color = stlmm_color("secondary"),
    linewidth = 0.8
  ) +
  labs(x = "x", y = "response")


## ----fixed-predict------------------------------------------------------------
new_dat <- data.frame(x = c(-0.75, 0, 0.75))

pred <- predict(fit, newdata = new_dat, y_samples = TRUE)

summary(pred)


## ----grouped-data-------------------------------------------------------------
n_group <- 5
n_per_group <- 10
group_dat <- data.frame(
  group = factor(rep(letters[1:n_group], each = n_per_group)),
  x = rep(seq(-1, 1, length.out = n_per_group), n_group)
)

sigma_sq_alpha <- 0.5^2
alpha_true <- rnorm(n_group, sd = sqrt(sigma_sq_alpha))
names(alpha_true) <- levels(group_dat$group)

beta <- c(0.5, -0.5)
mu <- beta[1] + beta[2] * group_dat$x +
  alpha_true[as.character(group_dat$group)]

tau_sq <- 0.25^2
epsilon <- rnorm(nrow(group_dat), sd = sqrt(tau_sq))
group_dat$y <- mu + epsilon


## ----grouped-fit--------------------------------------------------------------
group_fit <- stLMM(
  y ~ x + iid(group),
  data = group_dat,
  priors = list(
    resid = list(tau_sq = half_t(df = 3, scale = 0.5)),
    iid_1 = list(sigma_sq = ig(shape = 3, scale = 0.25))
  ),
  n_samples = 250,
  verbose = FALSE
)

summary(group_fit)


## ----grouped-predict----------------------------------------------------------
group_new <- data.frame(
  group = factor(c("a", "c", "e"), levels = levels(group_dat$group)),
  x = c(-0.5, 0, 0.5)
)

group_pred <- predict(group_fit, newdata = group_new)

summary(group_pred)