如何使用反应对象创建函数？

Posted 2023-02-14

【中文标题】如何使用反应对象创建函数？

【英文标题】：How to create a function with a reactive object?

【发布时间】：2022-01-19 08:16:32

【问题描述】：

下面的 MWE 代码可以正常工作。它允许用户单击单选按钮来选择聚合数据的方法：在这种情况下，按周期 1 或周期 2。

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

如何创建一个概念上类似于sumCol() 的反应函数，它可以用sumCol("ColA")、sumCol("ColB") 或类似的东西调用？在完整的 App 中，要聚合的列太多，无法创建多个版本的 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)

【参考方案1】：

只需创建一个反应对象data 和另一个反应表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)

【参考方案2】：

这是一个带有dplyr 和magrittr 包的解决方案。

更改的详细信息在代码 cmets 中。

library(shiny)
library(dplyr) # for data manipulation
library(magrittr) # for pipe operator

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)
)

dataView_choices <- c("Period_1", "Period_2") # define choices for select input

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 = dataView_choices, # choices for select input
      selected = "Period_1",
      inline = TRUE
    ),
    tableOutput("totals")
  )

server <- function(input, output, session) 

  output$data <- renderTable(data)
  output$totals <- renderTable(
    totals <- data %>% 
      select(-setdiff(dataView_choices, input$dataView)) %>% # remove other periods in the select input
      group_by_(input$dataView) %>% # group by the selected period
      summarise(across(everything(), sum, .names = "Sum_.col")) # sum of all columns with a "Sum_" prefix
    
    totals
  )


shinyApp(ui, server)

【讨论】：

按照 danlooo 的建议使用 group_by(!!sym(input$dataView)) 似乎更好，因为在 dplyr 0.7.0 中已弃用 group_by_()。