Nothing
source_ui <- function(...) {
source(
file.path("ui_files", ...),
local = TRUE
)$value
}
save_and_close_button <- function() {
tags$button(
id = 'save_and_close_button',
type = "button",
class = "btn action-button",
onclick = "window.close();",
"Save & Close"
)
}
shinystan_version <- function() {
# prevents error when deployed to shinyapps.io
ver <- try(utils::packageVersion("shinystan"))
if (inherits(ver, "try-error"))
return()
else
strong(paste("Version", ver))
}
logo_and_name <- function() {
div(div(
img(
src = "wide_ensemble.png",
class = "wide-ensemble",
width = "100%"
)
),
div(
style = "margin-top: 25px",
img(src = "stan_logo.png", class = "stan-logo"),
div(id = "shinystan-title", "ShinyStan")
))
}
# save and close reminder -------------------------------------------------
save_and_close_reminder <- function(id) {
helpText(
id = id,
p(
"To make sure the changes aren't lost, use the",
span(class = "save-close-reminder", "Save & Close"),
"button in the top left corner to exit the app before",
"closing the browser window."
)
)
}
# show/hide options/glossary ---------------------------------------------
a_options <- function(name) {
lab <- if (name == "table")
"Table Options" else "Show/Hide Options"
div(class = "aoptions",
checkboxInput(
inputId = paste0(name, "_options_show"),
label = strong(style = "margin-top: 20px; color: #222222;", lab),
value = FALSE
))
}
a_glossary <- function(id) {
div(class = "aoptions",
actionLink(
inputId = id,
label = strong(style = "margin-top: 20px; color: #222222;", "Glossary"),
icon = icon("book", lib = "glyphicon")
))
}
# plotOutput generators ---------------------------------------------------
dygraphOutput_175px <- function(id)
dygraphs::dygraphOutput(id, height = "175px")
plotOutput_200px <- function(id, ...)
plotOutput(id, height = "200px")
plotOutput_400px <- function(id, ...)
plotOutput(id, height = "400px")
# conditionalPanel generator for EXPLORE/density -------------------------
condPanel_dens_together <- function(...) {
conditionalPanel(condition = "input.dens_chain_split == 'Together'", ...)
}
condPanel_dens_prior <- function(dist, ...) {
cond <- paste0("input.dens_prior ==","'", dist,"'")
conditionalPanel(cond, ...)
}
# conditional transparency settings ---------------------------------------
alpha_calc_pt <- function(N) {
if (N <= 100) return(1)
else if (N <= 200) return(0.75)
else if (N >= 1500) return(0.15)
else 1 - pnorm(N/1500)
}
alpha_calc_lines <- function(N) {
if (N < 50) return(0.5)
if (N < 500) return(0.4)
if (N < 1000) return(0.3)
if (N < 5000) return(0.2)
else return(0.1)
}
# transformations ---------------------------------------------------------
transformation_selectInput <- function(id) {
selectInput(
id,
label = NULL,
choices = transformation_choices,
selected = "identity"
)
}
transform_helpText <- function(var = "x") {
div(
if (var == "x")
helpText(style = "font-size: 13px;",
"To apply a transformation",
"select a function and click",
code("Transform"))
else if (var == "x,y")
helpText(style = "font-size: 13px;",
"To apply transformations",
"select a function for x and/or y",
"and click", code("Transform"))
else
helpText(style = "font-size: 13px;",
"To apply transformations",
"select a function for x, y, and/or z",
"and click", code("Transform"))
)
}
# diagnostics help text ---------------------------------------------------
hT11 <- function(...)
helpText(style = "font-size: 11px;", ...)
help_interval <- hT11("Highlighted interval shows \\(\\bar{x} \\pm sd(x)\\)")
help_lines <- hT11("Lines are mean (solid) and median (dashed)")
help_max_td <- hT11("Horizontal line indicates the max_treedepth setting")
help_points <- hT11(
"Large red points indicate which (if any) iterations",
"encountered a divergent transition. Yellow indicates",
"a transition hitting the maximum treedepth."
)
help_dynamic <- hT11(
"Use your mouse to select a range in the traceplot to zoom into. ",
"The other plots on the screen will update accordingly. ",
"Double-click to reset."
)
# ppcheck plot descriptions ----------------------------------------------
plot_descriptions <-
c(
plot_hists_rep_vs_obs = "Distributions of observed data and a random sample of replications",
plot_dens_rep_vs_obs = "Density estimate of observed data (blue) and a random sample of replications",
plot_obs_vs_avg_y_rep = "Observations vs average simulated value",
plot_hist_resids = "Residuals",
plot_avg_rep_vs_avg_resid_rep = "Average simulated value vs average residual",
plot_test_statistics = "Distributions of test statistics \\(T(y^{rep})\\)"
)
# stan manual reference ---------------------------------------------------
stan_manual <- function() {
helpText(
style = "font-size: 12px;",
"Glossary entries are compiled (with minor edits) from various excerpts of the",
a(
"Stan Modeling Language User's Guide and Reference Manual",
href = "http://mc-stan.org/documentation/"
),
"(",
a(href = "http://creativecommons.org/licenses/by/3.0/", "CC BY (v3)"),
")"
)
}
# objects to use in ui.R and ui_files -------------------------------------
if (!exists(".SHINYSTAN_OBJECT")) {
.SHINYSTAN_OBJECT <- shinystan:::.sso_env[[".SHINYSTAN_OBJECT"]]
}
.model_name <- slot(.SHINYSTAN_OBJECT, "model_name")
.param_names <- slot(.SHINYSTAN_OBJECT, "param_names")
.param_list <- .make_param_list(.SHINYSTAN_OBJECT)
.param_list_with_groups <- .make_param_list_with_groups(.SHINYSTAN_OBJECT)
.nChains <- slot(.SHINYSTAN_OBJECT, "n_chain")
.nIter <- slot(.SHINYSTAN_OBJECT, "n_iter")
.nWarmup <- slot(.SHINYSTAN_OBJECT, "n_warmup")
.model_code <- slot(.SHINYSTAN_OBJECT, "model_code")
.notes <- slot(.SHINYSTAN_OBJECT, "user_model_info")
.has_rstanarm_ppcs <-
isTRUE(.SHINYSTAN_OBJECT@misc$stanreg) &&
!is.null(.SHINYSTAN_OBJECT@misc$pp_check_plots)
if (exists("object"))
rm(object)
if (exists(".SHINYSTAN_OBJECT"))
rm(.SHINYSTAN_OBJECT)
gc()
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.