How can I pass text to summarise() in shiny

Question

I'm building a shinyapp. I try to save the functions user selected as char into to a data.frame(), and then use paste() to generate something like "n = n(), sum = sum(value), mean = mean(value)" or shorter, and finally pass to summarise()
I tried the enquote() and eval(parse()), all failed.

library(shiny)
library(shinyjs)
library(tidyverse)

ui <- fluidPage(
  useShinyjs(),
  fluidRow(
    column(width = 3,
      wellPanel(
        selectInput("data_groupby", label = "group_by", choices = c(Choose = "", "group", "sameple", "var"), selected = c("group", "var"), multiple = TRUE),
        actionButton("data_groupby_ok", "click here to group_by"),
        selectInput("data_summarise_fun", "Function", choices = c(Choose = "", "n", "sum", "mean")),
        actionButton("data_summarise_add", "Summarise"),
        h4("paras to be passed to summarise():"),
        verbatimTextOutput("summarise_paras")
      )
    ),
    column(width = 3,
      h4("data:"),
      verbatimTextOutput("data")
    ),
    column(width = 3,
      h4("data_summarised:"),
      verbatimTextOutput("data_summarised")
    ),
    column(width = 3,
      h4("data_desired (if add 3 functions):"),
      verbatimTextOutput("data_desired")
    )
  )
)

server <- function(input, output, session) {

  aggr <- reactiveValues(
    data = NULL,
    summarise_paras = data.frame(column = character()),
    data_grouped = NULL,
    data_summarised = NULL,
    data_desired = NULL
  )

  set.seed(50)
  aggr$data <- data.frame(
    group = rep(LETTERS[1:3], each = 6),
    sample = rep(c(paste0("A_", 1:3), paste0("B_", 1:3), paste0("C_", 1:3)), each = 2),
    var = rep(c("height", "weight"), times = 9),
    value = runif(18, min = 0, max = 1)
  )

  aggr$data_desired <- data.frame(
    group = rep(LETTERS[1:3], each = 6),
    sample = rep(c(paste0("A_", 1:3), paste0("B_", 1:3), paste0("C_", 1:3)), each = 2),
    var = rep(c("height", "weight"), times = 9),
    value = runif(18, min = 0, max = 1)
  ) %>%
    group_by(group, var) %>% summarise(n = n(), sum = sum(value), mean = mean(value))

  observeEvent(input$data_groupby_ok, {
    groupby <- input$data_groupby
    aggr$data_grouped <- aggr$data %>% group_by(across(all_of(groupby)))
    disable("data_groupby")
  })

  observe({
    toggleState("data_summarise_add", nchar(input$data_summarise_fun) >0)
  })

  observeEvent(input$data_summarise_add, {

    tryCatch({
      fun <- input$data_summarise_fun

      if (fun == "n") {
        para <- "n = n()"
      } else if (fun == "sum") {
        para <- "sum = sum(value)"
      } else if (fun == "mean") {
        para <- "mean = mean(value)"
      }
      aggr$summarise_paras <- aggr$summarise_paras %>%
                              filter(column != para) %>%
                              bind_rows(data.frame(column = para))
      paras <- paste(aggr$summarise_paras$column, collapse = ",")
      aggr$data_summarised <- aggr$data_grouped %>% summarise(enquote(paras))

      reset("data_summarise_fun")
    }, error = function(e) {
      showNotification(paste(e$message), type = "error", duration = 5)
    })
  })

  output$data <- renderPrint({print(aggr$data)})
  output$summarise_paras <- renderPrint({print(aggr$summarise_paras)})
  output$data_summarised <- renderPrint({print(aggr$data_summarised)})
  output$data_desired <- renderPrint({print(aggr$data_desired)})
}

shinyApp(ui = ui, server = server)

My desired output is aggr$data_desired, which was printed in my shiny example

Answer 1

The issue is that (presumably) you want the values to be things like "n = 10, sum = -0.369, mean = -0.036987", but what you have written isn't that - it's bad because it's not valid R code (you can't just write x = 1, y = 2 in R, you will get the error Error: unexpected ',' in "x = 1,", but also because equals is for assignment, and you don't seem to want to assign n() to the variable n.

One option is using glue:

data |> summarise(val = glue::glue("n = {n()}, sum = {sum(value)}, mean = {mean(value)}"), .by = c(group, var))

Output:

   group var                                                          val
1      A   a n = 10, sum = -0.369871614091487, mean = -0.0369871614091487
2      A   b   n = 10, sum = -4.90551745324375, mean = -0.490551745324375
3      A   c   n = 10, sum = -4.04729937846017, mean = -0.404729937846017
4      A   d   n = 10, sum = -2.54372850319173, mean = -0.254372850319173
5      B   c   n = 10, sum = 0.936866512219415, mean = 0.0936866512219415
6      B   d   n = 10, sum = -3.34912487194284, mean = -0.334912487194284
7      B   a n = 10, sum = -0.341116609361569, mean = -0.0341116609361569
8      B   b   n = 10, sum = -3.18225275070246, mean = -0.318225275070246
9      C   a   n = 10, sum = -4.74290766135976, mean = -0.474290766135976
10     C   b   n = 10, sum = 0.112798793892494, mean = 0.0112798793892494
11     C   c   n = 10, sum = -1.44746005504636, mean = -0.144746005504636
12     C   d   n = 10, sum = -1.31363366405953, mean = -0.131363366405953
13     D   c     n = 10, sum = -3.3104100896434, mean = -0.33104100896434
14     D   d     n = 10, sum = 1.38864716115738, mean = 0.138864716115738
15     D   a     n = 10, sum = 6.04682327356391, mean = 0.604682327356391
16     D   b   n = 10, sum = -2.40214704657337, mean = -0.240214704657337
17     E   a   n = 10, sum = -2.66630215861559, mean = -0.266630215861559
18     E   b n = 10, sum = -0.889225624753177, mean = -0.0889225624753177
19     E   c   n = 10, sum = -6.39670148391452, mean = -0.639670148391452
20     E   d   n = 10, sum = -4.79912286801664, mean = -0.479912286801664

Answer 2

Here's a MWE that I think achieves your goal but takes a different approach to yours. I discard the intermediate data frame and use the values of Shiny widgets to produce the summary table. The only tricky piece is the use of !!as.symbol(), which is needed to convert Shiny's input strings to the tidy-selected symbols that are needed by the tidyverse.

library(shiny)
library(tidyverse)
library(DT)

ui <- fluidPage(
  selectInput(
    "analysisVar", 
    "Analysis variable:", 
    choices = names(mtcars),
    selected = "mpg"
  ),
  selectInput(
    "groupVar", 
    "Group variable:", 
    choices = names(mtcars),
    selected = "cyl"
  ),
  selectInput(
    "statistics", 
    "Summary statistics", 
    choices = c("mean", "min", "max", "median"), 
    multiple = TRUE,
    selected = "mean"
  ),
  dataTableOutput("results")
)

server <- function(input, output, session) {
  summaryStats <- reactive({
    req(input$groupVar, input$analysisVar)
    
    mtcars %>% 
      group_by(!!as.symbol(input$groupVar)) %>% 
      summarise(
        across(
          !!as.symbol(input$analysisVar), 
          .fns = list(mean = mean, min = min, max = max, median = median),
          .names = "{.fn}"
        ),
        .groups = "drop"
      ) %>% 
      select(input$groupVar, input$statistics)
  })
  
  output$results <- renderDataTable({ summaryStats() })
}

shinyApp(ui, server)