时间戳

首页 > 解决方案 > 根据 shinydashboard 中的值创建动态 valueBox 颜色

r - 根据 shinydashboard 中的值创建动态 valueBox 颜色

问题描述

我想写一个闪亮的仪表板应用程序来反映医院的床位容量。在一些 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().

标签： rshinyshinydashboard

解决方案

你能做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]])
    )
  })
}

推荐阅读