Shiny - Change background-color of htmlOutput conditionally

Question

I have a shiny-app which is displaying name of a District through htmlOutput. Now these districts have a corresponding category - A/B/C, and based on whether category==A,B,C I want to set background-color of htmlOutput to 'red','blue','green'.

I don't know how to conditionally change background-color. I'm fairly new to CSS.

So far, I've been able to set the background-color but not change it by using the code below in ui.R (where dist is the tag used for htmlOutput displaying district):

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

Reproducible example below:

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)

Here we have two output variables - sel, sel2 I want to change background-color of sel based on variable "catg", i.e. give #sel background-color:red if catg=="A", background-color:blue; if catg=="B", etc.

Answer 1

I think for these kind of things best practice requires some JavaScript (it is also really good to know this one because it can be generalised for so many things), which can be implemented quite easily. After all, this is the reason shiny:inputchanged exists on shiny.

ui

The only thing I added here is the JavaScript function (with comments) and also some CSS to initiate the sel id as red, because India is the initially selected value.

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")
  ))

Note: Best practice here would be to add the JavaScript code in a .js file and add that with includeScript in the ui.

server

Didn't change anything here.

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 app

shinyApp(ui = ui, server = server)

Answer 2

You can wrap the text in the renderText in an extra div and set the background color with inline 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>"))
  })

I added a lookup table at the top of your app to figure out which color goes with each country:

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

Answer 3

You can achieve this by creating your htmlOutput within server using the renderUI function and by adding a colour column to your dataset and creating three variable classes in the CSS. This works but personally I would use a separate CSS file and have the R code split between global, ui and server files.

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)

Hope this goes someway towards helping.