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

问题描述

多年来，这一直困扰着我。

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

我已经在控制台中顺利运行了此功能，但是它对于我闪亮的应用程序是不可或缺的，并且困扰了我很多年了，因为数据和组都是用户选择的反应对象，因此需要使用形式：

function(datasetinput() ~ !!input$group_variable)或某些版本。

我无法找到!!，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",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,2)) %>%
        arrange(group1) %>%
        group_by(group1) %>%
        gt() %>%
        gt::tab_options(
          column_labels.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行。

解决方法

有多种方法可以解决此问题。一种方法是使用[[]]子集特定列。因此，将describeBy行更改为：

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

还要在where中添加dplyr::across

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