如何为Shiny的惰性执行函数自定义错误提示信息？

问题背景 #

我开发的Shiny应用包含3个关联图表：

• 图表1：根据用户输入的百分比选取数据集行进行绘制
• 图表2：使用图表1未选中的剩余数据，再按输入的百分比选取后绘制
• 图表3：使用图表2未选中的剩余数据进行绘制

当前问题：图表2可以正常返回自定义错误信息，但由于Shiny的惰性执行特性，当图表2没有生成可用数据时，图表3依赖的Graph2_data_inverse()尚未生成，导致图表3显示默认错误"Error: argument is of length zero"，我希望替换为自定义错误信息。虽然通过重复编写validate(need(...))可以实现，但需要更优雅的方案。

优化方案 #

核心是统一处理数据集的有效性，避免重复验证逻辑：

1. 让每个逆数据集（*_data_inverse）在无数据时返回空数据框而非NULL，确保始终能被nrow()正常调用
2. 封装通用的验证逻辑，减少代码冗余
3. 在每个图表的数据生成函数中，先验证依赖的上游数据集是否有效

完整优化代码 #

library(shiny)
library(datasets)
library(shinyFeedback)
library(plotly)
library(dplyr)

data <- iris

ui <- fluidPage(
  shinyFeedback::useShinyFeedback(),
  
  column(4,
         numericInput("Graph1_percent", tags$span(style="color: #000000; font-size: 13px;", "Percent (%)"), value = 100, min = 0, max = 100),
         plotlyOutput("Graph1", height = 400)
  ),
  column(4,
         numericInput("Graph2_percent", tags$span(style="color: #000000; font-size: 13px;", "Percent (%)"), value = 100, min = 0, max = 100),
         plotlyOutput("Graph2", height = 400)
  ),
  column(4,
         numericInput("Graph3_percent", tags$span(style="color: #000000; font-size: 13px;", "Percent (%)"), value = 100, min = 0, max = 100),
         plotlyOutput("Graph3", height = 400)
  )
  
)

server <- function(input, output, session) {
  # 通用验证函数：检查数据集是否有行
  validate_data <- function(data, msg = 'There is no data available for this graph.') {
    validate(need(nrow(data) > 0, msg))
  }
  
  ### Graph 1
  Graph1_data <- reactive({
    n <- nrow(data)
    if(input$Graph1_percent == 0 || n == 0) {
      data.frame()  # 返回空数据框而非NULL
    } else {
      data[1:round(n*(input$Graph1_percent / 100)), ]
    }
  })
  
  Graph1_data_inverse <- reactive({
    n <- nrow(data)
    if(n == 0 || input$Graph1_percent == 100) {
      data.frame()  # 返回空数据框而非NULL
    } else {
      data[(round(n*(input$Graph1_percent / 100)) + 1):n, ]
    }
  })
  
  output$Graph1 <- renderPlotly({
    req(Graph1_data())
    ggplotly(Graph1_data() %>%
               ggplot(aes(x = Sepal.Length, fill = Species)) +
               geom_bar())
  })
  
  ### Graph 2
  Graph2_data <- reactive({
    validate_data(Graph1_data_inverse())
    
    n <- nrow(Graph1_data_inverse())
    if(input$Graph2_percent == 0 || n == 0) {
      data.frame()
    } else {
      Graph1_data_inverse()[1:round(n*(input$Graph2_percent / 100)), ]
    }
  })
  
  Graph2_data_inverse <- reactive({
    validate_data(Graph1_data_inverse())
    
    n <- nrow(Graph1_data_inverse())
    if(n == 0 || input$Graph2_percent == 100) {
      data.frame()
    } else {
      Graph1_data_inverse()[(round(n*(input$Graph2_percent / 100)) + 1):n, ]
    }
  })
  
  output$Graph2 <- renderPlotly({
    req(Graph2_data())
    ggplotly(Graph2_data() %>%
               ggplot(aes(x = Sepal.Length, fill = Species)) +
               geom_bar())
  })
  
  ### Graph 3
  Graph3_data <- reactive({
    validate_data(Graph2_data_inverse())
    
    n <- nrow(Graph2_data_inverse())
    if(input$Graph3_percent == 0 || n == 0) {
      data.frame()
    } else {
      Graph2_data_inverse()[1:round(n*(input$Graph3_percent / 100)), ]
    }
  })
  
  Graph3_data_inverse <- reactive({
    validate_data(Graph2_data_inverse())
    
    n <- nrow(Graph2_data_inverse())
    if(n == 0 || input$Graph3_percent == 100) {
      data.frame()
    } else {
      Graph2_data_inverse()[(round(n*(input$Graph3_percent / 100)) + 1):n, ]
    }
  })
  
  output$Graph3 <- renderPlotly({
    req(Graph3_data())
    ggplotly(Graph3_data() %>%
               ggplot(aes(x = Sepal.Length, fill = Species)) +
               geom_bar())
  })
  
}

shinyApp(ui = ui, server = server)

方案说明 #

• 每个数据集（包括逆数据集）在无数据时返回空数据框，避免nrow()调用报错
• 封装validate_data函数，统一处理数据有效性验证，减少重复代码
• 每个下游数据集生成前，先通过通用验证函数检查上游依赖数据集，确保自定义错误信息正常显示

内容的提问来源于stack exchange，提问作者Walshe_d