根据shinydashboard中的数值创建动态的valueBox颜色。

Question

我想写一个shinydashboard应用程序来反映一家医院的床位情况。在一些valueBoxes中，我希望根据空床的数量改变盒子的颜色（从绿色-橙色-红色）。

我试着写了一个反应式对象，但似乎无法让颜色按照我想要的方式来反映数值。

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Situation Report"),
  dashboardSidebar(

    menuItem("Night Capacity Report", tabName = "night_report", icon = icon("file-alt"))



  ), #/dashboardSidebar
  dashboardBody(
    tabItems(
      tabItem(tabName = "night_report", h3("Night Capacity Report"),

              fluidRow(
                box(title = "MEDICINE", width = 12,

                    fluidRow(
                      valueBoxOutput("au1_night", width = 3),
                      valueBoxOutput("w13_night", width = 3),
                      valueBoxOutput("w9_night", width = 3)
                    )

                )
              )
      )


    ) #/tabItems
  ) #/dashboardBody
) #/dashboardPage


server <- function(input, output){

  colour_empty_med_ward <- reactive({
    for (i in seq_along(night_medicine)) {


      if(night_medicine[[i, 3]] >= 10){
        colour_med <- "green"
      }else if(night_medicine[[i, 3]] >= 5 & night_medicine[[i, 3]] < 10){
        colour_med <- "orange"
      }else if(night_medicine[[i, 3]] < 5){
        colour_med <- "red"
      }

      return(colour_med)
    }
  })
}

output$au1_night <- renderValueBox({

  valueBox(
    "AU 1", paste0(night_medicine[[1,3]], "/", night_medicine[[1,2]]), icon = icon("bed"),
    color = colour_empty_med_ward()
  )
})

output$w13_night <- renderValueBox({
  valueBox(
    "Ward 13", paste0(night_medicine[[2,3]], "/", night_medicine[[2,2]]), icon = icon("bed"),
    color = colour_empty_med_ward()
  )
})

output$w9_night <- renderValueBox({
  valueBox(
    "Ward 9", paste0(night_medicine[[3,3]], "/", night_medicine[[3,2]]), icon = icon("bed"),
    color = colour_empty_med_ward()
  )
})

shinyApp(ui = ui, server = server)

查询床位数的对象是从每次上传的Excel文件中导入的，但我已经附上了一个 dput 这里的样本。

> dput(night_medicine)
structure(list(Ward = c("AU1", "13", "9", "22", "23", "32", "33", 
"34", "41", "42", "43", "44", "51", "54", "Total"), Compliment = c("37", 
"12", "7", "20", "26", "23", "10", "16", "22", "24", "30", "30", 
"10", "7", "274"), Empty = c("0", "10", "5", "1", "2", "2", "0", 
"6", "0", "6", "0", "0", "0", "1", "33")), row.names = c(NA, 
-15L), class = c("tbl_df", "tbl", "data.frame"))

我对这个还很陌生，我正在努力寻找一种方法来解决这个问题。 我可以为每个病房写单独的反应对象，但是实际文件中有很多，我想知道我是否可以以某种方式绕过它，比如使用一个成功的版本。 colour_empty_med_ward().

Answer 1

你能不能让 colour_empty_med_ward 一个普通的函数，它的参数中包含了要用于颜色的值。 (在这种情况下，你可以简化并使用 cut 此处所示）。)

colour_empty_med_ward <- function(night_medicine) {
  cut(as.numeric(night_medicine), breaks=c(-Inf, 5, 10, Inf), labels=c("red","orange","green"), right = FALSE)
}

然后在 server 你的 output 可以调用该函数并向其发送相应的 night_medicine 价值。

server <- function(input, output){

  output$au1_night <- renderValueBox({
    valueBox(
      "AU 1", paste0(night_medicine[[1,3]], "/", night_medicine[[1,2]]), icon = icon("bed"),
      color = colour_empty_med_ward(night_medicine[[1,3]])
    )
  })

  output$w13_night <- renderValueBox({
    valueBox(
      "Ward 13", paste0(night_medicine[[2,3]], "/", night_medicine[[2,2]]), icon = icon("bed"),
      color = colour_empty_med_ward(night_medicine[[2,3]])
    )
  })

  output$w9_night <- renderValueBox({
    valueBox(
      "Ward 9", paste0(night_medicine[[3,3]], "/", night_medicine[[3,2]]), icon = icon("bed"),
      color = colour_empty_med_ward(night_medicine[[3,3]])
    )
  })
}