as.formula 函数调用，其中公式输入是闪亮的反应对象

Question

这一直困扰着我多年。

我有一个函数，其中第一个参数需要采用以下形式 function(data~ group_variable) 或 function(data, group = data$group_variable) 的形式。

我有这个功能在控制台中顺利运行，但它是我闪亮的应用程序不可或缺的一部分，它一直困扰着我很长时间，因为数据和组都是用户选择的反应对象，所以它需要采取形式：

function(datasetInput() ~ !!input$group_variable) 或一些版本。

我还没有找到任何!!s、enquo()、substitute()、as.function(substitute()) 等的组合，可以在闪亮的应用程序中使用。 as.Formula(substitute(data ~ group)) 在控制台中工作。

这是我能做的尽可能少的陈述：

library(shiny)
library(shinyWidgets)
library(psych)
library(dplyr)
library(gt)
use <- function(name) {
  # consider future support for .json? 
  if (grepl(".csv", name)) {
    readr::read_csv(name)
  } else if (grepl(".xlsx", name)) {
    readxl::read_xlsx(name)
  } else if (grepl(".dta", name)) {
    haven::read_dta(name)
  } else if (grepl(".sav", name)) {
    haven::read_spss(name)
  } else if (grepl(".rda", name)) {
    load(name)
  } else {
    stop("unknown data type.")
  }
}

ui <- fluidPage(
  mainPanel(
    fileInput("FileInput", "Input Your Data Set"),
    helpText("Dataset must be one of: .csv, .sav, .dta, .xlsx, or .rda"), 
    materialSwitch(
      inputId = "ext_desc",
      label = "Extended Description", 
      value = FALSE,
      status = "primary"
    ),
    materialSwitch(
      inputId = "desc_by_group_bool",
      label = "Describe By A Group", 
      value = FALSE, 
      status = "primary"
    ),
    varSelectInput(
      inputId = "desc_group",
      label = "Select A Group",
      data = NULL, 
      width = "400px"
    ),
    gt::gt_output("description")
    
  )
)
server <- function(input,output, session){
  
  datasetInput <- reactive({
    infile <- input$FileInput
    if (is.null(infile))
      return(NULL)
    dat<-use(infile$datapath)
    names(dat) <-  gsub(" ", "_", names(dat), fixed = TRUE) 
    return(dat)
  })
  
  observeEvent(datasetInput(), {
    updateVarSelectInput(session, "desc_group", data = datasetInput())
  })
  
  desc <- reactive({
    req(datasetInput())
    if (input$desc_by_group_bool == FALSE) {
      datasetInput() %>%
        #select_if(is_numeric) %>%
        psych::describe(., fast = !(input$ext_desc),
                        omit = TRUE) %>%
        add_rownames(var = "Variable") %>%
        dplyr::select(-c(vars)) %>%
        dplyr::mutate(dplyr::across(is.numeric, round, 2)) %>%
        gt::gt() %>%
        gt::tab_options(
          column_labels.font.size = "small",
          table.font.size = "small",
          row_group.font.size = "small",
          data_row.padding = px(3)
        ) %>%
        gt::tab_header(title = paste0("Data Description"))
    } else {
      # datasetInput() %>%
      # select_if(is.numeric) %>%
      psych::describeBy( datasetInput() ~ !!input$desc_group,
                         # here we get "invalid argument type" error
                         fast = !(input$ext_desc),
                         mat = TRUE) %>%
        tibble::rownames_to_column() %>%
        select(-c(item, vars)) %>%
        dplyr::mutate(dplyr::across(is.numeric, round, 2)) %>%
        arrange(group1) %>%
        group_by(group1) %>%
        gt() %>%
        gt::tab_options(
          column_labels.font.size = "small",
          table.font.size = "small",
          row_group.font.size = "small",
          data_row.padding = px(3)
        ) %>%
        tab_header(title = paste0("Data Description") ,
                   subtitle = paste0("Grouped by: ",  input$desc_group)
        )
    }
    
    
  })
  
  output$description =  gt::render_gt(desc())
  
}
shinyApp(ui = ui, server = server)

导致错误的行——以及我的问题的来源，请原谅我，上面的第 85 行。

Answer 1

我们可以通过多种方式解决这个问题。一种方法是使用[[]] 对特定列进行子集化。因此将describeBy 行更改为：

psych::describeBy( datasetInput(), group = datasetInput()[[input$desc_group]]

还要在dplyr::across 中添加where

dplyr::mutate(dplyr::across(where(is.numeric), round, 2))