Question

我正在构建一个Shiny应用程序，我想添加一个动态的“ checkboxGroup”，它取决于其他一些输入。更准确地说，用户可以上传N个文件，应用程序进行一些计算，然后输出是一个包含N列的表格（每个上传的文件一个）。此时，我希望用户只能选择某些列，即他/她想考虑的列，然后该表应根据用户的选择进行更新。

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

但不幸的是，在该示例中，我们有

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

菱形是“已知的”，而在我的情况下，我不知道用户将上传多少文件以及表将具有多少列。

有什么想法吗？干杯

已编辑：这是我要参考的部分代码。它的工作原理是，用户可以上传具有相同行数的N个excel文件。该应用程序返回一个带有N列的标签（每个上传的文件的第二列）。理想情况下，现在我想添加N个复选框（最初全部选中），并且用户可以取消选中他/她不想考虑的列。假设他/她取消选中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

我简化了代码以演示组复选框如何工作。

为简化起见，我将list文件中的数据保留为csv。然后为了进行计算，从列表中的所有数据框中提取出第二列，然后使用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)

Answer 2

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

闪亮：动态checkboxGroupInput

2 个答案: