闪亮：动态复选框组输入

Question

我正在构建一个闪亮的应用程序，我想添加一个依赖于其他输入的动态 "checkboxGroup"。更准确地说，用户可以上传 N 个文件，应用程序进行一些计算，然后输出是一个 table 有 N 列（每个上传的文件一个）。在这一点上，我希望用户能够 select 只有某些列，即 he/she 想要考虑的列，然后 table 应该根据用户的选择进行更新。

我在网上看了一些闪亮的应用程序，最接近的解决方案可能是这样的 https://shiny.rstudio.com/gallery/datatables-demo.html

但不幸的是在那个例子中我们有

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

其中钻石是 "known"，而在我的情况下，我不知道用户将上传多少文件以及我的 table 将有多少列。

有什么想法吗？干杯

已编辑： 这是我要参考的代码部分。它有效，用户可以上传 N excel 个具有相同行数的文件。该应用程序 returns 一个包含 N 列的选项卡（每个上传文件的第二列）。理想情况下，现在我想添加 N 个复选框（最初都是 selected），用户可以取消选中 he/she 不想考虑的列。说 he/she 取消选中 2 列，然后选项卡变为包含 N-2 列的选项卡。

再次感谢

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)

Answer 1

听起来您需要 checkboxGroupInput 有反应。 requires 是服务器脚本上的 renderUI 和 ui 脚本上的 uiOutput 的组合。

Answer 2

我稍微简化了代码以演示组复选框的工作原理。

为了简化，我将 csv 文件中的数据保存为 list。然后计算从列表中的所有数据框中提取第二列，然后使用 select 根据复选框显示列。

复选框项根据数据第二列的名称，默认全部选中。

现在不再输入读取的文件数，而是根据 list 数据的长度进行计算。

如果这更接近您的需要，请告诉我。

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)

闪亮：动态复选框组输入

Shiny: dynamic checkboxGroupInput

checkbox

r

shiny

responsive