如何在R Shiny中处理缺失数据时正常显示valueBox？

核心思路是在渲染valueBox前先判断对应数据是否存在，若缺失则返回显示加粗NA、保留副标题且背景为白色的箱体，正常数据则维持原有逻辑。

修改后的完整代码如下：

library(shiny)
library(shinydashboard)
library(tidyverse)

# Unique names for dropdown list.
names <- paste("Name", LETTERS[1:10])

# Example data.
set.seed(1)
dat <- data.frame(
  name = rep(paste("Name", LETTERS[c(1:6, 9:10)]), times = 2),
  date = rep(Sys.Date() + sample(1:10, 8), times = 2),
  var = c(rep("Left", 8), rep("Right", 8)),
  value = round(rnorm(16, 100, 20), 1)
)

##### APP #####

ui <- dashboardPage(
  dashboardHeader(title = "Example App"),
  
  dashboardSidebar(
    sidebarMenu(
      menuItem("Tab One",
               tabName = "tab1")
    )
  ),
  
  dashboardBody(
    tabItem(tabName = "tab1",
            fluidRow(
              box(selectInput("name", "Select Name:",
                              names,
                              selected = "Name A",
                              multiple = FALSE),
                  width = 12),
              valueBoxOutput("box1", width = 2),
              valueBoxOutput("box2", width = 2)
            )
    )
  )
)

server <- function(input, output){
  
  x <- reactive({
    dat %>%
      filter(name == input$name)
  })
  
  output$box1 <- renderValueBox({
    # 精准获取Left对应的值
    left_val <- x() %>% 
      filter(var == "Left") %>% 
      pull(value) %>% 
      first()
    
    if(is.na(left_val)){
      valueBox(
        value = tags$strong("NA"),
        subtitle = "Left",
        color = "white"
      )
    } else {
      valueBox(
        value = left_val,
        subtitle = "Left",
        color = ifelse(left_val >= 100, "green", "red")
      )
    }
  })
  
  output$box2 <- renderValueBox({
    # 精准获取Right对应的值
    right_val <- x() %>% 
      filter(var == "Right") %>% 
      pull(value) %>% 
      first()
    
    if(is.na(right_val)){
      valueBox(
        value = tags$strong("NA"),
        subtitle = "Right",
        color = "white"
      )
    } else {
      valueBox(
        value = right_val,
        subtitle = "Right",
        color = ifelse(right_val >= 100, "green", "red")
      )
    }
  })
  
}

shinyApp(ui = ui, server = server)

修改说明 #

• 针对每个valueBox，通过filter(var == "Left/Right")精准获取对应变量的值，避免依赖数据行顺序导致的错误
• 使用is.na()判断数据是否缺失，缺失时返回显示加粗NA、白色背景的箱体
• 正常数据时维持原有逻辑，根据值是否≥100设置绿色/红色背景

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