## ----setup, include = FALSE--------------------------------------------------- library(betaregscale) knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 10, fig.height = 5, fig.align = "center", warning = FALSE, message = FALSE, digits = 4 ) set.seed(2026) kbl10 <- function(x, n = 10, digits = 4, ...) { knitr::kable(utils::head(as.data.frame(x), n), digits = digits, align = "c", ...) } ## ----library------------------------------------------------------------------ library(betaregscale) ## ----data-sim----------------------------------------------------------------- n <- 260 d <- data.frame( x1 = rnorm(n), x2 = rnorm(n), z1 = rnorm(n) ) sim <- brs_sim( formula = ~ x1 + x2 | z1, data = d, beta = c(0.15, 0.55, -0.30), zeta = c(-0.10, 0.35), link = "logit", link_phi = "logit", ncuts = 100, repar = 2 ) kbl10(head(sim, 10)) kbl10( data.frame( n = nrow(sim), exact = sum(sim$delta == 0), left = sum(sim$delta == 1), right = sum(sim$delta == 2), interval = sum(sim$delta == 3) ), digits = 4 ) ## ----fit-candidates----------------------------------------------------------- fit_logit <- brs(y ~ x1 + x2 | z1, data = sim, link = "logit", repar = 2) fit_probit <- brs(y ~ x1 + x2 | z1, data = sim, link = "probit", repar = 2) fit_cauchit <- brs(y ~ x1 + x2 | z1, data = sim, link = "cauchit", repar = 2) tab_rank <- brs_table( logit = fit_logit, probit = fit_probit, cauchit = fit_cauchit ) kbl10(tab_rank) ## ----inference-stack---------------------------------------------------------- kbl10(brs_est(fit_logit)) kbl10(confint(fit_logit)) boot_tab <- brs_bootstrap(fit_logit, R = 80, level = 0.95) kbl10(head(boot_tab, 10)) set.seed(2026) # For marginal effects simulation ame_mu <- brs_marginaleffects( fit_logit, model = "mean", type = "response", interval = TRUE, n_sim = 120 ) kbl10(ame_mu) ## ----inference-visual--------------------------------------------------------- if (requireNamespace("ggplot2", quietly = TRUE)) { boot_tab_bca <- brs_bootstrap( fit_logit, R = 120, level = 0.95, ci_type = "bca", keep_draws = TRUE ) autoplot.brs_bootstrap( boot_tab_bca, type = "ci_forest", title = "Bootstrap (BCa) vs Wald intervals" ) set.seed(2026) # For marginal effects simulation ame_mu_draws <- brs_marginaleffects( fit_logit, model = "mean", type = "response", interval = TRUE, n_sim = 160, keep_draws = TRUE, ) autoplot.brs_marginaleffects(ame_mu_draws, type = "forest") } ## ----prediction-layer--------------------------------------------------------- score_prob <- brs_predict_scoreprob(fit_logit, scores = 0:10) kbl10(score_prob[1:8, 1:7]) ## ----cv-layer----------------------------------------------------------------- set.seed(2026) # For cross-validation reproducibility cv_tab <- brs_cv( y ~ x1 + x2 | z1, data = sim, k = 5, repeats = 5, repar = 2 ) kbl10(head(cv_tab, 10)) ## ----mixed-data--------------------------------------------------------------- g <- 10 ni <- 120 id <- factor(rep(seq_len(g), each = ni)) n_mm <- length(id) x1 <- rnorm(n_mm) x2 <- rbinom(n_mm, size = 1, prob = 1 / 2) b0 <- rnorm(g, sd = 0.40) b1 <- rnorm(g, sd = 0.22) eta_mu <- 0.20 + 0.65 * x1 - 0.30 * x2 + b0[id] + b1[id] * x1 eta_phi <- rep(-0.20, n_mm) mu <- plogis(eta_mu) phi <- plogis(eta_phi) shp <- brs_repar(mu = mu, phi = phi, repar = 2) y <- round(stats::rbeta(n_mm, shp$shape1, shp$shape2) * 100) dmm <- data.frame(y = y, id = id, x1 = x1, x2 = x2) kbl10(head(dmm, 10)) ## ----mixed-fit---------------------------------------------------------------- fit_brs <- brs(y ~ x1 + x2, data = dmm, repar = 2) fit_ri <- brsmm(y ~ x1 + x2, random = ~ 1 | id, data = dmm, repar = 2) fit_rs <- brsmm(y ~ x1 + x2, random = ~ 1 + x1 | id, data = dmm, repar = 2) tab_lr <- anova(fit_brs, fit_ri, fit_rs, test = "Chisq") kbl10(data.frame(model = rownames(tab_lr), tab_lr, row.names = NULL)) ## ----llr-decision------------------------------------------------------------- tab_lr_df <- data.frame(model = rownames(tab_lr), tab_lr, row.names = NULL) tab_lr_df$decision <- c( "baseline", ifelse(is.na(tab_lr_df$`Pr(>Chisq)`[2]), "inspect AIC/BIC + diagnostics", ifelse(tab_lr_df$`Pr(>Chisq)`[2] < 0.05, "prefer M1 over M0", "prefer M0 (parsimony)") ), ifelse(is.na(tab_lr_df$`Pr(>Chisq)`[3]), "inspect AIC/BIC + diagnostics", ifelse(tab_lr_df$`Pr(>Chisq)`[3] < 0.05, "prefer M2 over M1", "prefer M1 (parsimony)") ) ) kbl10(tab_lr_df) ## ----ranef-study-------------------------------------------------------------- rs <- brsmm_re_study(fit_rs) print(rs) kbl10(rs$summary) kbl10(rs$D) kbl10(rs$Corr) ## ----ranef-plots-------------------------------------------------------------- if (requireNamespace("ggplot2", quietly = TRUE)) { autoplot.brsmm(fit_rs, type = "ranef_caterpillar") autoplot.brsmm(fit_rs, type = "ranef_density") autoplot.brsmm(fit_rs, type = "ranef_pairs") autoplot.brsmm(fit_rs, type = "ranef_qq") }