How to create a function with a reactive object?

user_9788072 0
Viewed 57

The below MWE code works fine. It allows the user to click on a radio button to choose the method for aggregating data: by either period 1 or period 2 in this case.

In the larger App this is to be deployed in, there are many columns to aggregate. Not just 2 like in this MWE. So I'm trying to create a general function that serves the purpose of sumColA() and sumColB() shown below. In the commented-out code below you can see one of my attempts. The lines are commented-out because they don't work.

How can I create a reactive function similar in concept to sumCol() where the it would be invoked with something like sumCol("ColA"), sumCol("ColB"), or something similar? In the full App there are too many columns to aggregate to create multiple versions of sumColA(), sumColB(), etc.

MWE code:

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)
reactive shiny r function
2 Answers

Just create one reactive object data and another reactive table summed_data containing the sums of all columns:

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

Here is a solution with dplyr and magrittr package.

Details of the change are in code comments.

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