collapsePanel <- function(..., header = "", show_on_start = FALSE, id = "") {
collapse_id <- paste0("collapse", sample(1:100000000, 1))
div(
class = "panel panel-default",
div(
class = paste0("panel-heading", ifelse(show_on_start, "", " collapsed")),
`data-target` = paste0("#", collapse_id),
`data-toggle` = "collapse",
span(icon("caret-down"), header)
),
div(
id = collapse_id,
class = paste0("panel-collapse collapse", ifelse(show_on_start, " in", "")),
div(
...
)
),
id = id
)
}
dropNulls <- function(x) {
x[!vapply(x, is.null, FUN.VALUE = logical(1))]
}
balancingSliders <- function(
inputId,
label,
labels,
ids,
values,
min = 0,
max = 1,
sum = 1,
step = 0.01,
tooltips = TRUE,
ticks = FALSE
) {
sliderTags <- pmap(lst(label = labels, id = ids, value = values), function(label, id, value) {
sliderProps <- dropNulls(list(
id = id,
class = "js-range-slider",
`data-type` = "single",
`data-from` = value,
`data-min` = min,
`data-max` = max,
`data-step` = step,
`data-grid` = ticks
))
sliderTag <- div(
class = "form-group shiny-input-container",
style = paste0("width: 100%;"),
`data-sum` = 1,
tags$button(id = id, class = "lock btn btn-xs", icon("lock")),
tags$label(shiny::HTML(label)),
do.call(tags$input, sliderProps)
)
})
tags$div(
class = "form-group shiny-input-container balancing-sliders",
id = inputId,
singleton(tags$head(includeScript(system.file("js/balancing-sliders.js", package = "dynguidelines")))),
singleton(tags$head(includeCSS(system.file("css/balancing-sliders.css", package = "dynguidelines")))),
tags$label(
class = "control-label",
`for` = inputId,
label
),
sliderTags
)
}
indeterminateCheckbox <- function(
inputId,
label,
value,
...
) {
tags$span(
singleton(tags$head(includeScript(system.file("js/indeterminate-checkbox.js", package = "dynguidelines")))),
singleton(tags$head(includeCSS(system.file("css/indeterminate-checkbox.css", package = "dynguidelines")))),
class = "indeterminate-checkbox",
id = inputId,
tags$label(
tags$input(
type = "checkbox",
value = "",
`data-initial` = value
),
label
)
)
}
updateIndeterminateCheckboxInput <- function(session, inputId, value) {
message <- list(value=value)
session$sendInputMessage(inputId, message)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.