Dplyr数据透视表RShiny

下面是一个示例RShiny应用程序，它使用R中

dplyr

库中的数据集

starwars

。它生成一个透视表，最终用户可以在该透视表中选择他们想要的任意多个“维度”、“度量”和“聚合函数”，并相应地生成一个结果数据集

然而，在测试RShiny应用程序时，我遇到了“聚合函数”无法正常工作的问题。问题应该是在哪里定义了

pivotData

dataframe。在

summary\u 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)
    
  })

---

定义

函数

列表时，函数未正确存储。只需选择函数的字符串名称，然后使用

match.fun

即可获得实际函数

我注意到了几件事：

• 我已将您的

  dplyr

  代码更新为1.0.0，其中

  跨

• 当某些变量更改时，如果不使用

  renderUI

  而是使用

  observeEvent

  /

  updateInput

  ，则可以获得更快的UI

库（DT）
图书馆（闪亮）
图书馆（shinydashboard）
图书馆（dplyr）
谢谢你！你知道如何加上“长度”和“中间值”吗？出于某种原因，我在让它发挥作用方面遇到了一些困难。我假设您在最上面定义的函数_string对象中添加了这一点，但无法使其正常工作。
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)

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)