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

Question

下面的 MWE 代码工作正常。它允许用户单击单选按钮来选择聚合数据的方法：在本例中为第 1 期或第 2 期。

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

我如何创建一个在概念上类似于 sumCol() 的反应函数，它会被 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

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

Answer 2

这是 dplyr 和 magrittr 包的解决方案。

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

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)

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

How to create a function with a reactive object?

r

function

shiny

reactive