从上传的数据框中闪亮选择特定列

Question

我已经合并了不同的代码源来制作一个允许上传文件（数据框）的应用程序。

但是，除此之外，我还希望能够从数据框中选择特定列并对其进行分析。然而，这很困难，因为必须预先定义给定的数据框，以便能够在 ui.R 脚本中引用它....在 ui.R 中，因为它是在服务器中定义的....

预定义变量

vchoices <- 1:ncol(mtcars)
names(vchoices) <- names(mtcars)

用户界面

    runApp(
      ui = basicPage(
        h2('The uploaded file data'),
        dataTableOutput('mytable'),
        fileInput('file', 'Choose info-file to upload',
                  accept = c(
                    'text/csv',
                    'text/comma-separated-values',
                    'text/tab-separated-values',
                    'text/plain',
                    '.csv',
                    '.tsv'
                  )
        ),
        actionButton("choice", "incorporate external information"),

        selectInput("columns", "Select Columns", choices=vchoices, inline = T),
        #notice that the 'choices' in selectInput are set to the predefined 
        #variables above whereas I would like to set them equal to the 
        #not yet defined uploaded file below in server.R

        tableOutput("table_display")
      ))

请注意，selectInput 中的“选择”设置为上面的预定义变量，而我想将它们设置为等于下面 server.R 中尚未定义的上传文件

服务器

  server = function(input, output) {

      info <- eventReactive(input$choice, {
        inFile <- input$file
        if (is.null(inFile))
          return(NULL)
        isolate(f<-read.table(inFile$datapath, header = T,
                               sep = "\t"))
        f
      })
      output$table_display<-renderTable({
        f<-info()
        f<-subset(f, select=input$columns) #subsetting takes place here
        head(f)
      })
    }

有没有人知道一种方法来引用在服务器中定义的变量，在 ui 中，从而允许交互式操作？

Answer 1

您可以使用一系列函数update*Input- 在这种情况下updateSelectInput。它的第一个参数必须是session，您还必须添加sessiontoserver <- function(input, output)才能更新您的小部件。

您可以在单击后立即更新小部件actionButton- 因此，您必须updateSelectInput在eventReactive.

让我们来看看如何做到这一点：

首先，您可以将新上传的数据集的列名保存在一个变量中，例如，vars然后将其传递给函数updateSelectInput。（ 的选项selectInput最初设置为NULL- 我们不需要在此之前指定它们，因为它们无论如何都会被更新）

info <- eventReactive(input$choice, {
    inFile <- input$file
    # Instead # if (is.null(inFile)) ... use "req"
    req(inFile)

    # Changes in read.table 
    f <- read.table(inFile$datapath, header = input$header, sep = input$sep, quote = input$quote)
    vars <- names(f)
    # Update select input immediately after clicking on the action button. 
    updateSelectInput(session, "columns","Select Columns", choices = vars)

    f
  })

我在你的代码中添加了一个小的上传界面。

另一种方法是在服务器端定义小部件，然后通过renderUI函数将它们传递给客户端。你可以在这里找到一个例子。

完整示例：

library(shiny)

ui <- fluidPage(
  h2('The uploaded file data'),
  dataTableOutput('mytable'),
  fileInput('file', 'Choose info-file to upload',
            accept = c(
              'text/csv',
              'text/comma-separated-values',
              'text/tab-separated-values',
              'text/plain',
              '.csv',
              '.tsv'
            )
  ),
  # Taken from: http://shiny.rstudio.com/gallery/file-upload.html
  tags$hr(),
  checkboxInput('header', 'Header', TRUE),
  radioButtons('sep', 'Separator',
               c(Comma=',',
                 Semicolon=';',
                 Tab='\t'),
               ','),
  radioButtons('quote', 'Quote',
               c(None='',
                 'Double Quote'='"',
                 'Single Quote'="'"),
               '"'),
  ################################################################

  actionButton("choice", "incorporate external information"),

  selectInput("columns", "Select Columns", choices = NULL), # no choices before uploading 

  tableOutput("table_display")
)

server <- function(input, output, session) { # added session for updateSelectInput

  info <- eventReactive(input$choice, {
    inFile <- input$file
    # Instead # if (is.null(inFile)) ... use "req"
    req(inFile)

    # Changes in read.table 
    f <- read.table(inFile$datapath, header = input$header, sep = input$sep, quote = input$quote)
    vars <- names(f)
    # Update select input immediately after clicking on the action button. 
    updateSelectInput(session, "columns","Select Columns", choices = vars)

    f
  })

  output$table_display <- renderTable({
    f <- info()
    f <- subset(f, select = input$columns) #subsetting takes place here
    head(f)
  })
}
shinyApp(ui, server)