Filteinput数据的每个非数字列的发光选择输入

Question

我想创建一个闪亮的仪表板，其中：1）用户选择一个excel文件2）为获得的数据帧的每个非数字列创建一个Selectinput选项，该选项为用户提供选择该列中每个唯一值的选项。到目前为止，这就是我的代码：

library(shiny)
library(dplyr)
library(openxlsx)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(

      fileInput('datafile', 'Choose xlsx file',
                accept = c(".xlsx")),

      lapply(names("varselect"), function(i) {
        selectInput(paste0(i), paste0(i),
                    choices = "varselect"[i],
                    multiple = TRUE,
                    selected = "")})),
    mainPanel()))


server <- function(input, output,session) {
    Data <- reactive({
    infile <- input$datafile
    if (is.null(infile)) {
      return(data.frame())
    }
    read.xlsx(infile$datapath, 
              sheetIndex = 1) %>% select_if(colSums(!is.na(.)) > 0%>% select_if(~!is.numeric(.x)) %>% head()) 

  })

  output$varselect <- renderUI({

  })


  observe({
    lapply(names(Data()), function(i) {
      selectInput(paste0(i), paste0(i),
                  choices = Data()[i],
                  multiple = TRUE,
                  selected = "")})})


}


shinyApp(ui = ui, server = server)

我知道以下事实：代码无法正常工作，并且存在一些严重错误，但是我希望有人可以帮助我找到解决该问题的方法。我对Shinny相当陌生，这就是为什么我老实不知道如何解决此问题的原因。

非常感谢。

Answer 1

在ui中，您可以包括一个uiOutput，其中将包含所有动态创建的selectInput小部件。

然后，在output$varselect中，您可以根据selectInput中的列数创建Data()。

library(shiny)
library(dplyr)
library(openxlsx)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput('datafile', 'Choose xlsx file',
                accept = c(".xlsx")),
      uiOutput("varselect")
    ),
    mainPanel()
  )
)

server <- function(input, output, session) {

  Data <- reactive({
    infile <- input$datafile
    if (is.null(infile)) {
      return(data.frame())
    }
    read.xlsx(infile$datapath, sheet = 1) %>%
      select_if(colSums(!is.na(.)) > 0) %>%
      select_if(~!is.numeric(.x)) %>%
      head()
  })

  output$varselect <- renderUI({
    if (ncol(Data() > 0)) {
      lapply(1:ncol(Data()), function(i) {
        selectInput(inputId = paste0("si_", i), 
                    label = paste0("Input #", i),
                    choices = Data()[,i],
                    multiple = TRUE)
      })
    }
  })

}

shinyApp(ui = ui, server = server)