inst/doc/shiny_customized_widgets.R

In dipsaus: A Dipping Sauce for Data Analysis and Visualizations

## ----include = FALSE, echo=FALSE----------------------------------------------

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)


## ----setup, echo=FALSE--------------------------------------------------------
library(shiny)
library(dipsaus)

## ----eval=FALSE---------------------------------------------------------------
# 
# # UI function
# actionButtonStyled(inputId, label, icon = NULL, width = NULL,
#                    btn_type = "button", type = "primary", class = "", ...)
# 
# # Update function
# updateActionButtonStyled(session, inputId, label = NULL, icon = NULL,
#                          type = NULL, disabled = NULL, ...)

## ----results="asis", echo=FALSE-----------------------------------------------

btypes <- c("default", "primary", "info", "success", "warning", "danger")
btypes <- rbind(btypes, stringr::str_to_title(btypes))

tags$table(
  class = "table table-bordered text-center",
  tags$tbody(
    tags$tr(tagList(
      apply(btypes, 2, function(x) {
        tags$th(x[2], br(), tags$small(paste0('type="', x[1], '"')))
      }),
      tags$th("")
    )),
    tags$tr(
      apply(btypes, 2, function(x) {
        tags$td(actionButtonStyled("btn", x[2], type = x[1], btn_type = "a", width = "100%"))
      }),
      tags$td("[default]")
    ),
    tags$tr(
      apply(btypes, 2, function(x) {
        tags$td(actionButtonStyled("btn", x[2], type = x[1], btn_type = "a", 
                                   width = "100%", class = "btn-lg"))
      }),
      tags$td('class="btn-lg"')
    ),
    tags$tr(
      apply(btypes, 2, function(x) {
        tags$td(actionButtonStyled("btn", x[2], type = x[1], btn_type = "a", 
                                   width = "100%", class = "btn-sm"))
      }),
      tags$td('class="btn-sm"')
    ),
    tags$tr(
      apply(btypes, 2, function(x) {
        tags$td(actionButtonStyled("btn", x[2], type = x[1], btn_type = "a", 
                                   width = "100%", class = "btn-xs"))
      }),
      tags$td('class="btn-xs"')
    ),
    tags$tr(
      apply(btypes, 2, function(x) {
        tags$td(actionButtonStyled("btn", x[2], type = x[1], btn_type = "a", 
                                   width = "100%", disabled = TRUE))
      }),
      tags$td("disabled=TRUE")
    )
  )
)



## ----eval=FALSE---------------------------------------------------------------
# compoundInput2(
#   "compound", "Group Label", label_color = 1:10,
#   components = div(
#     textInput("txt", "Text"),
#     selectInput("sel", "Select", choices = 1:10, multiple = TRUE),
#     sliderInput("sli",
#                 "Slider",
#                 max = 1,
#                 min = 0,
#                 val = 0.5)
#   ), max_ncomp = 10, min_ncomp = 0, initial_ncomp = 1
# )

## ----eval = FALSE-------------------------------------------------------------
# # Bad example
# observeEvent(input$A, {
#   updateSliderInput(session, "B", value = input$A)
# })
# observeEvent(input$B, {
#   updateTextInput(session, "A", value = input$B)
# })

## ----eval = FALSE-------------------------------------------------------------
# sync_shiny_inputs(
#   input,
#   session,
#   inputIds = c("A", "B"),
#   uniform = list(function(a) {
#     as.numeric(a)
#   }, function(b) {
#     b
#   }),
#   updates = list(function(a) {
#     updateTextInput(session, "A", value = a)
#   }, function(b) {
#     updateSliderInput(session, "B", value = b)
#   })
# )