Shiny - Change Background-color Of Htmloutput Conditionally

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

Solution 1:

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.

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

Solution 3:

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 optionvar e = document.getElementById("yours");
                     var strUser = e.options[e.selectedIndex].text;

                     //color changes according to countryif (strUser =="Poland") {
                        $("#sel").css({"background-color":"green"}) 
                     } elseif(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)