简体   繁体   中英

Shiny: dynamic checkboxGroupInput

I'm building a Shiny app and I would like to add a dynamic "checkboxGroup" which depends on some other input. More precisely, the user can upload N files, the app makes some calculations, then the output is a table with N columns (one for each file uploaded). At this point I would like the user to be able to select only certain columns, ie the ones he/she would like to consider, then the table should update according to the user's choice.

I had a look at some shiny apps on the web, and the closest solution is probably something like https://shiny.rstudio.com/gallery/datatables-demo.html

but unfortunately in that example we have

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

where diamonds is "known", whereas in my case I don't know how many files the user will upload and so how many columns my table will have.

Any ideas? Cheers

EDITED: Here there is the portion of code I'm reffering to. It works, the user can upload N excel files with same number of rows. The app returns a tab with N columns (the second column of each file uploaded). Ideally, now I would like to add N check boxes (all selected initially), and the user can uncheck the columns he/she doesn't want to consider. Say he/she uncheck 2 columns, then the tab changes into a tab with N-2 columns.

Thanks again

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(data.table)
library(dplyr)
library(xlsx)


sidebar <- dashboardSidebar(
  width = 350,
  sidebarMenu(
    tags$style(HTML(".sidebar-menu li a { color: #f4f8e8; }")),
    menuItem("Computations",tabName = "tab1", icon = icon("file-text-o"))
  ))


body <- dashboardBody(
  tags$style(".content-wrapper {background-color: #c3f9fa;}"),
  style = "color: black;",
  tabItems(
    tabItem(
      tabName = "tab1",
      h2("upload files"),
      tags$style(HTML(" .progress-bar { background-color: #1dbcbf; }")),
      fileInput("csvs",
                label="Upload CSVs here",
                multiple = TRUE),
      textInput(inputId="num_files", 
                label="number of files uploaded", 
                value = "", 
                width = NULL, 
                placeholder = NULL),
      actionButton(inputId = "display_tab", label = "Display Tab after computations"),
      box(title = "tab after computations:",tableOutput("all_cols"),width = 100),
      checkboxGroupInput(inputId="show_vars", "Columns to keep:", choices = "selectedData", selected = "selectedData")
    )))

dbHeader <- dashboardHeader(title = 'Exercise')


ui <- dashboardPage(

  skin = "black",
  dbHeader,
  sidebar,
  body
)

server <- function(input, output) {
  options(shiny.maxRequestSize=260*1024^2)

  computations <- function(num_files, db){
    num_files <- as.numeric(num_files)
    N <- nrow(db)/num_files  #number of rows for 1 file (they all have same size)
    tab_to_be_displayed <- db[1:N,2]

    for(j in (1:(num_files - 1))){
      left <- j*N+1
      right <- (j+1)*N
      tab_to_be_displayed <- cbind(tab_to_be_displayed, db[left:right,2])
    }
    return(tab_to_be_displayed)
  }


  mycsvs<-reactive({
    rbindlist(lapply(input$csvs$datapath, fread),
              use.names = TRUE, fill = TRUE)
  })



  selectedData <- reactive({
    names(computations(input$num_files, mycsvs()))
  })



  observeEvent(input$display_tab,{
    numero <- input$num_files
    comp_tab <- computations(numero, mycsvs())
    output$all_cols <- renderTable(comp_tab, align = 'c', rownames = TRUE, colnames = TRUE, digits = 3)
  })


}




shinyApp(ui = ui, server = server)

I simplified the code a bit to demonstrate how the group checkboxes could work.

In simplifying, I kept the data as a list from the csv files. Then for computations extracted the second column from all data frames in the list, then used select to show columns based on the checkboxes.

The checkbox items are based on the names of the second columns of the data, with a default of all selected.

Instead of entering the number of files that were read, it is now computed based on the length of the list of data.

Let me know if this is closer to what you need.

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(data.table)
library(dplyr)
library(xlsx)

sidebar <- dashboardSidebar(
  width = 350,
  sidebarMenu(
    tags$style(HTML(".sidebar-menu li a { color: #f4f8e8; }")),
    menuItem("Computations",tabName = "tab1", icon = icon("file-text-o"))
  ))

body <- dashboardBody(
  tags$style(".content-wrapper {background-color: #c3f9fa;}"),
  style = "color: black;",
  tabItems(
    tabItem(
      tabName = "tab1",
      h2("upload files"),
      tags$style(HTML(" .progress-bar { background-color: #1dbcbf; }")),
      fileInput("csvs",
                label="Upload CSVs here",
                multiple = TRUE),
      textOutput("numfiles"),
      box(title = "tab after computations:",tableOutput("all_cols"),width = 100),
      uiOutput("checkboxes")
    )))

dbHeader <- dashboardHeader(title = 'Exercise')

ui <- dashboardPage(
  skin = "black",
  dbHeader,
  sidebar,
  body
)

server <- function(input, output) {
  options(shiny.maxRequestSize=260*1024^2)

  db <- reactiveVal(list())

  computations <- function(){
    req(input$checkboxes)
    do.call(cbind, lapply(db(), "[", , 2)) %>%
      select_if(names(.) %in% input$checkboxes)
  }

  observeEvent(input$csvs, {
    db(lapply(input$csvs$datapath, fread))
  })

  output$numfiles <- renderText(paste("Number of files: ", length(db())))

  output$checkboxes <- renderUI({
    choice_list <- unlist(lapply(db(), function(x) colnames(x)[2]))
    checkboxGroupInput("checkboxes", "Columns to keep:", choices = choice_list, selected = choice_list)
  })

  output$all_cols <- renderTable(computations(), align = 'c', rownames = TRUE, colnames = TRUE, digits = 3)

}

shinyApp(ui = ui, server = server)

It sounds like you need your checkboxGroupInput to be reactive. That requires a combination of renderUI on your server script, and uiOutput on your ui script.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM