Search code examples
rshinycolorstagslabel

R/Shiny - updateNumericInput - How to change the color of the label, and paste a variable


With numericInpuT, to modify the color of a label in UI, I can use tags$span, but I'm not sure how to use tags$span with updateNumericInput if, at the same time, I'm adding a variable.

In the example below (modified from help("updateNumericInput")), I can change the color and font size of the label in UI. But when I try to follow the same procedure with updateNumericInput I get, instead, an [object Object] in the label. Various attempts to get it right can be seen commented out in the text. Could it be that 'label' in numericInput and in updateNumericInput are treated differently?

The reason to modify the color on the server side is that I need to include, in the label, some variable that I'm calculating, in this case represented by Sys.time().

In the end, what I need is the bottom label to look like the 3rd label ("Input number 3 ..."), but in the selected color (#00ffff).

Thank you

library(shiny)

ui <- fluidPage(
  sliderInput("controller", "Controller", 0, 20, 10),
  numericInput("inNumber", tags$span(style="color: #ff0000; font-size: 12px;","Input number"), 0),
  numericInput("inNumber2", tags$span(style="color: #00ff00; font-size: 12px;","Input number 2"), 0),
  numericInput("inNumber3", tags$span(style="color: #0000ff; font-size: 12px;","Input number 3"), 0),
  numericInput("inNumber4", tags$span(style="color: #0000ff; font-size: 12px;","Input number 4"), 0)
)

server <- function(input, output, session) {
  
  observeEvent(input$controller, {
    # We'll use the input$controller variable multiple times, so save it as x for convenience.
    x <- input$controller
    
    updateNumericInput(session, "inNumber", value = x)
    
    updateNumericInput(session, "inNumber2",
                     # label = paste("Number label ", x),
                       value = x, min = x-10, max = x+10, step = 5)
    
    updateNumericInput(session, "inNumber3",
                       label = paste0("Input number 3 (b&w) on ",Sys.time()),
                       value = x, min = x-10, max = x+10, step = 5)
    
    # --- Here it comes - Build the string to be used by tags$span

    xx1    = 'style="color: #00ffff; font-size: 12px;"'
    xx2    = paste0("Input number 4 ", Sys.time())
    xx_all = paste0(xx1,",","\"",xx2,"\"")                    # "style=\"color: #00ffff; font-size: 12px;\",\"Input number 4 2022-10-19 15:37:44\""
    
    updateNumericInput(session, "inNumber4",
                     # label = tags$span(style="color: #00ffff; font-size: 12px;","Input number 4 (color)"),
                     # label = tags$span("style=\"color: #00ffff; font-size: 12px;\",\"Input number 4 (color) \", 2022-10-19 14:59:13 EDT"),
                     # label = HTML(as.character(tags$span(xx_all))),
                       label = tags$span(as.character(HTML(xx_all))),
                       value = x, min = x-10, max = x+10, step = 5)
  })
}

shinyApp(ui, server)

Solution

  • The problem is that label only accept character at this moment, shiny.tag can not be processed. However, we can write some JS to make the character become HTML node.

    library(shiny)
    library(shinyjs)
    ui <- fluidPage(
        useShinyjs(),
        sliderInput("controller", "Controller", 0, 20, 10),
        numericInput("inNumber", tags$span(style="color: #ff0000; font-size: 12px;","Input number"), 0),
        numericInput("inNumber2", tags$span(style="color: #00ff00; font-size: 12px;","Input number 2"), 0),
        numericInput("inNumber3", tags$span(style="color: #0000ff; font-size: 12px;","Input number 3"), 0),
        numericInput("inNumber4", tags$span(style="color: #0000ff; font-size: 12px;","Input number 4"), 0),
        tags$script(
            "
            $('#inNumber4').on('shiny:updateinput', function(e){
                setTimeout(function(){$('#inNumber4-label').html($('#inNumber4-label').text())}, 0.1);
            });
            "
        )
    )
    
    server <- function(input, output, session) {
        
        observeEvent(input$controller, {
            x <- input$controller
            
            updateNumericInput(session, "inNumber", value = x)
            
            updateNumericInput(session, "inNumber2",
                               value = x, min = x-10, max = x+10, step = 5)
            
            updateNumericInput(session, "inNumber3",
                               label = paste0("Input number 3 (b&w) on ",Sys.time()),
                               value = x, min = x-10, max = x+10, step = 5)
            
            updateNumericInput(session, "inNumber4",
                               label = tags$span(
                                   style="color: #00ffff; font-size: 12px;", 
                                   paste0("Input number 4 (color) ", Sys.time())) |> 
                                     as.character(),
                               value = x, min = x-10, max = x+10, step = 5)
        })
    }
    
    shinyApp(ui, server)
    
    1. change the input to label as.character
    2. add a listener to watch for the input update of inNumber4
    3. When the event is triggered, the text is not updated immediately, we need to wait for a very tiny amount of time setTimeout(..., 0.1) before we can evaluate the text to become HTML

    enter image description here