## ----vignette-nowrap-options, include = FALSE, eval = [encoded data, 9944 characters]
options(width = 10000)

## ----setup, include = [encoded data, 9976 characters]
knitr::opts_chunk$set(
  collapse = TRUE,
  comment  = "#>",
  message  = FALSE,
  warning  = FALSE
)

tick    <- '<span class="yes">&#10003;</span>'
limited <- '<span class="limited">limited</span>'
no      <- '<span class="no">No</span>'
na_cell <- '<span class="na-cell">n/a</span>'

model_columns <- c(
  "brma.norm", "brma.glmm", "bselmodel", "bPET/bPEESE",
  "BMA.norm", "BMA.glmm", "RoBMA"
)

reference_links <- c(
  "add_loo()"                            = "../reference/add_loo.brma.html",
  "add_marglik()"                        = "../reference/add_marglik.brma.html",
  "add_waic()"                           = "../reference/add_waic.brma.html",
  "as_draws()"                           = "../reference/as_draws.brma.html",
  "as_draws_array()"                     = "../reference/as_draws.brma.html",
  "as_draws_df()"                        = "../reference/as_draws.brma.html",
  "as_draws_list()"                      = "../reference/as_draws.brma.html",
  "as_draws_matrix()"                    = "../reference/as_draws.brma.html",
  "as_draws_rvars()"                     = "../reference/as_draws.brma.html",
  "as_zplot()"                           = "../reference/as_zplot.brma.html",
  "bayes_factor()"                       = "../reference/bf.brma.html",
  "bf()"                                 = "../reference/bf.brma.html",
  "blup()"                               = "../reference/blup.brma.html",
  "bPET()"                               = "../reference/bPET.html",
  "bPEESE()"                             = "../reference/bPEESE.html",
  "brma()"                               = "../reference/brma.html",
  "brma.glmm()"                          = "../reference/brma.glmm.html",
  "BMA()"                                = "../reference/BMA.html",
  "BMA.glmm()"                           = "../reference/BMA.glmm.html",
  "bridge_sampler()"                     = "../reference/bridge_sampler.brma.html",
  "bselmodel()"                          = "../reference/bselmodel.html",
  "check_loo()"                          = "../reference/check_loo.brma.html",
  "coef()"                               = "../reference/coef.brma.html",
  "contr.meandif()"                      = "../reference/contr.BayesTools.html",
  "contr.orthonormal()"                  = "../reference/contr.BayesTools.html",
  "contr.treatment()"                    = "https://stat.ethz.ch/R-manual/R-devel/library/stats/html/contrast.html",
  "cooks.distance()"                     = "../reference/cooks.distance.brma.html",
  "covratio()"                           = "../reference/covratio.brma.html",
  "dfbetas()"                            = "../reference/dfbetas.brma.html",
  "dffits()"                             = "../reference/dffits.brma.html",
  "estimate_unit_information_sd()"       = "../reference/estimate_unit_information_sd.html",
  "fitted()"                             = "../reference/fitted.brma.html",
  "funnel()"                             = "../reference/funnel.html",
  "galbraith()"                          = "../reference/radial.html",
  "hatvalues()"                          = "../reference/hatvalues.brma.html",
  "influence()"                          = "../reference/influence.brma.html",
  "interpret()"                          = "../reference/interpret.html",
  "logLik()"                             = "../reference/logLik.brma.html",
  "logml()"                              = "../reference/logml.brma.html",
  "loo()"                                = "../reference/loo.brma.html",
  "loo::pareto_k_ids()"                  = "https://mc-stan.org/loo/reference/pareto-k-diagnostic.html",
  "loo::pareto_k_table()"                = "https://mc-stan.org/loo/reference/pareto-k-diagnostic.html",
  "loo_compare()"                        = "../reference/loo_compare.brma.html",
  "loo_weights()"                        = "../reference/loo_weights.brma.html",
  "marginal_means()"                     = "../reference/marginal_means.brma.html",
  "nobs()"                               = "../reference/nobs.brma.html",
  "plot()"                               = "../reference/plot.brma.html",
  "plot_diagnostic()"                    = "../reference/plot_diagnostic.html",
  "plot_diagnostic_autocorrelation()"    = "../reference/plot_diagnostic.html",
  "plot_diagnostic_density()"            = "../reference/plot_diagnostic.html",
  "plot_diagnostic_trace()"              = "../reference/plot_diagnostic.html",
  "plot_pet_peese()"                     = "../reference/plot_pet_peese.html",
  "plot_prior()"                         = "../reference/plot_prior.html",
  "plot_weightfunction()"                = "../reference/plot_weightfunction.html",
  "pooled_effect()"                      = "../reference/pooled_effect.brma.html",
  "pooled_heterogeneity()"               = "../reference/pooled_heterogeneity.brma.html",
  "post_prob()"                          = "../reference/post_prob.brma.html",
  "predict()"                            = "../reference/predict.brma.html",
  "print_prior()"                        = "../reference/print_prior.html",
  "prior()"                              = "../reference/prior.html",
  "prior_factor()"                       = "../reference/prior_factor.html",
  "prior_informed()"                     = "../reference/prior_informed.html",
  "prior_none()"                         = "../reference/prior_none.html",
  "prior_PEESE()"                        = "../reference/prior_PEESE.html",
  "prior_PET()"                          = "../reference/prior_PET.html",
  "prior_weightfunction()"               = "../reference/prior_weightfunction.html",
  "qqnorm()"                             = "../reference/qqnorm.brma.html",
  "radial()"                             = "../reference/radial.html",
  "ranef()"                              = "../reference/ranef.brma.html",
  "regplot()"                            = "../reference/regplot.html",
  "residuals()"                          = "../reference/residuals.brma.html",
  "RoBMA()"                              = "../reference/RoBMA.html",
  "rstandard()"                          = "../reference/rstandard.brma.html",
  "rstudent()"                           = "../reference/rstudent.brma.html",
  "simulate()"                           = "https://stat.ethz.ch/R-manual/R-devel/library/stats/html/simulate.html",
  "summary()"                            = "../reference/summary.brma.html",
  "summary_heterogeneity()"              = "../reference/summary_heterogeneity.brma.html",
  "summary_models()"                     = "../reference/summary_models.html",
  "true_effects()"                       = "../reference/true_effects.brma.html",
  "update()"                             = "../reference/update.brma.html",
  "vcov()"                               = "https://stat.ethz.ch/R-manual/R-devel/library/stats/html/vcov.html",
  "vif()"                                = "../reference/vif.brma.html",
  "waic()"                               = "../reference/waic.brma.html",
  "weights()"                            = "https://stat.ethz.ch/R-manual/R-devel/library/stats/html/weights.html",
  "wf_cumulative()"                      = "../reference/prior_weightfunction.html",
  "wf_fixed()"                           = "../reference/prior_weightfunction.html",
  "wf_independent()"                     = "../reference/prior_weightfunction.html",
  "forest()"                             = "https://wviechtb.github.io/metafor/reference/forest.rma.html",
  "baujat()"                             = "https://wviechtb.github.io/metafor/reference/baujat.html",
  "gosh()"                               = "https://wviechtb.github.io/metafor/reference/gosh.html",
  "labbe()"                              = "https://wviechtb.github.io/metafor/reference/labbe.html"
)

model_column_links <- list(
  "brma.norm"   = "../reference/brma.html",
  "brma.glmm"   = "../reference/brma.glmm.html",
  "bselmodel"   = "../reference/bselmodel.html",
  "bPET/bPEESE" = c("../reference/bPET.html", "../reference/bPEESE.html"),
  "BMA.norm"    = "../reference/BMA.html",
  "BMA.glmm"    = "../reference/BMA.glmm.html",
  "RoBMA"       = "../reference/RoBMA.html"
)

status_map <- c(
  Y = tick,
  L = limited,
  N = no,
  A = na_cell
)

feature_row <- function(topic, feature, pattern) {

  values <- strsplit(pattern, "", fixed = TRUE)[[1]]
  if (length(values) != length(model_columns)) {
    stop("Status pattern has wrong length: ", pattern, call. = FALSE)
  }

  out <- c(
    list(Topic = topic, Feature = feature),
    stats::setNames(as.list(status_map[values]), model_columns)
  )

  return(out)
}

feature_table <- function(rows) {

  rows <- as.data.frame(do.call(rbind, rows), stringsAsFactors = FALSE, check.names = FALSE)
  rows[] <- lapply(rows, function(x) {

    if (is.list(x)) {
      return(vapply(x, function(y) paste0(as.character(y), collapse = ""), character(1)))
    }
    return(as.character(x))
  })

  cat('
<style>
.feature-matrix {
  border-collapse: collapse;
  width: 100%;
  font-size: 0.84em;
}
.feature-matrix th,
.feature-matrix td {
  border: 1px solid #d0d7de;
  padding: 4px 6px;
  vertical-align: top;
}
.feature-matrix th {
  background: #f6f8fa;
}
.feature-matrix .topic-head {
  min-width: 60px;
  width: 60px;
}
.feature-matrix .feature-head {
  min-width: 25em;
}
.feature-matrix .model-head {
  height: 118px;
  min-width: 34px;
  max-width: 34px;
  width: 34px;
  padding: 0;
  position: relative;
  vertical-align: bottom;
}
.feature-matrix .rotated-header {
  bottom: 6px;
  display: block;
  left: 50%;
  line-height: 1;
  position: absolute;
  transform: rotate(-90deg);
  transform-origin: left center;
  white-space: nowrap;
}
.feature-matrix .topic-cell {
  background: #f6f8fa;
  min-width: 60px;
  width: 60px;
  padding: 0;
  text-align: center;
  vertical-align: middle;
}
.feature-matrix .topic-cell span {
  display: inline-block;
  transform: rotate(-90deg);
  white-space: normal;
  width: 8em;
  text-align: center;
  font-weight: 700;
  line-height: 1.1;
}
.feature-matrix .feature-cell {
  min-width: 25em;
}
.feature-matrix .feature-cell a {
  color: #0969da;
  text-decoration: none;
}
.feature-matrix .feature-cell a:hover {
  text-decoration: underline;
}
.feature-matrix .feature-cell a code {
  color: inherit;
}
.feature-matrix .status-cell {
  text-align: center;
  vertical-align: middle;
  white-space: nowrap;
  width: 34px;
}
.feature-matrix .yes {
  color: #1a7f37;
  font-weight: 700;
}
.feature-matrix .limited {
  color: #9a6700;
}
.feature-matrix .no,
.feature-matrix .na-cell {
  color: #6e7781;
}
</style>
')

  escape_html_text <- function(x) {

    x <- as.character(x)
    x <- gsub("&", "&amp;", x, fixed = TRUE)
    x <- gsub("<", "&lt;", x, fixed = TRUE)
    x <- gsub(">", "&gt;", x, fixed = TRUE)
    x <- gsub('"', "&quot;", x, fixed = TRUE)
    return(x)
  }

  format_code_span <- function(code) {

    code_html <- paste0("<code>", escape_html_text(code), "</code>")
    link      <- if (code %in% names(reference_links)) reference_links[[code]] else NA_character_

    if (!is.na(link)) {
      return(paste0('<a href="', escape_html_text(link), '">', code_html, "</a>"))
    }

    return(code_html)
  }

  escape_html <- function(x) {

    x       <- as.character(x)
    matches <- gregexpr("`[^`]+`", x, perl = TRUE)[[1]]

    if (matches[1] == -1L) {
      return(escape_html_text(x))
    }

    match_lengths <- attr(matches, "match.length")
    pieces        <- character(0)
    position      <- 1L

    for (j in seq_along(matches)) {
      match_start <- matches[j]
      match_end   <- match_start + match_lengths[j] - 1L

      if (match_start > position) {
        pieces <- c(pieces, escape_html_text(substr(x, position, match_start - 1L)))
      }

      code <- substr(x, match_start + 1L, match_end - 1L)
      pieces <- c(pieces, format_code_span(code))
      position <- match_end + 1L
    }

    if (position <= nchar(x)) {
      pieces <- c(pieces, escape_html_text(substr(x, position, nchar(x))))
    }

    return(paste0(pieces, collapse = ""))
  }

  format_model_column <- function(model_column) {

    link <- model_column_links[[model_column]]

    if (length(link) == 2L) {
      return(paste0(
        '<a href="', escape_html_text(link[[1]]), '">bPET</a>/',
        '<a href="', escape_html_text(link[[2]]), '">bPEESE</a>'
      ))
    }

    return(paste0(
      '<a href="', escape_html_text(link), '">',
      escape_html_text(model_column),
      "</a>"
    ))
  }

  topic_runs <- rle(rows$Topic)
  topic_start <- cumsum(c(1L, head(topic_runs$lengths, -1L)))
  topic_span <- rep(0L, nrow(rows))
  topic_span[topic_start] <- topic_runs$lengths

  cat('<div style="overflow-x: auto;">\n')
  cat('<table class="feature-matrix">\n')
  cat("<thead><tr>")
  cat('<th class="topic-head">Topic</th>')
  cat('<th class="feature-head">Feature</th>')
  for (model_column in model_columns) {
    cat('<th class="model-head"><span class="rotated-header">', format_model_column(model_column), "</span></th>", sep = "")
  }
  cat("</tr></thead>\n")
  cat("<tbody>\n")
  for (i in seq_len(nrow(rows))) {
    cat("<tr>")
    if (topic_span[i] > 0L) {
      cat(
        '<td class="topic-cell" rowspan="', topic_span[i], '"><span>',
        escape_html(rows$Topic[i]),
        "</span></td>",
        sep = ""
      )
    }
    cat('<td class="feature-cell">', escape_html(rows$Feature[i]), "</td>", sep = "")
    for (model_column in model_columns) {
      cat('<td class="status-cell">', rows[[model_column]][i], "</td>", sep = "")
    }
    cat("</tr>\n")
  }
  cat("</tbody>\n")
  cat("</table>\n")
  cat("</div>\n")
}

## ----feature-matrix, echo = FALSE, results = "asis"[encoded data, 9947 characters]
rows <- list(
  feature_row("Model / Structure", "Fixed- and random-effects models", "YYYYYYY"),
  feature_row("Model / Structure", "Moderation (`mods`)", "YYYYYYY"),
  feature_row("Model / Structure", "Location-scale models (`scale`)", "YYYYYYY"),
  feature_row("Model / Structure", "Multilevel models (`cluster`)", "YYYYYYY"),
  feature_row("Model / Structure", "Model averaging", "NNNNYYY"),
  feature_row("Model / Structure", "Inclusion Bayes factors", "NNNNYYY"),
  feature_row("Model / Structure", "General multivariate / covariance structures", "NNNNNNN"),
  feature_row("Model / Structure", "Robust / sandwich inference", "NNNNNNN"),
  feature_row("Model / Structure", "Refit / update (`update()`)", "YYYYYYY"),

  feature_row("Priors", "Default prior distributions", "YYYYYYY"),
  feature_row("Priors", "Empirical/informed prior distributions (`prior_informed()`)", "YYYYYYY"),
  feature_row("Priors", "Custom prior distributions (`prior()`, `prior_factor()`, `prior_weightfunction()`, `prior_none()`)", "YYYYYYY"),
  feature_row("Priors", "PET / PEESE prior distributions (`prior_PET()`, `prior_PEESE()`)", "NNNYNNY"),
  feature_row("Priors", "Prior-only inspection (`only_priors = TRUE`)", "YYYYYYY"),
  feature_row("Priors", "Weight-function shape (`wf_cumulative()`, `wf_fixed()`, `wf_independent()`)", "NNYNNNY"),
  feature_row("Priors", "Factor contrasts (`contr.treatment()`, `contr.meandif()`, `contr.orthonormal()`)", "YYYYYYY"),
  feature_row("Priors", "UISD estimation (`estimate_unit_information_sd()`)", "YYYYYYY"),

  feature_row("Publication Bias", "Selection models", "NNYNNNY"),
  feature_row("Publication Bias", "PET / PEESE models", "NNNYNNY"),
  feature_row("Publication Bias", "Model averaging over bias models", "NNNNNNY"),
  feature_row("Publication Bias", "Bias-adjusted summaries / predictions", "NNYYNNY"),
  feature_row("Publication Bias", "Trim-fill / fail-safe N", "NNNNNNN"),

  feature_row("Prediction", "Pooled effect / heterogeneity summaries (`pooled_effect()`, `pooled_heterogeneity()`)", "YYYYYYY"),
  feature_row("Prediction", "Heterogeneity decomposition (`summary_heterogeneity()`, tau², I², H²)", "YYYYYYY"),
  feature_row("Prediction", "Fitted-value extraction (`fitted()`)", "YYYYYYY"),
  feature_row("Prediction", "Prediction for new covariate values (`predict()`)", "YYYYYYY"),
  feature_row("Prediction", "Posterior predictive response summaries (`predict()`)", "YYYYYYY"),
  feature_row("Prediction", "True effects / BLUPs / random effects (`true_effects()`, `blup()`, `ranef()`)", "YYYYYYY"),
  feature_row("Prediction", "Estimated marginal means (`marginal_means()`)", "YYYYYYY"),

  feature_row("Plots", "Posterior plots (`plot()`)", "YYYYYYY"),
  feature_row("Plots", "Prior plots (`plot_prior()`)", "YYYYYYY"),
  feature_row("Plots", "Marginal means plots (`marginal_means()` + `plot()`)", "YYYYYYY"),
  feature_row("Plots", "Regression plots (`regplot()`)", "YYYYYYY"),
  feature_row("Plots", "Funnel plots (`funnel()`)", "YYYYYYY"),
  feature_row("Plots", "zplot diagnostics (`as_zplot()`/`zplot()`)", "YYYYYYY"),
  feature_row("Plots", "Weight-function plots (`plot_weightfunction()`)", "NNYNNNY"),
  feature_row("Plots", "PET-PEESE plots (`plot_pet_peese()`)", "NNNYNNY"),
  feature_row("Plots", "Radial / Galbraith plots (`radial()`, `galbraith()`)", "YLYYYLY"),
  feature_row("Plots", "Forest plots (`forest()`)", "NNNNNNN"),
  feature_row("Plots", "Baujat plots (`baujat()`)", "NNNNNNN"),
  feature_row("Plots", "GOSH plots (`gosh()`)", "NNNNNNN"),
  feature_row("Plots", "L'Abbe plots (`labbe()`)", "NNNNNNN"),

  feature_row("Residuals / Diagnostics", "Raw residuals (`residuals()`)", "YYYYYYY"),
  feature_row("Residuals / Diagnostics", "Pearson / standardized residuals (`rstandard()`)", "YNNYYNL"),
  feature_row("Residuals / Diagnostics", "Studentized residuals (LOO-PIT) (`rstudent()`)", "YYYYYYY"),
  feature_row("Residuals / Diagnostics", "Q-Q plots (`qqnorm()`)", "YYYYYYY"),
  feature_row("Residuals / Diagnostics", "Cook's distances (`cooks.distance()`)", "YNNYYNN"),
  feature_row("Residuals / Diagnostics", "DFBETAS (`dfbetas()`)", "YYYYYYY"),
  feature_row("Residuals / Diagnostics", "DFFITS (`dffits()`)", "YNNYYNN"),
  feature_row("Residuals / Diagnostics", "Covariance ratios (`covratio()`)", "YYYYYYY"),
  feature_row("Residuals / Diagnostics", "Hat values (`hatvalues()`)", "YNNYYNN"),
  feature_row("Residuals / Diagnostics", "Combined influence summary (`influence()`)", "YLLYYLL"),
  feature_row("Residuals / Diagnostics", "LOO / WAIC diagnostics (`check_loo()`, `loo::pareto_k_ids()`, `loo::pareto_k_table()`)", "YYYYYYY"),
  feature_row("Residuals / Diagnostics", "Moderator collinearity diagnostics (`vif()`)", "YYYYYYY"),
  feature_row("Residuals / Diagnostics", "Refit leave-one-out / permutation tests", "NNNNNNN"),

  feature_row("MCMC Diagnostics", "Posterior summaries (Rhat, ESS, MCMC error) (`summary()`)", "YYYYYYY"),
  feature_row("MCMC Diagnostics", "Trace plots (`plot_diagnostic_trace()`)", "YYYYYYY"),
  feature_row("MCMC Diagnostics", "Density plots (`plot_diagnostic_density()`)", "YYYYYYY"),
  feature_row("MCMC Diagnostics", "Autocorrelation plots (`plot_diagnostic_autocorrelation()`)", "YYYYYYY"),
  feature_row("MCMC Diagnostics", "Diagnostic-plot wrapper (`plot_diagnostic()`)", "YYYYYYY"),

  feature_row("Model Comparison", "Marginal likelihood (`add_marglik()`, `logml()`)", "YYYYNNN"),
  feature_row("Model Comparison", "WAIC/LOO (`add_waic()`, `add_loo()`, `waic()`, `loo()`)", "YYYYYYY"),
  feature_row("Model Comparison", "Bayes factors (`bf()`, `bayes_factor()`, `post_prob()`)", "YYYYYYY"),
  feature_row("Model Comparison", "WAIC comparison (`loo_compare()`, `loo_weights()`)", "YYYYYYY"),
  feature_row("Model Comparison", "LOO comparison (`loo_compare()`, `loo_weights()`)", "YYYYYYY"),
  feature_row("Model Comparison", "AIC / BIC", "NNNNNNN"),

  feature_row("Reporting", "Plain-text interpretation (`interpret()`)", "YYYYYYY"),
  feature_row("Reporting", "Sub-model summary (`summary_models()`)", "NNNNYYY"),
  feature_row("Reporting", "Prior inspection (`print_prior()`)", "YYYYYYY"),

  feature_row("Extraction", "Posterior draw extraction (`as_draws()`, `as_draws_array()`, `as_draws_df()`, `as_draws_list()`, `as_draws_matrix()`, `as_draws_rvars()`)", "YYYYYYY"),
  feature_row("Extraction", "Coefficients (`coef()`)", "YYYYYYY"),
  feature_row("Extraction", "Point-wise log-likelihood (`logLik()`)", "YYYYYYY"),
  feature_row("Extraction", "Sample size (`nobs()`)", "YYYYYYY"),
  feature_row("Extraction", "Variance-covariance matrix (`vcov()`)", "NNNNNNN"),
  feature_row("Extraction", "Credible intervals (`summary()`, `summary_heterogeneity()`, `pooled_effect()`, `pooled_heterogeneity()`)", "YYYYYYY"),
  feature_row("Extraction", "Model weights (`weights()`)", "NNNNNNN"),
  feature_row("Extraction", "Simulated responses (`simulate()`)", "NNNNNNN")
)

# Intentionally skipped exported functions in this feature table:
# bridge_sampler(), contr.independent(), RoBMA.options(), RoBMA.get_option(),
# set_autofit_control(), set_convergence_checks().

feature_table(rows)

