Patrick Balada Patrick Balada - 3 months ago 72
R Question

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

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

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.