数据丢失时如何在 R Shiny 中创建 valueBox？

Question

我有一个类似于下面示例的闪亮应用程序。

我使用

valueBox()

返回一些与数据中特定变量相对应的值。在本例中，我仅使用 Left 和 Right 作为示例，其中框根据值是否大于 100 进行着色。我遇到的问题是当我从下拉列表中选择名称时数据中不存在的内容会在仪表板主体中返回一个丑陋的错误，就像下面的附加图片一样。

我的偏好是即使特定变量和/或名称的数据丢失，值框仍然可见。是的，我可以从下拉菜单中编辑名称，但这不是一个选项，因为我要求所有可能的名称都存在。我希望值框读取类似 NA 的内容，而不是以预期变量名称（例如 Left 或 Right）作为副标题的特定值（就像第一个中的那样）图像）。所有这些也都将出现在白色背景上。对于查看我的应用程序的其他最终用户来说，这看起来会干净得多。

有人使用下面的示例数据/代码对这个特定问题有任何解决方法或解决方案吗？

示例代码：

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({
    valueBox(value = first(x()$value),
             subtitle = "Left",
             color = ifelse(first(x()$value) >= 100, "green", "red")
             )
  })
  
  output$box2 <- renderValueBox({
    valueBox(value = last(x()$value),
             subtitle = "Right",
             color = ifelse(last(x()$value) >= 100, "green", "red")
    )
  })
  
  }

shinyApp(ui = ui, server = server)

Answer 1

正如@Limey 已经建议的那样，使用

if

或

ifelse

来解释任何

NA

值。但是，由于

"white"

不是有效的颜色（请参阅错误消息），我在 NA 情况下使用

"black"

：

set_color <- function(x) {
  if (is.na(x)) {
    return("black")
  }
  if (x >= 100) "green" else "red"
}

server <- function(input, output) {
  x <- reactive({
    dat %>%
      filter(name == input$name)
  })

  output$box1 <- renderValueBox({
    valueBox(
      value = first(x()$value),
      subtitle = "Left",
      color = set_color(first(x()$value))
    )
  })

  output$box2 <- renderValueBox({
    valueBox(
      value = last(x()$value),
      subtitle = "Right",
      color = set_color(last(x()$value))
    )
  })
}