Value Boxes

[mattkumar]

Hello,

Me again. I remember reading somewhere (either here or on stack overflow) that people were interested in value or info boxes that are in the shinydashboard package. Using what you've provided us in the shinymaterial package, I've created a similar layout I hope other users can use. Please see the self-contained app below.

library(shiny) library(shinymaterial)

ui <- material_page( title = "Basic Page", tags$h1("Page Content"),

material_row( material_column(width=4, material_card(material_row(icon("user","fa-2x"), "All Customers", hr()), h3("5000"), depth=5)), material_column(width=4, material_card(material_row(icon("user-plus","fa-2x"), "New Customers", hr()), h3("20"), depth=5)), material_column(width=4, material_card(material_row(icon("user-times","fa-2x"), "Leaving Customers", hr()), h3("6"), depth=5)) ),

material_row( material_column(width=2, material_card(material_row(icon("chrome","fa-2x"), "Value Box 1", hr()), depth=5)), material_column(width=2, material_card(material_row(icon("firefox","fa-2x"), tags$style(".fa-firefox {color:#E87722}"), "Value Box 2", hr()), depth=5)), material_column(width=2, material_card(material_row(icon("github","fa-2x"), "Value Box 3", hr()), depth=5)), material_column(width=2, material_card(material_row(icon("youtube","fa-2x"), tags$style(".fa-youtube {color:#FF0000}"), "Value Box 4", hr()), depth=5)), material_column(width=2, material_card(material_row(icon("twitter","fa-2x"), "Value Box 5", hr()), depth=5)), material_column(width=2, material_card(material_row(icon("facebook","fa-2x"), tags$style(".fa-facebook {color:#0000FF}"), "Value Box 6", hr()), depth=5)) )
)

server <- function(input, output) {

} shinyApp(ui = ui, server = server)

[ericrayanderson]

Interesting idea, thanks for this. It could be as simple as a wrapper of the code you've given above. Will think about if this should be a feature or maybe something on the "showcase" page? (to give users ideas). Any thoughts?

[clairekaufman]

This was very helpful for me! However, I am having a hard time trying to color code the icon conditionally, based on value returned from some logic in the server portion. Any guidance would be appreciated. See the detail and reproducible example below.

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)

[ericrayanderson]

There is a reply to a similar question here: https://community.rstudio.com/t/how-to-conditionally-color-code-in-a-shinymaterial-app/9708/2