R语言Shiny app调用自定义函数绘制plotly图时出现报错如何解决

问题根源 #

你的代码存在4个核心错误，逐一对应报错和无输出问题：

• UI层调用了plotOutput渲染plotly图表，plotly专用输出组件为plotlyOutput，这是无图表输出的核心原因
• 未加载lubridate包就调用my()函数处理日期，导致数据处理环节报错中断
• plotly的公式环境不支持rlang的{{}}卷曲插值，直接传入sym类型对象会触发类型错误
• 处理颜色时直接对sym类型的group_variable调用unique()，触发unique() applies only to vectors报错

修正方案 #

1. 替换UI层的plotOutput("distPlot")为plotlyOutput("distPlot")
2. 加载lubridate包用于日期转换
3. 数据处理环节保留rlang插值，plotly传参改用.data[[列名字符串]]的方式引用动态列
4. 从处理好的base_data中取分组列的唯一值生成配色向量，不要直接操作sym对象
5. 复用函数参数group_filter代替硬编码的input$group_choice，保证函数复用性

完整可运行代码 #

library(tidyr)
library(shiny)
library(plotly)
library(dplyr)
library(rlang)
library(stringr)
library(lubridate) # 新增lubridate包用于日期转换

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

ui <- fluidPage(
  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)),
    mainPanel(
      plotlyOutput("distPlot") # 替换为plotly专用输出组件
    )
  )
)

server <- function(input, output) {
  employee_list <- reactive({
    req(input$resource_choice)
    input$resource_choice
  })
  
  resource_plots <- function(data, group_variable, group_filter = NULL, title) {
    group_col <- sym(group_variable)
    # 数据处理环节用rlang插值
    base_data <- data %>%
      dplyr::group_by(!!group_col) %>%
      summarise_at(vars(contains("_20")), sum, na.rm = TRUE) %>%
      pivot_longer(-!!group_col, names_to = "date", values_to = "capacity") %>%
      mutate(date_num = my(str_replace(date, "_", " ")), # 修正日期转换逻辑
             date = toTitleCase(str_replace_all(date, "_20", " "))) %>%
      ungroup() %>%
      mutate(date = reorder(date, date_num))
    # 应用过滤条件，复用group_filter参数
    if(!is.null(group_filter)){
      base_data <- base_data %>% dplyr::filter(!!group_col %in% group_filter)
    }
    # 生成配色
    some_colors <- c("#CA001B", "#1D28B0", "#D71DA4", "#00A3AD", "#FF8200", "#753BBD", "#00B5E2", "#008578", "#EB6FBD", "#FE5000", "#6CC24A", "#D9D9D6", "#AD0C27", "#950078")
    group_unique <- unique(base_data[[group_variable]])
    used_colors <- some_colors[seq_along(group_unique)]
    
    # plotly用.data[[ ]]引用动态列，避免插值问题
    fig <- plot_ly(base_data, x = ~date, y = ~capacity, type = 'scatter', mode = "lines", 
                   name = ~.data[[group_variable]], color = ~.data[[group_variable]], 
                   colors = used_colors) %>%
      layout(title = list(text = title), legend = list(orientation = 'h', x = .5, xanchor = "center", y = -.3))
    return(fig)
  }
  
  output$distPlot <- renderPlotly({
    req(input$group_choice) # 增加输入校验，避免选择为空时报错
    resource_plots(my_data, "project", input$group_choice, "Will it ever work?")
  })
}

shinyApp(ui = ui, server = server)

内容的提问来源于stack exchange，提问作者J.Sabree