Dplyr透视表RShiny

Question

这里有一个使用R.中的dataset starwars的示例starwars应用程序，它生成一个支点表，最终用户可以选择他们想要的“维度(S)”、“度量值(S)”和“聚合函数”，并相应地生成相应的数据集。

然而，在测试RShiny应用程序时，我遇到了“聚合函数”不能正常工作的问题。问题应该是在哪里定义pivotData数据。在summarize_at dplyr链中，对象funsList是从其以前分配的input$funChoices中调用的。然而，这是不工作的，产生和错误。

代码如下：

pivotData <- reactive({
    input$runit
    isolate({
      measuresVec <- input$measures
      dimensionsVec <- input$dimensions
      funsList <- input$funChoices
      
      pivotData <- data %>%
        group_by_at(vars(dimensionsVec)) %>%
        summarize_at(vars(measuresVec), funsList , na.rm = TRUE)
    })
    
    return(pivotData)
    
  })

如果将funsList替换为刚开始定义的functions对象，您将看到前两个输入(维度和度量)可以工作。但是，函数的数量显然是在RShiny应用程序中预先定义的，并且将自动显示，而不需要最终用户获得这个机会。

理想情况下，列的总数应该等于(维数的#)+(函数的度量值*#)

任何帮助都将不胜感激！非常感谢！

下面是整个代码片段：

library(DT)
library(shiny)
library(shinydashboard)
library(dplyr)
library(dbplyr)
library(tidyverse)
library(DBI)

ui <- function(request) {
  dashboardPage(
    dashboardHeader(title = "SW Pivot"),
    dashboardSidebar(
      actionButton("runit", "RUN QUERY"),
      hr(),
      
      h4(HTML("&nbsp"), "Select Table Rows"),
      uiOutput('rowSelect'),
      hr(),
      h4(HTML("&nbsp"), "Select Table Columns"),
      uiOutput('colSelect'),
      hr(),
      h4(HTML("&nbsp"), "Select Table Cell Fill"),
      uiOutput('aggSelect'),
      hr()
      
    ),
    dashboardBody(dataTableOutput("data"))
    
  )
}

data <- starwars

server<-shinyServer(function(input, output, session) {
  
  # Identify Measures, Dimensions, and Functions --------------
  
  dimensions <- colnames(data)[!sapply(data, is.numeric)]
  measures <- colnames(data)[sapply(data, is.numeric)]
  functions <- list( mean = mean, 
                     sum = sum, 
                     max = max, 
                     min = min)
  
  # functions <- as.vector(unlist(functions))
  
  output$rowSelect <- renderUI({
    selectizeInput(
      inputId = "dimensions",
      label = NULL,
      multiple = TRUE,
      choices = dimensions,
      selected = c()
    )
  })
  
  output$colSelect <- renderUI({
    selectizeInput(
      inputId = "measures",
      label = NULL,
      multiple = TRUE,
      choices = measures,
      selected = c()
    )
  })
  
  output$aggSelect <- renderUI({
    selectizeInput(
      inputId = "funChoices",
      label = NULL,
      multiple = TRUE,
      choices = functions,
      selected = c()
    )
  })
  
  pivotData <- reactive({
    input$runit
    isolate({
      measuresVec <- input$measures
      dimensionsVec <- input$dimensions
      funsList <- input$funChoices
      
      pivotData <- data %>%
        group_by_at(vars(dimensionsVec)) %>%
        summarize_at(vars(measuresVec), functions, na.rm = TRUE)
    })
    
    return(pivotData)
    
  })
  
  output$data <- renderDataTable({
      tabledata <- pivotData()
      datatable(tabledata)
  })
  
})

shinyApp(ui, server)

Answer 1

在定义function列表时，这些函数没有得到正确的存储。只要选择函数的字符串名称，然后使用match.fun获得实际函数就更容易了。

我注意到了几件事：

我已经用across

• you将您的dplyr代码更新为1.0.0当您不使用renderUI时获得一个更快的UI，但是当一些变量改变

时使用observeEvent/updateXInput

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

ui <- function(request) {
  dashboardPage(
    dashboardHeader(title = "SW Pivot"),
    dashboardSidebar(
      actionButton("runit", "RUN QUERY"),
      hr(),
      
      h4(HTML("&nbsp"), "Select Table Rows"),
      uiOutput('rowSelect'),
      hr(),
      h4(HTML("&nbsp"), "Select Table Columns"),
      uiOutput('colSelect'),
      hr(),
      h4(HTML("&nbsp"), "Select Table Cell Fill"),
      uiOutput('aggSelect'),
      hr()
      
    ),
    dashboardBody(dataTableOutput("data"))
    
  )
}

data <- starwars

server<-shinyServer(function(input, output, session) {
  
  # Identify Measures, Dimensions, and Functions --------------
  
  dimensions <- colnames(data)[!sapply(data, is.numeric)]
  measures <- colnames(data)[sapply(data, is.numeric)]
  functions_string <- c("mean", "sum", "max", "min")
  
  # functions <- as.vector(unlist(functions))
  
  output$rowSelect <- renderUI({
    selectizeInput(
      inputId = "dimensions",
      label = NULL,
      multiple = TRUE,
      choices = dimensions,
      selected = c()
    )
  })
  
  output$colSelect <- renderUI({
    selectizeInput(
      inputId = "measures",
      label = NULL,
      multiple = TRUE,
      choices = measures,
      selected = c()
    )
  })
  
  output$aggSelect <- renderUI({
    selectizeInput(
      inputId = "funChoices",
      label = NULL,
      multiple = TRUE,
      choices = functions_string,
      selected = c()
    )
  })
  
  pivotData <- eventReactive(input$runit, {
    measuresVec <- input$measures
    dimensionsVec <- input$dimensions
    
    fun_list <- lapply(input$funChoices, match.fun)
    names(fun_list) <- input$funChoices
    pivotData <- data %>%
      group_by(across(all_of(dimensionsVec))) %>%
      summarize(across(all_of(measuresVec), fun_list, na.rm = TRUE))
    
    return(pivotData)
    
  })
  
  output$data <- renderDataTable({
    tabledata <- pivotData()
    datatable(tabledata)
  })
  
})

shinyApp(ui, server)