How to perform calculations on a data table rendered with a reactive data frame, in R Shiny?

Question

The below MWE code works as intended for summing columns of a reactive data frame (data() and summed_data() in the code). If you run the code or look at the image at the bottom, you'll see where the data frame columns are summed, based on either of two user input grouping criteria, under the header "Sum the data table columns:". The App works fine, through "Sum the data table columns:".

However, I am now trying to generate a new data table that takes the grouped values from summed_data() and performs the calculations described in the image under the heading "Calculations performed on summed data table columns:" (basically, [colA] divided by [average of colB in moving from one row to the next]). The user would be able to choose how to group the data in the calculations too, by Period_1 or by Period_2. The "Sum the data table columns" and "Calculations performed..." user input for grouping selection would be independent of each other.

Is there an efficient way to accomplish this? I'm trying to stick to base R and packages tidyverse and dplyr. I'd like avoid "package bloat".

Note that in the fuller App this is deployed, there are many more columns to calculate than in this simple MWE.

MWE code:

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)

Curious Jorge - user9788072 Curious Jorge - user9788072 · Accepted Answer · 2021-12-22T19:06:20

I figured out one solution, creating a new reactive object calculated_data() and using dplyr group_by() and mutate() functions to perform the calculations, as shown below in revised code:

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)

How to perform calculations on a data table rendered with a reactive data frame, in R Shiny?

1 Answers