Shiny - 根据条件更改 htmlOutput 的背景颜色

Question

我有一个 shiny 应用程序，它通过 htmlOutput 显示一个区域的名称。这些区域对应着 A/B/C 三个类别，基于类别是 A、B 还是 C，我想将 htmlOutput 的背景颜色设为 'red'、'blue' 或者 'green'。

我不知道如何有条件地改变背景颜色。我对 CSS 还比较新手。

到目前为止，我已经能够设置背景颜色，但无法通过以下代码在 ui.R 中更改它（其中 dist 是用于显示区域的 htmlOutput 标签）：

HTML('
          #dist{
                      background-color: rgba(255,0,255,0.9);
          }
    ')

以下是一个可复制的示例：

请见以下代码：

library(shiny)


ui <- fluidPage(
   titlePanel("Test App"),

   selectInput("yours", choices = c("India", "Malaysia","Russia","Poland", "Hungary"), label = "Select Country:"),
  absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE, 
                style="padding-left: 8px; padding-right: 8px; padding-top: 8px; padding-bottom: 8px",
                draggable = TRUE, top = 126, left = "auto", right = 20, bottom = "auto",
                width = 250, height = "auto",
     htmlOutput("sel"), br(),htmlOutput("sel2")
   )
)

server <- function(input, output){
  catg<- c("A","A","B","C","A")
  country <- c("India", "Malaysia","Russia","Poland", "Hungary")
  countries <- data.frame(catg,country)

  output$sel <- renderText({
    paste0("Change my background color and of the text to my right based on variable catg:",input$yours,"-", countries$catg[countries$country==input$yours])
  })

  output$sel2 <- renderText({
    paste0("DON'T change my background color:", countries$catg[countries$country==input$yours])
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

这里有两个输出变量 - sel，sel2。我想根据变量"catg"改变sel的背景颜色，即如果catg=="A"，则为#sel背景颜色为红色，如果catg == "B"，则为背景颜色为蓝色等。

- ProgSnob

---

您需要添加一个最小可重现的示例。人们需要测试代码以查看其是否有效。没有人会愿意花时间去创建示例（尤其是对于一个闪亮的应用程序而言）。 - LyzandeR

@LyzandeR 我现在已经添加了一个可重现的示例。 - ProgSnob

Answer 1

您可以通过在服务器端使用renderUI函数创建htmlOutput，并将颜色列添加到数据集中并在CSS中创建三个变量类来实现此目的。这样做是可以实现的，但我个人会使用单独的CSS文件，并在全局、ui和服务器文件之间分割R代码。

library(shiny)

catg<- c("A","A","B","C","A")
country <- c("India", "Malaysia","Russia","Poland", "Hungary")
colour <- c("sel-green", "sel-green","sel-red","sel-blue", "sel-green")
countries <- data.frame(catg,country, colour)

ui <- fluidPage(

tags$head(
    tags$style(

        # Colorize the actionButton.
        HTML(
            '
            .sel-green{
            background-color:#7FFF00;
            }

            .sel-red{
            background-color:#DC143C;
            }

            .sel-blue{
            background-color:#0000FF;
            }
            '
        )
        )
        ), 

titlePanel("Test App"),

selectInput("yours", choices = c("India", "Malaysia","Russia","Poland", "Hungary"), label = "Select Country:"),
absolutePanel(id = "controls", class = "panel panel-default", fixed =     TRUE, 
              style="padding-left: 8px; padding-right: 8px; padding-top: 8px; padding-bottom: 8px",
              draggable = TRUE, top = 126, left = "auto", right = 20, bottom = "auto",
              width = 250, height = "auto",
              uiOutput("textBox", width = 10),
              br(),
              htmlOutput("sel2")
)
)

server <- function(input, output){

observe({

backgroundColour <<- as.character(countries$colour[countries$country==input$yours])

output$sel <- renderText({
    paste0("Change my background color and of the text to my right based on variable catg:",input$yours,"-", countries$catg[countries$country==input$yours])
})

output$sel2 <- renderText({
    paste0("DON'T change my background color:", countries$catg[countries$country==input$yours])
})

output$textBox <- renderUI({
    htmlOutput("sel", class=backgroundColour)
})

})
}

# Run the application 
shinyApp(ui = ui, server = server)

希望这些能够在一定程度上帮助到你。

- LuckySeedling

Answer 2

您可以在 renderText 中的文本周围添加一个额外的 div ，并使用内联CSS设置背景颜色：

  output$sel <- renderText({
    background_color = color_code[countries$catg[countries$country==input$yours],"color"]
    HTML(paste0("<div style='background-color:",background_color,"'>",
      paste0("Change my background color and of the text to my right based on variable catg:",input$yours,"-", countries$catg[countries$country==input$yours]),
      "</div>"))
  })

我在你的应用程序顶部添加了一个查找表，以确定每个国家对应的颜色：

color_code = data.frame(catg=c("A","B","C"),color=c("red","blue","green"))

- NicE

Answer 3

我认为对于这些事情，最佳实践需要一些JavaScript（它也非常好，因为它可以推广到很多事情），这可以很容易地实现。毕竟，这就是为什么在shiny上存在shiny:inputchanged的原因。

ui

我在这里添加的唯一内容是JavaScript函数（带有注释）以及一些CSS来将sel id初始化为红色，因为印度是最初选择的值。

ui <- 
 fluidPage(
  tags$head(HTML('
                <script>
                //shiny:inputchanged runs the function when an event is changed
                $(document).on("shiny:inputchanged", function(event) {

                   //in this case the event is <yours>
                   if (event.name === "yours") {

                     //var strUser gets the selected option
                     var e = document.getElementById("yours");
                     var strUser = e.options[e.selectedIndex].text;

                     //color changes according to country
                     if (strUser == "Poland") {
                        $("#sel").css({"background-color":"green"}) 
                     } else if(strUser == "Russia") {
                        $("#sel").css({"background-color":"blue"}) 
                     } else {
                        $("#sel").css({"background-color":"red"}) 
                     }
                   }
                 });

                </script>
                ')),
  tags$head(tags$style('#sel {background-color: red;')),
  titlePanel("Test App"),
  selectInput("yours", choices = c("India", "Malaysia","Russia","Poland", "Hungary"), 
              label = "Select Country:"),
  absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE, 
          style="padding-left:8px;padding-right:8px;padding-top:8px;padding-bottom:8px",
                draggable = TRUE, top = 126, left = "auto", right = 20, bottom = "auto",
                width = 250, height = "auto",
                htmlOutput("sel"), br(),htmlOutput("sel2")
  ))

注意：最佳实践是将JavaScript代码添加到.js文件中，并使用includeScript将其添加到UI中。

服务器

这里没有改变任何内容。

server <- function(input, output){
 catg<- c("A","A","B","C","A")
 country <- c("India", "Malaysia","Russia","Poland", "Hungary")
 countries <- data.frame(catg,country)

 output$sel <- renderText({
  paste0("Change my background color and of the text to my right based on variable catg:",
         input$yours,"-", 
         countries$catg[countries$country==input$yours])
 })

 output$sel2 <- renderText({
  paste0("DON'T change my background color:",
         countries$catg[countries$country==input$yours])
 })
}

运行应用程序

shinyApp(ui = ui, server = server)

- LyzandeR

---

谢谢。我会研究一下，因为我正在使用一个大量依赖JS库-leaflet的应用程序。 - ProgSnob

非常欢迎！我猜这使它成为一个更好的解决方案候选者 :)。 - LyzandeR