r - 为什么我的闪亮应用程序在使用自定义函数构建情节图时会发出警告：错误！：无效的参数类型错误？

Question

我正在尝试构建一个自定义函数来在我的 Shiny 应用程序中显示一个计数图。我想做一个函数，因为这个应用程序有这个情节的 4 个版本。该函数有 5 个输入：

resource_plots <- function (data, group_variable, group_filter = NULL, title) 

第一个参数是数据。第二个是要可视化的列的名称。第三个是用户通过第一个变量的特定级别向图表添加线条。最后一个是情节的标题。

为了使它工作，这个自定义函数会考虑输入，但它也使用 group_variable 上的 sym() 函数。我不断收到此警告，但没有看到任何情节，我不知道为什么：

Warning: Error in !: invalid argument type

这是我的代码的简化版本：

library(tidyr)
library(shiny)
library(plotly)
library(dplyr)
library(rlang)
library(stringr)

my_data <- tibble(employee = c("Justin", "Corey","Sibley", "Justin", "Corey","Sibley", "Lisa", "NA"),
                  education = c("graudate", "student", "student", "student", "student", "student", "student", "student"),
                  fte_max_capacity = c(1, 2, 3, 1, 2, 3, 4, 5),
                  project = c("big", "medium", "small", "medium", "small", "small", "medium", "medium"),
                  aug_2021 = c(2, 1, 1, 1, 1, 1, 2, 5),
                  sep_2021 = c(1, 1, 1, 1, 1, 1, 2, 50),
                  oct_2021 = c(1, 1, 1, 1, 1, 1, 2, 12),
                  nov_2021 = c(1, 1, 1, 1, 1, 1, 2, 10))

# Define UI for application that draws a histogram
ui <- fluidPage(
    
    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            selectInput("group_choice", label = h3("group_choice"), 
                        choices = unique(my_data$project),
                        selected = unique(my_data$project),
                        multiple = TRUE),
            selectInput("resource_choice", label = h3("resource_choice"), 
                        choices = unique(my_data$employee),
                        multiple = TRUE)),
        
        # Show a plot of the generated distribution
        mainPanel(
            plotOutput("distPlot")
        )
    )
)


# Define server logic required to draw a histogram
server <- function(input, output) {
    
    
    
    employee_list <- c(NA_character_)
    
    employee_list <- reactive({
        req(input$resource_choice)
        input$resource_choice
    })
    
    
    resource_plots <- function(data, group_variable, group_filter = NULL, title) {
        
        group_variable <- sym(group_variable)
        variable_list <- c("big")
        
        base_data <- data %>%
            dplyr::group_by(!!group_variable) %>%
            summarise_at(vars(contains("_20")), sum, na.rm = TRUE) %>%
            pivot_longer(-{{group_variable}}, names_to = "date", values_to = "capacity") %>%
            mutate(date_num = my(date),
                   date = toTitleCase(str_replace_all(date, "_20", " "))) %>%
            ungroup() %>%
            mutate(date = reorder(date, date_num)) %>%
            dplyr::filter(!!group_variable %in% variable_list)
        

        
        fig <- plot_ly(base_data, x = ~date, y = ~capacity, type = 'scatter', mode = "line", name = ~{{group_variable}}, color = ~{{group_variable}}) %>%
            layout(title = list(text = title), legend = list(orientation = 'h', x = .5, xanchor = "center", y = -.3))
        
        fig


    }
    
    
    
    output$distPlot <- renderPlotly({
        just_projects <- my_data %>%
            dplyr::select(project)
        
        resource_plots(my_data, names(just_projects), input$group_choice, "Will it ever work?")
        
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

编辑：我进一步减少了我的代码并将其放在上面。我现在收到一个新错误：

Warning: Error in unique.default: unique() applies only to vectors

这对我来说很奇怪，因为该函数没有调用unique()——UI 中唯一可以完美运行的部分。

编辑 2我实施了 stefan 建议的更改。我知道没有收到任何警告消息——但它也没有向我显示情节：

library(shiny)
library(plotly)
library(dplyr)
library(rlang)
library(stringr)

my_data <- tibble(employee = c("Justin", "Corey","Sibley", "Justin", "Corey","Sibley", "Lisa", "NA"),
                  education = c("graudate", "student", "student", "student", "student", "student", "student", "student"),
                  fte_max_capacity = c(1, 2, 3, 1, 2, 3, 4, 5),
                  project = c("big", "medium", "small", "medium", "small", "small", "medium", "medium"),
                  aug_2021 = c(2, 1, 1, 1, 1, 1, 2, 5),
                  sep_2021 = c(1, 1, 1, 1, 1, 1, 2, 50),
                  oct_2021 = c(1, 1, 1, 1, 1, 1, 2, 12),
                  nov_2021 = c(1, 1, 1, 1, 1, 1, 2, 10))

# Define UI for application that draws a histogram
ui <- fluidPage(
    
    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            selectInput("group_choice", label = h3("group_choice"), 
                        choices = unique(my_data$project),
                        selected = unique(my_data$project),
                        multiple = TRUE),
            selectInput("resource_choice", label = h3("resource_choice"), 
                        choices = unique(my_data$employee),
                        multiple = TRUE)),
        
        # Show a plot of the generated distribution
        mainPanel(
            plotOutput("distPlot")
        )
    )
)


# Define server logic required to draw a histogram
server <- function(input, output) {
    
    
    
    employee_list <- c(NA_character_)
    
    employee_list <- reactive({
        req(input$resource_choice)
        input$resource_choice
    })
    
    
    resource_plots <- function(data, group_variable, group_filter = NULL, title) {
        
        group_variable <- sym(group_variable)

        base_data <- data %>%
            dplyr::group_by(!!group_variable) %>%
            summarise_at(vars(contains("_20")), sum, na.rm = TRUE) %>%
            pivot_longer(-{{group_variable}}, names_to = "date", values_to = "capacity") %>%
            mutate(date_num = my(date),
                   date = toTitleCase(str_replace_all(date, "_20", " "))) %>%
            ungroup() %>%
            mutate(date = reorder(date, date_num)) %>%
            dplyr::filter(!!group_variable %in% input$group_choice)
        
        some_colors <- c("#CA001B", "#1D28B0", "#D71DA4", "#00A3AD", "#FF8200", "#753BBD", "#00B5E2", "#008578", "#EB6FBD", "#FE5000", "#6CC24A", "#D9D9D6", "#AD0C27", "#950078")
        
        line_chart_text_format <- list(
            family = "Arial",
            size = 10)
        
        title_format <- list(
            family = "Arial",
            size = 16)

        
        fig <-   eval_tidy(
            quo_squash(
                quo({plot_ly(base_data, x = ~date, y = ~capacity, type = 'scatter', mode = "line", name = ~{{group_variable}}, color = ~{{group_variable}}, colors = ~some_colors[seq_along(unique({{group_variable}}))]) %>%
                        layout(title = list(text = "Capacity by Project Impact"), legend = list(orientation = 'h', x = .5, xanchor = "center", y = -.3))
                })))
        
        fig


    }
    
    
    
    output$distPlot <- renderPlotly({
        just_projects <- my_data %>%
            dplyr::select(project)
        
        resource_plots(my_data, names(just_projects), input$group_choice, "Will it ever work?")
        
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

标签： rshinyplotlyrlangcustom-function