Shiny in R: Is it possible to output a color using renderText?

Question

I am trying to create a box using the package shinydashboard. I cannot create it on the server-side (this is another issue but on my question). However, I wanted to set the color dynamically and was wondering if it is somehow possible by using renderText. I have now a renderText on the server side, which outputs either NULL or the color "maroon". However, this gives me the following error:

Warning: Error in validateColor: Invalid color

Do you know what the problem is or have a different approach? Any help is very much appreciated!

Answer 1

In short, there's no way to directly change the color using renderText but there's plenty of ways of changing colors of text dynamically.

To mention a few ways, you could:

Use CSS classes and toggle between them:

require(shiny)
require(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    tags$head(
      tags$style(
        HTML("
              .toggle{
                color: red;
              }
             ")
        ),
      tags$script(
        HTML("
          Shiny.addCustomMessageHandler ('toggleClass',function (m) {
                  var element = $('#'+m.id); // Find element to change color of
                  element.toggleClass('toggle');
          });
             ")
      )
    ),
    fluidRow(
      box( id='test',
           title = "Box",
           status = "warning",
           solidHeader = TRUE,
           height = 400,
           textOutput('txtOut')
      )
    ),
    actionButton('btn','Generate Color')
  ) #end dashboardBody
)

server <- function(input, output, session) {

  # Helper function, calls javascript
  toggleClass <- function(id){
    session$sendCustomMessage(type = 'toggleClass', message = list('id'=id))
  }

  output$txtOut <- renderText({ "Static text" }); # Text can be re-rendered independantly

  observeEvent(input$btn,{
    toggleClass('txtOut') # Add  / remove class
  })

}
shinyApp(ui, server)

Use Javascript bindings to change color of elements (probably the most powerful method):

   require(shiny)
   require(shinydashboard)

    ui <- dashboardPage(
      dashboardHeader(title = "Basic dashboard"),
      dashboardSidebar(),
      dashboardBody(
        tags$head(
          tags$script(
            HTML("
              // Change color inside of element with supplied id
              Shiny.addCustomMessageHandler ('changeTxtColor',function (m) {
                      var element = $('#'+m.id); // Find element to change color of
                      element.css({ 'color': 'rgb('+m.r+','+m.g+','+m.b+')' }); // Change color of element
              });

              // Change color of shinydashboard box
              Shiny.addCustomMessageHandler ('changeBoxColor',function (m) {
                      var parent  = $('#'+m.id).closest('.box');
                      var element = parent.children('.box-header');
                      var rgbStr  = 'rgb('+m.r+','+m.g+','+m.b+')';
                      element.css({ 'background-color':  rgbStr});
                      parent.css({ 'border-color' :  rgbStr})
              });
                ")
          )
        ),
        fluidRow(
          box( id='test',
            title = "Box",
            status = "warning",
            solidHeader = TRUE,
            height = 400,
            textOutput('txtOut'),
            div(id='target') 
            # Since you can't specify the id of shinydashboard boxes
            # we need a child with id to change the color of the box.
          )
        ),
        actionButton('btn','Generate Color')
      )
    )

    server <- function(input, output, session) {

      randomColor <- reactive({
        input$btn
        name <- sample(colors(),1)
        rgb  <- col2rgb(name)
        return( list(name=name, rgb=rgb) )
      })

      # Helper function, calls javascript
      changeTxtColor <- function(id,rgb){
        session$sendCustomMessage(type = 'changeTxtColor', message = list('id'=id,'r'=rgb[1],'g'=rgb[2],'b'=rgb[3]))
      }
      changeBoxColor <- function(id,rgb){
        session$sendCustomMessage(type = 'changeBoxColor', message = list('id'=id,'r'=rgb[1],'g'=rgb[2],'b'=rgb[3]))
      }

      output$txtOut <- renderText({
        rgb <- randomColor()$rgb
        changeTxtColor('txtOut',rgb)
        changeBoxColor('target',rgb)
        sprintf("Generated color with name %s ", randomColor()$name)
      })

    }
    shinyApp(ui, server)

Simply output HTML instead of using renderText, allowing for precise control of the HTML produces see this question:

require(shiny)
require(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      box( id='test',
           title = "Box",
           status = "warning",
           solidHeader = TRUE,
           height = 400,
           htmlOutput('txtOut')
      )
    ),
    actionButton('btn','Generate Color')
  ) #end dashboardBody
)

server <- function(input, output, session) {

  # Reactive variable
  randomColor <- reactive({
    input$btn
    name <- sample(colors(),1)
    rgb  <- col2rgb(name)
    return( list(name=name, rgb=rgb) )
  })

  # Helper function, calls javascript
  toggleClass <- function(id){
    session$sendCustomMessage(type = 'toggleClass', message = list('id'=id))
  }

  output$txtOut <- renderUI({
    rgb    <- randomColor()$rgb
    rgbStr <- sprintf('rgb(%d,%d,%d)',rgb[1],rgb[2],rgb[3])
    print(rgb)
    div( HTML(sprintf("<text style='color:%s'> Generated color with name %s </text>", rgbStr, randomColor()$name) ) )
  })

}
shinyApp(ui, server)

Sorry for the text volume.