How to conditionally color code in a shinymaterial app

shiny
1

I came across the shinymaterial package, which creates apps that look nice and it seems very simple to implement. I am transitioning an app from shinydashboard to shinymaterial.

However, shinydashboard does not include a built-in option to create an infoBox like there is within shinydashboard.

With some searching, I found this post on GitHub, which worked easily to create similar value boxes!

I was able to copy this code to also add the desired color. However, where I am running into a problem, is how to conditionally change the color of the icon based on a value.

What I am currently doing that seems like it should work is this.

Here's the code that works to assign a specific (non-dynamic) color to the icon within the ui:

material_column(width=4, material_card(
    material_row(icon("ambulance","fa-2x"), tags$style(".fa- 
    ambulance{color:#ff0000}"), "LTI Rate", hr()), h3(textOutput("LTIRate")), 
    depth=5))),

Now to determine the color that should be displayed, I have created this code on the server side:

output$OSHAColor <- renderText({

   LTI_Rate <- inj_dmg_stn %>%
   filter(Location == input$STATION) %>%
   select(`LTI Rate`)

   LTI_Target <- inj_dmg_stn %>%
   filter(Location == input$STATION) %>%
   select(`LTI Target`)

   ifelse(LTI_Rate <= LTI_Target, sprintf('".fa-medkit 
   {color:%s}"','#228B22'), 
   sprintf('".fa-medkit {color:%s}"','#FF00000'))

   })

To test what this is really outputting, I have displayed it three ways in the ui, using the following code:

material_row(paste(textOutput("OSHAColor")), 
    HTML(paste(textOutput("OSHAColor"))), textOutput("OSHAColor"))

The first outputs as the HTML string (starting with ...<div id="OSHAColor" class="...), which is not what I want. The second and third output as desired for the shiny tag string I am trying to pass to shiny$tags (".fa-medkit {color: #228B22}").

When I try use use either of those two options in tags$style for my icon like this:

tags$style(HTML(paste(textOutput("OSHAColor"))))

I get a black icon, instead of red or green, meaning the color or tags$style parameter was not recognized.

I thought this post might help me, but I tried and I'm not sure I can create the whole icon on the server side.

Lastly, here is a reproducible example:

library(shiny)
    library(shinymaterial)

    ## shinymaterial infobox reference site
    ## https://github.com/ericrayanderson/shinymaterial/issues/31

    data <- as.data.frame(1.0)
    colnames(data) <- c('Rate')


    ui <- material_page(

      title = "Reproducible Example",

      material_card(
        title = tags$b("INJURIES"),
        material_row(
          material_column(width=4,         
      material_card(material_row(icon("medkit","fa-2x"),         
        tags$styleHTML(paste(textOutput("Color")))), "Rate", hr()), 
        h3(textOutput("ARate")), depth=5)),
        material_column(width=4, 
      material_card(material_row(icon("ambulance","fa-2x"), tags$style(".fa- 
        ambulance {color:#ff0000}"), "Rate", hr()), h3(textOutput("Rate")), 
        depth=5))),
         material_row(paste(textOutput("Color")), 
         HTML(paste(textOutput("Color"))))
      )

    )

    server <- function(input, output) {

      ## Rate ##
      output$Rate <- renderText({as.character(sprintf("%.2f",round(

        data[1,1]
        ,2))

      )})

      ## Color ##
      output$Color <- renderText({

        ifelse(data[1,1] <= 4.0, as.character(sprintf('".fa-medkit         
        {color:%s}"','#228B22')), as.character(sprintf('".fa-medkit 
        {color:%s}"','#FF00000')))

      })

    }

    shinyApp(ui = ui, server = server)

Any suggestions would be greatly appreciated.

1 Like
2

In order to change the color, I think you are going to need some JavaScript, as shinymaterial has no built in way to do this currently. The other solution would be to do as you suggested - created the icon on the server side. This may not actually be too complex, I put a reproducible example below:

library(shiny)
library(shinymaterial)

ui <- material_page(
  title = "Reproducible Example",
  material_row(
    material_column(
      width = 2,
      material_radio_button(
        input_id = "color", 
        label = "Color",
        choices = c("red", "blue")
      )
    ),
    material_column(
      width = 2,
      material_card(
        material_row(
          uiOutput('ambulanceIcon')
        )
      )
    )
  )
)

server <- function(input, output) {
  
  output$ambulanceIcon <- renderUI({
    
    if(input$color == "red") {
      styleTag <- "color:red"
    } else if(input$color == "blue"){
      styleTag <- "color:blue"
    }
    
    tags$span(
      style = styleTag, 
      icon("ambulance", "fa-2x")
    )
    
  })
}

shinyApp(ui = ui, server = server)