inst/doc/getting-started.R

In smoothbp: Hierarchical Piecewise Regression with Smoothed Change-Points

## ----setup, include=FALSE-----------------------------------------------------
NOT_CRAN <- identical(tolower(Sys.getenv("NOT_CRAN")), "true")
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", eval = NOT_CRAN)

## ----simulate-----------------------------------------------------------------
# library(smoothbp)
# 
# dat <- simulate_smoothbp(
#   n_subj    = 20,
#   n_obs     = 8,
#   b0        = 5.0,   # level at change-point
#   b1        = -0.3,  # pre-change slope
#   delta     =  1.2,  # slope change (delta_1)
#   omega     =  3.0,  # change-point location
#   rho       =  4.0,  # transition sharpness
#   sigma     =  0.4,  # residual SD
#   sigma_u   =  0.5,  # between-subject SD
#   tau_range = c(0, 6),
#   seed      = 42
# )
# 
# head(dat)
# true_params(dat)

## ----fit-zero-bp--------------------------------------------------------------
# fit0 <- smoothbp(
#   formula = y ~ tau,
#   b0      = ~ 1 + (1 | subject),
#   b1      = ~ 1,
#   deltas  = list(),   # no change-points
#   omega   = list(),
#   rho     = list(),
#   data    = dat,
#   chains  = 2L, iter = 1000L, warmup = 500L, seed = 42L, .verbose = FALSE
# )
# summary(fit0)

## ----fit-one-bp---------------------------------------------------------------
# fit1 <- smoothbp(
#   formula = y ~ tau,
#   b0      = ~ 1 + (1 | subject),
#   b1      = ~ 1,
#   deltas  = list(~ 1),          # one slope change
#   omega   = list(~ 1),          # one change-point location
#   rho     = list(~ 1),          # one sharpness
#   data    = dat,
#   priors  = smoothbp_priors(
#     omega = list(prior_normal(3, 2, lb = 0))
#   ),
#   chains  = 4L, iter = 2000L, warmup = 1000L, seed = 42L
# )
# summary(fit1)

## ----fit-multi-bp-------------------------------------------------------------
# # Fit a model with 3 candidate breakpoints
# fit3 <- smoothbp(
#   formula = y ~ tau,
#   b0      = ~ 1 + (1 | subject),
#   b1      = ~ 1,
#   # Each segment gets its own formula (here, just an intercept)
#   deltas  = list(~ 1, ~ 1, ~ 1),
#   omega   = list(~ 1, ~ 1, ~ 1),
#   rho     = list(~ 1, ~ 1, ~ 1),
#   data    = dat,
#   priors  = smoothbp_priors(
#     # Use the space_omega_priors helper to initialize the search
#     omega = space_omega_priors(K = 3, tau_min = 0, tau_max = 6)
#   )
# )

## ----fit-fixed----------------------------------------------------------------
# # Test for a hard kink at exactly tau = 3.0
# fit_fixed <- smoothbp_ss(
#   formula = y ~ tau,
#   omega   = list(fixed(3.0)),   # Location is known
#   rho     = list(fixed(100)),   # Sharpness is fixed (hard kink)
#   data    = dat
# )
# 
# # The PIP tells us the probability that the intervention had an effect
# pip(fit_fixed)

## ----fit-parallel-------------------------------------------------------------
# fit1 <- smoothbp(
#   formula = y ~ tau,
#   b0      = ~ 1 + (1 | subject),
#   data    = dat,
#   chains  = 4L, iter = 2000L, warmup = 1000L, seed = 42L,
#   cores   = 4L    # run all 4 chains concurrently
# )

## ----rprofile, eval=FALSE-----------------------------------------------------
# options(smoothbp.cores = parallel::detectCores())

## ----summary------------------------------------------------------------------
# print(fit1)                                        # fixed + ran_pars (default)
# print(fit1, effects = "fixed")                     # population-level only
# summary(fit1, effects = "all")                     # returns everything, including u[j]

## ----trace--------------------------------------------------------------------
# plot(fit1)        # alias for trace_plot(fit1)
# trace_plot(fit1, type = "both")   # trace + density

## ----trace-strict-------------------------------------------------------------
# trace_plot(fit1, rhat_thresh = 1.01, ess_thresh = 400)

## ----pp-check-----------------------------------------------------------------
# pp_check(fit1)

## ----priors-------------------------------------------------------------------
# smoothbp_priors(
#   b0    = prior_normal(0, 10),
#   b1    = prior_normal(0, 5),
#   omega = list(
#     prior_normal(2, 1),   # change-point 1
#     prior_normal(5, 1)    # change-point 2
#   ),
#   rho   = list(
#     prior_normal(4, 2, lb = 0),
#     prior_normal(4, 2, lb = 0)
#   ),
#   sigma = prior_invgamma(shape = 2, scale = 1)
# )

## ----ss-overview--------------------------------------------------------------
# fit_ss <- smoothbp_ss(
#   formula = y ~ tau,
#   b0      = ~ 1 + (1 | subject),
#   b1      = ~ 1,
#   deltas  = list(~ 1, ~ 1, ~ 1),   # 3 candidate breakpoints
#   omega   = list(~ 1, ~ 1, ~ 1),
#   rho     = list(~ 1, ~ 1, ~ 1),
#   data    = dat,
#   spike   = prior_spike_slab(pi = 0.1, learn_pi = TRUE),
#   chains  = 4L, iter = 2000L, warmup = 1000L, seed = 42L
# )
# 
# # Posterior inclusion probabilities per breakpoint
# pip(fit_ss)
# #> gamma_delta1_(Intercept) gamma_delta2_(Intercept) gamma_delta3_(Intercept)
# #>                    0.987                    0.063                    0.041

## ----hypothesis-directional---------------------------------------------------
# # Is the slope change at breakpoint 1 positive?
# smoothbp::hypothesis(fit1, "delta1_(Intercept) > 0")
# 
# # Complex linear hypothesis: is the final slope (b1 + delta1) negative?
# smoothbp::hypothesis(fit1, "b1_(Intercept) + delta1_(Intercept) < 0")
# 
# # Does the change-point fall before time 4?
# smoothbp::hypothesis(fit1, "omega1_(Intercept) < 4")

## ----loo----------------------------------------------------------------------
# # Compare 0-BP (linear) vs 1-BP vs 3-BP models
# loo0 <- loo(fit0)
# loo1 <- loo(fit1)
# loo3 <- loo(fit3)
# 
# loo::loo_compare(loo0, loo1, loo3)

## ----bridge-sampler-----------------------------------------------------------
# library(bridgesampling)
# bs0 <- bridge_sampler(fit0)
# bs1 <- bridge_sampler(fit1)
# bayes_factor(bs1, bs0)

## ----fitted-training----------------------------------------------------------
# # Posterior mean + 95% CI at training observations
# fitted(fit1)
# 
# # Full posterior draws matrix (n_draws × n_obs)
# draws_mat <- fitted(fit1, summary = FALSE)

## ----draws-manip--------------------------------------------------------------
# library(posterior)
# 
# # Convert to a data frame for use with ggplot2
# draws_df <- as_draws_df(fit1$draws)
# 
# # Extract a specific parameter
# b1_draws <- draws_df$`b1_(Intercept)`
# 
# # Compute custom summaries
# summarise_draws(fit1$draws, "mean", "sd", ~quantile(.x, c(0.1, 0.9)))

## ----fitted-marginal----------------------------------------------------------
# # Population-level predictions at new time points
# newdata_marginal <- data.frame(tau = seq(0, 6, by = 0.1))
# fitted(fit1, newdata = newdata_marginal)

## ----fitted-conditional-------------------------------------------------------
# # Subject-specific predictions
# fitted(fit1, newdata = data.frame(tau = seq(0, 6, by = 0.1), subject = "1"))

## ----capture-example, eval=FALSE----------------------------------------------
# methods_txt <- model_methods(fit1)
# results_txt <- model_results(fit1)

## ----model-methods------------------------------------------------------------
# model_methods(fit1)

## ----model-results------------------------------------------------------------
# model_results(fit1)