Создать цвет Dynami c ValueBox на основе значений в Shinydashboard - PullRequest
Новая
       21

Создать цвет Dynami c ValueBox на основе значений в Shinydashboard

0 голосов
/ 25 апреля 2020

Я хочу написать приложение для Shinydashboard, чтобы отразить вместимость койки в больнице. В некоторых полях valueBox я хотел бы, чтобы цвет рамки менялся в зависимости от количества пустых кроватей (от зелено-оранжево-красного).

Я пытался написать реактивный объект, но, похоже, не могу получить цвет, чтобы отражать значение так, как я хотел. 

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().

1 Ответ

1 голос
/ 25 апреля 2020

Не могли бы вы сделать 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]])
    )
  })
}
...