Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Select/Deselect All Button for shiny variable selection

Tags:

r

shiny

I have this statement that lets me get basic descriptive statistics about my variables:

checkboxGroupInput('show_vars', 'Columns in diamonds to show:',
                          names(input_data), selected = names(input_data))

However, after having to unclick 10 variables to get the one variable I was interested in, I realized that this user interface is not very friendly. I would like to add a button that selects/deselects all when you click it. It can be clicked multiple times. I am not even sure how to begin. Any nudges will help.

ui.R:

library(shiny)
hw<-diamonds 

shinyUI(fluidPage(
  title = 'Examples of DataTables',
  sidebarLayout(
    sidebarPanel(
        checkboxGroupInput('show_vars', 'Columns in diamonds to show:',
                           names(hw), selected = names(hw))

    ),
    mainPanel(
      verbatimTextOutput("summary"), 
      tabsetPanel(
        id = 'dataset',
        tabPanel('hw', dataTableOutput('mytable1'))
        )
    )
  )
))

server.R:

library(shiny)
data(diamonds)
hw<-diamonds  
shinyServer(function(input, output) {
  output$summary <- renderPrint({
    dataset <- hw[, input$show_vars, drop = FALSE]
    summary(dataset)
  })
  # a large table, reative to input$show_vars
  output$mytable1 <- renderDataTable({
    library(ggplot2)
    hw[, input$show_vars, drop = FALSE]
  })
})
like image 212
user3780173 Avatar asked Jul 23 '14 16:07

user3780173


3 Answers

This is how I set up a select/deselect all button.

In ui.R add an action button where needed:

actionButton("selectall", label="Select/Deselect all")

Then server.R uses updateCheckboxGroupInput based on the condition of the action button. If the number of times the button is pressed is even it will select all, else if it's odd it will select none.

# select/deselect all using action button

observe({
  if (input$selectall > 0) {
    if (input$selectall %% 2 == 0){
      updateCheckboxGroupInput(session=session, 
                               inputId="show_vars",
                               choices = list("carat" = "carat",
                                              "cut" = "cut",
                                              "color" = "color",
                                              "clarity"= "clarity",
                                              "depth" = "depth",
                                              "table" = "table",
                                              "price" = "price",
                                              "x" = "x",
                                              "y" = "y",
                                              "z" = "z"),
                               selected = c(names(hw)))

    } else {
      updateCheckboxGroupInput(session=session, 
                               inputId="show_vars",
                               choices = list("carat" = "carat",
                                              "cut" = "cut",
                                              "color" = "color",
                                              "clarity"= "clarity",
                                              "depth" = "depth",
                                              "table" = "table",
                                              "price" = "price",
                                              "x" = "x",
                                              "y" = "y",
                                              "z" = "z"),
                               selected = c())

    }}
})

The full app for your example below - you'd need to add session to the server function, I added a condition for renderDataTable when no variables are selected.

library(shiny)
library(ggplot2)
data(diamonds)
hw <- diamonds

runApp(
  list(
    ui=(
      fluidPage(
        title = 'Examples of DataTables',
        sidebarLayout(
          sidebarPanel(
            actionButton("selectall", label="Select/Deselect all"),
            checkboxGroupInput('show_vars', 'Columns in diamonds to show:',
                               names(hw), selected = names(hw))

          ),
          mainPanel(
            verbatimTextOutput("summary"),
            tabsetPanel(
              id = 'dataset',
              tabPanel('hw', dataTableOutput('mytable1'))
            ))))),

    server = (function(input, output, session) {
      output$summary <- renderPrint({
        dataset <- hw[, input$show_vars, drop = FALSE]
        summary(dataset)
      })
      observe({
        if (input$selectall > 0) {
          if (input$selectall %% 2 == 0){
            updateCheckboxGroupInput(session=session, inputId="show_vars",
                                     choices = list("carat" = "carat",
                                                    "cut" = "cut",
                                                    "color" = "color",
                                                    "clarity"= "clarity",
                                                    "depth" = "depth",
                                                    "table" = "table",
                                                    "price" = "price",
                                                    "x" = "x",
                                                    "y" = "y",
                                                    "z" = "z"),
                                     selected = c(names(hw)))

          }
          else {
            updateCheckboxGroupInput(session=session, inputId="show_vars",
                                     choices = list("carat" = "carat",
                                                    "cut" = "cut",
                                                    "color" = "color",
                                                    "clarity"= "clarity",
                                                    "depth" = "depth",
                                                    "table" = "table",
                                                    "price" = "price",
                                                    "x" = "x",
                                                    "y" = "y",
                                                    "z" = "z"),
                                     selected = c())

          }}
      })

      # a large table, reative to input$show_vars
     output$mytable1 <- renderDataTable({
        if (is.null(input$show_vars)){
          data.frame("no variables selected" = c("no variables selected"))
        } else{
          hw[, input$show_vars, drop = FALSE]
        }

      })
    })

  ))
like image 119
Alistair W Avatar answered Nov 18 '22 15:11

Alistair W


The shinyWidgets library has a nice function called pickerInput() that comes with a "select all/deselect all" feature. After much research, I found this to be the only Shiny input that has this feature built-in:

enter image description here

Link to site: https://dreamrs.github.io/shinyWidgets/index.html

like image 38
Dale Kube Avatar answered Nov 18 '22 16:11

Dale Kube


I added a global.R for loading packages and data - not always necessary but it's generally cleaner. There might be different ways to do what I did below, but I tend to use conditional panels in situations like this.

ui.R

library(shiny)

shinyUI(fluidPage(
  title = 'Examples of DataTables',
  sidebarLayout(
    sidebarPanel(

      radioButtons(
        inputId="radio",
        label="Variable Selection Type:",
        choices=list(
          "All",
          "Manual Select"
        ),
        selected="All"),

      conditionalPanel(
        condition = "input.radio != 'All'",
        checkboxGroupInput(
          'show_vars', 
          'Columns in diamonds to show:',
          choices=names(hw), 
          selected = "carat"
        )
      )

    ),
    mainPanel(
      verbatimTextOutput("summary"), 
      tabsetPanel(
        id = 'dataset',
        tabPanel('hw', dataTableOutput('mytable1'))
      )
    )
  )
))

server.R

library(shiny)
library(ggplot2)
##
shinyServer(function(input, output) {

  Data <- reactive({

    if(input$radio == "All"){
      hw
    } else {
      hw[,input$show_vars,drop=FALSE]
    }

  })

  output$summary <- renderPrint({
    ## dataset <- hw[, input$show_vars, drop = FALSE]
    dataset <- Data()
    summary(dataset)
  })

  # a large table, reative to input$show_vars
  output$mytable1 <- renderDataTable({
    Data()
    ## hw[, input$show_vars, drop = FALSE]
  })
})

global.R

library(shiny)
library(ggplot2)
data(diamonds)
hw <- diamonds

enter image description here

enter image description here

like image 10
nrussell Avatar answered Nov 18 '22 16:11

nrussell