Shiny 如何动态选择导入数据集的列以进行进一步分析

Question

我正在尝试一个小型闪亮应用程序，其中我从本地目录加载一个 CSV 文件，然后从数据框中选择特定列并使用此子集数据框进行进一步的数据分析。

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(

   # Application title
   titlePanel("Old Faithful Geyser Data"),

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(
        fileInput("dataset", "Choose CSV File",
                  multiple = TRUE,
                  accept = c("text/csv",
                             "text/comma-separated-values,text/plain",
                             ".csv")),
        # Include clarifying text ----
        #helpText(em("Note: This app requires file in csv format only!!")),
        helpText(em("Note:Select all the inputs and click on button as given below to exectute the app")),
        # Input: Checkbox if file has header ----
        checkboxInput("header", "Header", TRUE),
        # Input: Select separator ----
        radioButtons("sep", "Separator",
                     choices = c(Comma = ",",
                                 Semicolon = ";",
                                 Tab = "\t"),
                     selected = ","),
        selectInput("select", "Select columns to display", names(datasetInput), multiple = TRUE),
        actionButton("update", "Update Data set", class = "btn-primary",style='padding:4px; font-size:120%')
      ),

      # Show a plot of the generated distribution
      mainPanel(
        h2('The Mydata'),
        dataTableOutput('mytable')
      )
   )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  datasetInput <- eventReactive(input$update, {
    validate(need(input$dataset != "", "Please select a data set in csv format only!!!"))# custom error message on opening the app
    read.csv(input$dataset$datapath,
             header = input$header,
             sep = input$sep)
  }, ignoreNULL = FALSE)

  dataset <- reactive({
    df_input<-datasetInput()
    df_input$x<-NULL
    df_input
  })

   output$mytable = renderDataTable({
     columns = names(dataset)
     if (!is.null(input$select)) {
       columns = input$select
     }
     dataset[,columns,drop=FALSE]
   })
}

# Run the application 
shinyApp(ui = ui, server = server)

查看一些 SO 答案；得到了一些；如下所示：

shiny allowling users to choose which columns to display

但是这个答案，数据集是预定义的；我想让用户下载他自己的数据集。

我收到以下错误：

lapply(obj, function(val) { : object 'datasetInput' not found

中的错误

我认为我必须在某个地方使用 observeEvent 函数？

Answer 1

这是server.R 的变体；与 akrun 的 ui.R 一起使用。这个动态调整过滤选项，并允许您通过添加列名称来添加列，即使在单击按钮后也是如此。

library(shiny)
library(DT)

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

  data <- reactive({
    req(input$dataset)
    read.csv(input$dataset$datapath, header = input$header,sep = input$sep)
    })

  filtereddata <- eventReactive({
      input$update
      data()
    },  {
    req(data())
    if(is.null(input$select) || input$select == "")
      data() else 
        data()[, colnames(data()) %in% input$select]
  })

  observeEvent(data(), {
    updateSelectInput(session, "select", choices=colnames(data()))
  })

  output$mytable  <- renderDataTable(filtereddata())

} 

Answer 2

我们可以修改它

library(shiny)
library(DT)

-ui

ui <- fluidPage(

  # Application title
  titlePanel("Old Faithful Geyser Data"),

  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      fileInput("dataset", "Choose CSV File",
                multiple = TRUE,
                accept = c("text/csv",
                           "text/comma-separated-values,text/plain",
                           ".csv")),
      # Include clarifying text ----
      #helpText(em("Note: This app requires file in csv format only!!")),
      helpText(em("Note:Select all the inputs and click on button as given below to exectute the app")),
      # Input: Checkbox if file has header ----
      checkboxInput("header", "Header", TRUE),
      # Input: Select separator ----
      radioButtons("sep", "Separator",
                   choices = c(Comma = ",",
                               Semicolon = ";",
                               Tab = "\t"),
                   selected = ","),
      selectInput("select", "Select columns to display", c('col1', 'col2'), multiple = TRUE),
      actionButton("update", "Update Data set", class = "btn-primary",style='padding:4px; font-size:120%')
    ),

    # Show a plot of the generated distribution
    mainPanel(
      h2('The Mydata'),
      #tableOutput("mytable")
      DT::dataTableOutput("mytable")

    )
  )
)

-服务器

server <- function(input, output) {

  values <- reactiveValues(df_data = NULL)
  observeEvent(input$dataset, {
      values$df_data <- read.csv(input$dataset$datapath,
                                header = input$header,
                                sep = input$sep
                                )}

               )
  observeEvent(input$update, {
    temp <- values$df_data[input$select]
    values$df_data <- temp

  })
  output$mytable  <- renderDataTable(values$df_data)

}

-运行应用程序

shinyApp(ui = ui, server = server)

-输出

-更新后

Answer 3

@Christoph Wolk ......太棒了！

只是一个小改动......因为我不想在使用浏览器选择数据时立即显示数据，但只有在点击 update data set 按钮时，我才将outdata() 注释掉，如下所示“

filtereddata <- eventReactive({
    input$update
    #data()
    },  {
    req(data())
        if(is.null(input$select) || input$select == "")
      data() else 
        data()[, colnames(data()) %in% input$select]
  })

  observeEvent(data(), {
    updateSelectInput(session, "select", choices=colnames(data()))
  })

有没有办法在应用打开时在主面板中显示自定义消息而不是空白；像这样：

Please select a data set in csv format only

我们需要在上面的filtereddata() 中添加某种条件：

validate(need(input$dataset != "","Please select a data set in csv format only!!!"))# custom error message on opening the app

解决了！！！！！！

filtereddata <- eventReactive({
    validate(need(input$dataset != "","Please select a data set in csv format only!!!"))# custom error message on opening the app
    input$update
    #data()
    },  {
       req(data())

    if(is.null(input$select) || input$select == "")
      data() else 
        data()[, colnames(data()) %in% input$select]
  })

在用户界面中

添加这个以获得错误消息的自定义颜色

# Custom error message with green colour ----



tags$head(
    tags$style(HTML("
                    .shiny-output-error-validation {
                    color: green;
                    }
                    ")))