如何在 R Shiny 中对使用反应数据框呈现的数据表执行计算？

Question

下面的 MWE 代码按预期工作，用于对反应数据帧的列求和（代码中的data() 和 summed_data()）。如果您运行代码或查看底部的图像，您将根据两个用户输入分组标准中的任何一个，在标题“对数据表列求和：”。该应用程序运行良好，通过“汇总数据表列：”。

但是，我现在正在尝试生成一个新的数据表，该表从 summed_data() 获取分组值并执行图像中描述的计算，标题为“对汇总数据表列执行的计算：”（基本上，[colA] 除以 [从一行移动到下一行时 colB 的平均值]）。用户也可以选择如何按 Period_1 或 Period_2 对计算中的数据进行分组。用于分组选择的“汇总数据表列”和“执行的计算...”用户输入将相互独立。

有没有一种有效的方法来做到这一点？我试图坚持使用基本 R 和包 tidyverse 和 dplyr。我想避免“包装膨胀”。

请注意，在部署的更完整的应用程序中，要计算的列比在这个简单的 MWE 中要多得多。

MWE 代码：

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"),
    h3("Calculations performed on summed data table columns:"),
    radioButtons(
      inputId = "grouping2",
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = c("Period_1", "Period_2"),
      selected = "Period_1",
      inline = TRUE
    )
  )

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, 64),
      ColB = c(15, 25, 35, 45, 55, 33)
    )
  })
  
  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 1

我想出了一个解决方案，创建一个新的反应对象 calculated_data() 并使用 dplyr group_by() 和 mutate() 函数来执行计算，如下面的修改代码所示：

ui <-
  fluidPage(
    h3("Data table:"),
    tableOutput("data"),
    h3("Sum the data table columns:"),
    radioButtons(
      inputId = "grouping1", # changed
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = c("Period_1", "Period_2"),
      selected = "Period_1",
      inline = TRUE
    ),
    tableOutput("sums"),
    h3("Calculations performed on summed data table columns:"),
    radioButtons(
      inputId = "grouping2", # changed
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = c("Period_1", "Period_2"),
      selected = "Period_1",
      inline = TRUE
    ),
    tableOutput("calc") # added
  )

server <- function(input, output, session) {
  data <- reactive({
    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, 64),
      ColB = c(15, 25, 35, 45, 55, 33)
    )
  })
  
  summed_data <- reactive({
    data() %>%
      group_by(!!sym(input$grouping1)) %>%
      select("ColA","ColB") %>%
      summarise(across(everything(), sum))
  })
  
  calculated_data <- reactive({ # added this section
    data() %>%
      group_by(!!sym(input$grouping2)) %>%
        select("ColA","ColB") %>%
        summarise(across(everything(), sum)) %>%
      mutate(avgColB=case_when(is.na(lag(ColB)) ~ ColB, TRUE ~ (lag(ColB) + ColB)/2)) %>%
      mutate(ColAB = ColA / avgColB) %>%
      select(-ColA,-ColB,-avgColB)
  })
  
  output$data <- renderTable(data())
  output$sums <- renderTable(summed_data())
  output$calc <- renderTable(calculated_data()) # added
}

shinyApp(ui, server)