Files
shiny/R/update-input.R
2013-04-10 12:30:58 -05:00

315 lines
9.2 KiB
R

#' Change the value of a text input on the client
#'
#' @template update-input
#' @param value The value to set for the input object.
#'
#' @seealso \code{\link{textInput}}
#'
#' @examples
#' \dontrun{
#' shinyServer(function(input, output, clientData, session) {
#'
#' observe({
#' # We'll use the input$controller variable multiple times, so save it as x
#' # for convenience.
#' x <- input$controller
#'
#' # This will change the value of input$inText, based on x
#' updateTextInput(session, "inText", value = paste("New text", x))
#'
#' # Can also set the label, this time for input$inText2
#' updateTextInput(session, "inText2",
#' label = paste("New label", x),
#' value = paste("New text", x))
#' })
#' })
#' }
#' @export
updateTextInput <- function(session, inputId, label = NULL, value = NULL) {
message <- dropNulls(list(label=label, value=value))
session$sendInputMessage(inputId, message)
}
#' Change the value of a checkbox input on the client
#'
#' @template update-input
#' @param value The value to set for the input object.
#'
#' @seealso \code{\link{checkboxInput}}
#'
#' @examples
#' \dontrun{
#' shinyServer(function(input, output, clientData, session) {
#'
#' observe({
#' # TRUE if input$controller is even, FALSE otherwise.
#' x_even <- input$controller %% 2 == 0
#'
#' updateCheckboxInput(session, "inCheckbox", value = x_even)
#' })
#' })
#' }
#' @export
updateCheckboxInput <- updateTextInput
#' Change the value of a slider input on the client
#'
#' @template update-input
#' @param value The value to set for the input object.
#'
#' @seealso \code{\link{sliderInput}}
#'
#' @examples
#' \dontrun{
#' shinyServer(function(input, output, clientData, session) {
#'
#' observe({
#' # We'll use the input$controller variable multiple times, so save it as x
#' # for convenience.
#' x <- input$controller
#'
#' # Similar to number and text. only label and value can be set for slider
#' updateSliderInput(session, "inSlider",
#' label = paste("Slider label", x),
#' value = x)
#'
#' # For sliders that pick out a range, pass in a vector of 2 values.
#' updateSliderInput(session, "inSlider2", value = c(x-1, x+1))
#'
#' # An NA means to not change that value (the low or high one)
#' updateSliderInput(session, "inSlider3", value = c(NA, x+2))
#' })
#' })
#' }
#' @export
updateSliderInput <- updateTextInput
#' Change the selected tab on the client
#'
#' @param session The \code{session} object passed to function given to
#' \code{shinyServer}.
#' @param inputId The id of the tabset panel object.
#' @param selected The name of the tab to make active.
#'
#' @seealso \code{\link{tabsetPanel}}
#'
#' @examples
#' \dontrun{
#' shinyServer(function(input, output, clientData, session) {
#'
#' observe({
#' # TRUE if input$controller is even, FALSE otherwise.
#' x_even <- input$controller %% 2 == 0
#'
#' # Change the selected tab.
#' # Note that the tabsetPanel must have been created with an 'id' argument
#' if (x_even) {
#' updateTabsetPanel(session, "inTabset", selected = "panel2")
#' } else {
#' updateTabsetPanel(session, "inTabset", selected = "panel1")
#' }
#' })
#' })
#' }
#' @export
updateTabsetPanel <- function(session, inputId, selected = NULL) {
message <- dropNulls(list(value = selected))
session$sendInputMessage(inputId, message)
}
#' Change the value of a number input on the client
#'
#' @template update-input
#' @param value The value to set for the input object.
#' @param min Minimum value.
#' @param max Maximum value.
#' @param step Step size.
#'
#' @seealso \code{\link{numericInput}}
#'
#' @examples
#' \dontrun{
#' shinyServer(function(input, output, clientData, session) {
#'
#' observe({
#' # We'll use the input$controller variable multiple times, so save it as x
#' # for convenience.
#' x <- input$controller
#'
#' updateNumericInput(session, "inNumber", value = x)
#'
#' updateNumericInput(session, "inNumber2",
#' label = paste("Number label ", x),
#' value = x, min = x-10, max = x+10, step = 5)
#' })
#' })
#' }
#' @export
updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
min = NULL, max = NULL, step = NULL) {
message <- dropNulls(list(label=label, value=value, min=min, max=max, step=step))
session$sendInputMessage(inputId, message)
}
#' Change the value of a checkbox group input on the client
#'
#' @template update-input
#' @param choices A named vector or named list of options. For each item, the
#' name will be used as the label, and the value will be used as the value.
#' @param selected A vector or list of options which will be selected.
#'
#' @seealso \code{\link{checkboxGroupInput}}
#'
#' @examples
#' \dontrun{
#' shinyServer(function(input, output, clientData, session) {
#'
#' observe({
#' # We'll use the input$controller variable multiple times, so save it as x
#' # for convenience.
#' x <- input$controller
#'
#' # Create a list of new options, where the name of the items is something
#' # like 'option label x 1', and the values are 'option-x-1'.
#' cb_options <- list()
#' cb_options[[sprintf("option label %d 1", x)]] <- sprintf("option-%d-1", x)
#' cb_options[[sprintf("option label %d 2", x)]] <- sprintf("option-%d-2", x)
#'
#' # Change values for input$inCheckboxGroup
#' updateCheckboxGroupInput(session, "inCheckboxGroup", choices = cb_options)
#'
#' # Can also set the label and select items
#' updateCheckboxGroupInput(session, "inCheckboxGroup2",
#' label = paste("checkboxgroup label", x),
#' choices = cb_options,
#' selected = sprintf("option label %d 2", x)
#' )
#' })
#' })
#' }
#' @export
updateCheckboxGroupInput <- function(session, inputId, label = NULL,
choices = NULL, selected = NULL) {
choices <- choicesWithNames(choices)
options <- list()
for (i in seq_along(choices)) {
choiceName <- names(choices)[i]
opt <- list(value = choices[[i]],
label = choiceName,
checked = choiceName %in% selected)
options[[i]] <- opt
}
message <- dropNulls(list(label = label, options = options))
session$sendInputMessage(inputId, message)
}
#' Change the value of a radio input on the client
#'
#' @template update-input
#' @param choices A named vector or named list of options. For each item, the
#' name will be used as the label, and the value will be used as the value.
#' @param selected A vector or list of options which will be selected.
#'
#' @seealso \code{\link{radioButtons}}
#'
#' @examples
#' \dontrun{
#' shinyServer(function(input, output, clientData, session) {
#'
#' observe({
#' # We'll use the input$controller variable multiple times, so save it as x
#' # for convenience.
#' x <- input$controller
#'
#' r_options <- list()
#' r_options[[sprintf("option label %d 1", x)]] <- sprintf("option-%d-1", x)
#' r_options[[sprintf("option label %d 2", x)]] <- sprintf("option-%d-2", x)
#'
#' # Change values for input$inRadio
#' updateRadioButtons(session, "inRadio", choices = r_options)
#'
#' # Can also set the label and select an item
#' updateRadioButtons(session, "inRadio2",
#' label = paste("Radio label", x),
#' choices = r_options,
#' selected = sprintf("option label %d 2", x)
#' )
#' })
#' })
#' }
#' @export
updateRadioButtons <- updateCheckboxGroupInput
#' Change the value of a select input on the client
#'
#' @template update-input
#' @param choices A named vector or named list of options. For each item, the
#' name will be used as the label, and the value will be used as the value.
#' @param selected A vector or list of options which will be selected.
#'
#' @seealso \code{\link{selectInput}}
#'
#' @examples
#' \dontrun{
#' shinyServer(function(input, output, clientData, session) {
#'
#' observe({
#' # We'll use the input$controller variable multiple times, so save it as x
#' # for convenience.
#' x <- input$controller
#'
#' # Create a list of new options, where the name of the items is something
#' # like 'option label x 1', and the values are 'option-x-1'.
#' s_options <- list()
#' s_options[[sprintf("option label %d 1", x)]] <- sprintf("option-%d-1", x)
#' s_options[[sprintf("option label %d 2", x)]] <- sprintf("option-%d-2", x)
#'
#' # Change values for input$inSelect
#' updateSelectInput(session, "inSelect", choices = s_options)
#'
#' # Can also set the label and select an item (or more than one if it's a
#' # multi-select)
#' updateSelectInput(session, "inSelect2",
#' label = paste("Select label", x),
#' choices = s_options,
#' selected = sprintf("option label %d 2", x)
#' )
#' })
#' })
#' }
#' @export
updateSelectInput <- function(session, inputId, label = NULL, choices = NULL,
selected = NULL) {
choices <- choicesWithNames(choices)
options <- list()
for (i in seq_along(choices)) {
choiceName <- names(choices)[i]
opt <- list(value = choices[[i]],
label = choiceName,
selected = choiceName %in% selected)
options[[i]] <- opt
}
message <- dropNulls(list(label = label, options = options))
session$sendInputMessage(inputId, message)
}