R 闪亮 |链接输入选择以对数据框进行分组

Question

我正在编写一个闪亮的应用程序，它将帮助我的同事更仔细地检查 csv 文件。

第一个选项卡允许导入，第二个选项卡用于数据分组。

为便于编码，如果没有上传 csv，则使用 mtcars 数据集。

它需要一个数据集，然后根据选定的列和分组编写摘要。

我设法开发了一种反应式输入，它采用您想要选择的列。然后仅使用那些“选定”列作为选择来更新分组输入。但是，它似乎没有将其传递给创建摘要输出的函数。它会产生一个警告：

警告：错误：必须使用有效的下标向量对列进行子集化。 x 下标的类型错误list。 ℹ 必须是数字或字符。 119：

哈希代码导致闪亮的应用程序崩溃。

library(shiny)
library(DT)
library(dplyr)

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

    myData <-reactive({
        if(is.null(input$file1)) return(mtcars)
        as.data.frame(rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
                  quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
                  use.names = TRUE,fill=TRUE
        ))
    })

    output$contents <-
            DT::renderDataTable({
        return(DT::datatable(myData(), filter='top'))
            })

    observe({
        data <- myData()
        updateSelectInput(session, 'selected',choices=names(data))
    })


#    observeEvent(input$selected, {
#        data <- myData() %>% select(all_of(input$selected))
#        updateSelectInput(session, 'groupby', choices= names(data))
#    })



    output$group_summary <- renderPrint({
        myData() %>%
            select(all_of(input$selected)) %>%
            group_by(across(all_of(input$groupby))) %>%
            summary()

    })



}
)


ui <- shinyUI(fluidPage(


    titlePanel("Nya Statistikhanteraren"),
            # Input: Select a file ----
    navlistPanel(
        tabPanel("Import",
                fileInput("file1", "Choose CSV File",
                          multiple = TRUE,
                          accept = c("text/csv",
                                     "text/comma-separated-values,text/plain",
                                     ".csv")),

            # Horizontal line ----
                tags$hr(),

            # Input: Checkbox if file has header ----
                checkboxInput("header", "Header", TRUE),

            # Input: Select separator ----
                radioButtons("sep", "Separator",
                            choices = c(Comma = ",",
                                        Semicolon = ";",
                                        Tab = "\t"),
                            selected = "\t"),

            # Input: Select quotes ----
                radioButtons("quote", "Quote",
                            choices = c(None = "",
                                        "Double Quote" = '"',
                                        "Single Quote" = "'"),
                            selected = '"'),

            # Input: Select decimal ----

            radioButtons("decimal","Decimal",
                         choices = c(Comma = ",",
                                     Dot = "."),
                         selected=","),

            # Horizontal line ----
                tags$hr(),

    # Main panel for displaying outputs ----


            # Output: Data file ----
                DT::dataTableOutput("contents")
        ),
    tabPanel("Grouping",

             varSelectInput("selected", "Selected:", data, multiple = TRUE),
             varSelectInput("groupby", "Grouping:", data, multiple=TRUE),

             box(
                 title="Summary",
                 status="warning",
                 solidHeader=TRUE,
                 verbatimTextOutput("group_summary")
             )
             )
    )
  )
)

shinyApp(ui,server)

Answer 1

我认为这更符合您的要求。选择器的主要问题是它们返回列表并且all_of() 想要一个向量，因此将input$selected 包装在as.character() 中解决了这个问题。您会遇到的另一个问题是正在生成的摘要不受group_by() 语句的影响。我修改了函数的那一部分，以便您可以在 group_by 参数中获得每个组的摘要。仍然有一个labels missing 警告，但我怀疑你可以解决这个问题。

library(shiny)
library(DT)
library(dplyr)

server <- shinyServer(function(input, output, session){
  #     Add to your server
  observeEvent(input$browser,{
      browser()
  })
  
  myData <-reactive({
    if(is.null(input$file1)) return(mtcars)
    as.data.frame(rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
                                   quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
                            use.names = TRUE,fill=TRUE
    ))
  })
  
  output$contents <-
    DT::renderDataTable({
      return(DT::datatable(myData(), filter='top'))
    })
  
  observe({
    data <- myData()
    updateSelectInput(session, 'selected',choices=names(data))
  })
  
  
     observeEvent(input$selected, {
         data <- myData() %>% dplyr::select(all_of(as.character(input$selected)))
         updateSelectInput(session, 'groupby', choices= names(data))
     })
  
  
  
  output$group_summary <- renderPrint({
    if(length(input$groupby) >0){
    tmp <- myData() %>%
      dplyr::select(all_of(as.character(input$selected))) %>%
      group_by(across(all_of(as.character(input$groupby))))
    tk <- tmp %>% group_keys
    tk <- tk %>% as.matrix() %>% apply(1, paste, collapse="-")
    tmp <- tmp %>% group_split() %>% setNames(tk)
    lapply(tmp, summary)
    }
  }, width=600)
  
  
  
}
)


ui <- shinyUI(fluidPage(
  
  
  titlePanel("Nya Statistikhanteraren"),
  # Input: Select a file ----
  navlistPanel(
    tabPanel("Import",
             fileInput("file1", "Choose CSV File",
                       multiple = TRUE,
                       accept = c("text/csv",
                                  "text/comma-separated-values,text/plain",
                                  ".csv")),
             
             # Horizontal line ----
             tags$hr(),
             
             # Input: Checkbox if file has header ----
             checkboxInput("header", "Header", TRUE),
             
             # Input: Select separator ----
             radioButtons("sep", "Separator",
                          choices = c(Comma = ",",
                                      Semicolon = ";",
                                      Tab = "\t"),
                          selected = "\t"),
             
             # Input: Select quotes ----
             radioButtons("quote", "Quote",
                          choices = c(None = "",
                                      "Double Quote" = '"',
                                      "Single Quote" = "'"),
                          selected = '"'),
             
             # Input: Select decimal ----
             
             radioButtons("decimal","Decimal",
                          choices = c(Comma = ",",
                                      Dot = "."),
                          selected=","),
             
             # Horizontal line ----
             tags$hr(),
             
             # Main panel for displaying outputs ----
             
             
             # Output: Data file ----
             DT::dataTableOutput("contents")
    ),
    tabPanel("Grouping",
             actionButton("browser", label = ), 
             varSelectInput("selected", "Selected:", data, multiple = TRUE),
             varSelectInput("groupby", "Grouping:", data, multiple=TRUE),
             
             box(
               title="Summary",
               status="warning",
               solidHeader=TRUE,
               verbatimTextOutput("group_summary")
             )
    )
  )
)
)

shinyApp(ui,server)

Answer 2

这就是我最终使用 rlang 解决它的方法。注意：下面的代码有一个 v$data.... 链，我想按顺序使用它。

  #Grouping functionality.
    observe({
        if(is.null(v$datarecoded)){
          if(is.null(v$datafiltered)){
            data <- myData()
          } else {
            data <- v$datafiltered
          }
          } else{
          data <- v$datarecoded
          }

      updateSelectInput(session, 'selected',choices=names(data),selected = names(data)[1])
    })


    observeEvent(input$selected, {
        updateSelectInput(session, 'groupby', choices= input$selected)
    })

    output$summary <- renderPrint({
      if(is.null(v$datarecoded)){
        if(is.null(v$datafiltered)){
          data <- mydata()
        } else {
          data <- v$datafiltered
        }
      } else{
        data <- v$datarecoded
      }
        data %>%
            select(!!!rlang::syms(input$selected)) %>%
            group_by(!!!rlang::syms(input$groupby)) %>%
            summary()

    })

    grouped_summary_temp <- reactive({
      if(is.null(v$datarecoded)){
        if(is.null(v$datafiltered)){
          data <- mydata()
        } else {
          data <- v$datafiltered
        }
      } else{
        data <- v$datarecoded
      }

         data2 <- data %>%
          select(!!!rlang::syms(input$selected)) %>%
          group_by(!!!rlang::syms(input$groupby)) %>%
          summarise(across(.fns=list(Min=min,Max=max,Mean=mean,Median=median,SD=sd)))
         return(data2)

         })

    output$grouped_summary <- DT::renderDataTable({
      DT::datatable(grouped_summary_temp(), filter='top')
    })