Search code examples
rshinyshinywidgets

Label does not display for sliderTextInput


I am using the sliderTextInput widget from the shinyWidgets package. The slider works fine, but my label for the slider is not displayed. Instead of my label, "[object Object]" is displayed. How can I correct this problem? Here is my reprex.

# reprex for slider problem
library(shiny)
library(shinyWidgets)

dateD <- seq.Date(as.Date("2017-01-01"),
    Sys.Date()-1,by="day")
dateC <- character()
for (i in 1:length(dateD)) {
    dateC[i] <- format(dateD[i],"%b %d, %Y")
}
strtRang <- c(dateC[1],dateC[length(dateC)])

ui <- fluidPage(
    sliderTextInput("Dates",
        label="Choose starting and ending dates:",
        choices=dateC,
        selected=strtRang,
        dragRange = TRUE,
        width="100%")
)
server <- function(input, output,session) {
    observe({
        updateSliderTextInput(session,inputId="Dates",
            tags$b(tags$span(style="color:blue",
            label="Choose starting and ending dates:")),
            choices = dateC,
            selected=strtRang)
    })
}
shinyApp(ui, server)

Solution

  • The reason is label is expecting a string but not a shiny.tag class object. Even if you provide the HTML string, like <b>xxxxx</b>, it will still not work, because the creator of this function did not allow you to input HTML, only string. What string you provide will be what you see, no HTML parsing.

    If you want to add color and font weight dynamically, do this:

    # reprex for slider problem
    library(shiny)
    library(shinyWidgets)
    library(shinyjs)
    dateD <- seq.Date(as.Date("2017-01-01"),
                      Sys.Date()-1,by="day")
    dateC <- character()
    for (i in 1:length(dateD)) {
      dateC[i] <- format(dateD[i],"%b %d, %Y")
    }
    strtRang <- c(dateC[1],dateC[length(dateC)])
    
    ui <- fluidPage(
      shinyjs::useShinyjs(),
      sliderTextInput("Dates",
                      label='Choose starting and ending dates:',
                      choices=dateC,
                      selected=strtRang,
                      dragRange = TRUE,
                      width="100%")
    )
    server <- function(input, output, session) {
      observe({
        updateSliderTextInput(session,inputId="Dates",
                              label = "Choose starting and ending dates aaaa:",
                              choices = dateC,
                              selected=strtRang)
        shinyjs::runjs("$('.shiny-input-container:has(input[id=\"Dates\"]) > label').css({fontWeight: 900, color: 'blue'})")
      })
      
    }
    shinyApp(ui, server)
    

    If the style does not need to be set dynamically, easier:

    ui <- fluidPage(
      sliderTextInput("Dates",
                      label='Choose starting and ending dates:',
                      choices=dateC,
                      selected=strtRang,
                      dragRange = TRUE,
                      width="100%"),
      tags$script(HTML("$('.shiny-input-container:has(input[id=\"Dates\"]) > label').css({fontWeight: 900, color: 'blue'})"))
    )
    server <- function(input, output, session) {
    }
    shinyApp(ui, server)