r - 如何使用响应式(Reactive)对象创建函数？

Question

下面的 MWE 代码运行良好。它允许用户单击单选按钮来选择聚合数据的方法:在本例中为周期 1 或周期 2。

在要部署的较大应用程序中，有许多列需要聚合。不只是像这个 MWE 中的 2 个。因此，我尝试创建一个通用函数来实现下面所示的 sumColA() 和 sumColB() 的目的。在下面注释掉的代码中，您可以看到我的尝试之一。这些行已被注释掉，因为它们不起作用。

如何创建一个与 sumCol() 概念类似的 react 函数，其中将使用 sumCol("ColA")、 等内容调用它sumCol("ColB")，或类似的东西？在完整的应用程序中，需要聚合太多列来创建 sumColA()、sumColB() 等的多个版本。

MWE代码:

library(shiny)

data <- data.frame(
  Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03"),
  Period_2 = c(1, 2, 3, 3, 1, 2),
  ColA = c(10, 20, 30, 40, 50, 60),
  ColB = c(15, 25, 35, 45, 55, 65)
)

ui <-
  fluidPage(
    h3("Data table:"),
    tableOutput("data"),
    h3("Sum the data table columns:"),
    radioButtons(
      inputId = "dataView",
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = c("Period_1", "Period_2"),
      selected = "Period_1",
      inline = TRUE
    ),
    tableOutput("totals")
  )

server <- function(input, output, session) {
  sumColA <- reactive({
    fmlaA <- as.formula(paste("ColA", input$dataView, sep = " ~ "))
    aggregate(fmlaA, data, sum)
  })

  sumColB <- reactive({
    fmlaB <- as.formula(paste("ColB", input$dataView, sep = " ~ "))
    aggregate(fmlaB, data, sum)
  })
  
  ### Create sumCol function ###
  # sumCol <- function (x) 
  #     {reactive({
  #       fmla <- as.formula(paste("x", input$dataView, sep = " ~ "))
  #       aggregate(fmla, data, sum)
  #     })
  # }
  ### End sumCol ###
  
  output$data <- renderTable(data)
  output$totals <- renderTable({
    totals <- as.data.frame(c(sumColA(), sumColB()[2]))
    # totals <- as.data.frame(c(sumCol(ColA), sumCol(ColB)[2]))
    
    colnames(totals) <- c(input$dataView, "Sum Col A", "Sum Col B")
    
    totals
  })
}

shinyApp(ui, server)

Answer 1

只需创建一个响应式(Reactive)对象 data 和另一个包含所有列总和的响应式(Reactive)表 summed_data:

library(shiny)
library(tidyverse)

ui <-
  fluidPage(
    h3("Data table:"),
    tableOutput("data"),
    h3("Sum the data table columns:"),
    radioButtons(
      inputId = "grouping",
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = c("Period_1", "Period_2"),
      selected = "Period_1",
      inline = TRUE
    ),
    tableOutput("sums")
  )

server <- function(input, output, session) {
  data <- reactive({
    # example data. Might change dynamically
    data.frame(
      Period_1 = c("2020-01", "2020-02", "2020-03", "2020-01", "2020-02", "2020-03"),
      Period_2 = c(1, 2, 3, 3, 1, 2),
      ColA = c(10, 20, 30, 40, 50, 60),
      ColB = c(15, 25, 35, 45, 55, 65)
    )
  })

  summed_data <- reactive({
    data() %>%
      group_by(!!sym(input$grouping)) %>%
      select(matches("^Col")) %>%
      summarise(across(everything(), sum))
  })

  output$data <- renderTable(data())
  output$sums <- renderTable(summed_data())
}

shinyApp(ui, server)