non-standard evaluation to update a format with updateInputSlider: bug?

Question

I have a shiny application that has a functionnality to translate its text between several languages, by using some RenderText and an ActionButton to toggle between languages. Here is my app:

library(shiny)
trads = list(text3=list("text3 in language 1", "text in other language"),
             titl3=list("widget label in language 1", "widget label in other language"))

ui <- fluidPage(
  actionButton("language",label="language", icon=icon("flag")),
  htmlOutput("text3", container = tags$h3),
  sliderInput("slider1", label=h2("slider1"), 0, 10, 5)
)

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


     tr <- function(text){sapply(text, function(s) trads[[s]][[input$language%%2+1]], USE.NAMES=FALSE)}

     output$text3 = renderText({tr("text3")})

     observeEvent(input$language, {
          updateSliderInput(session, "slider1", label=tr("titl3"))
     })

}

shinyApp(ui, server)

It works fine except that my slider label was formatted initially with a html tag h3(), and when I use updatesliderinput I loose this tag and it returns to plain text. I tried adding the tag in the translation with paste0, or different syntax with eval but it prints in text the result of the paste instead of running it or gives an error. Any ideas to translate while keepping the format? Thanks

Note: I have the same problem with one text containing a URL link..

Answer 1

it really seams you have found a bug in updateSliderInput here. It can only handle pure strings and no HTML tags. As a work around would I recommend you to add something like this to the beginning of your UI

tags$head(
    tags$style(
      'label[for = "slider1"] {
    color: red;
    font-size: 20px;
    }'
    )
  )

but change the css to what ever you like (maybe copy the css rules for the h2 tag) and then always only pass a string to the label parameter. This way the styling always stays the same.

my complete code

library(shiny)
trads = list(text3=list("text3 in language 1", "text in other language"),
             titl3=list("widget label in language 1", "widget label in other language"))

ui <- fluidPage(
  tags$head(
    tags$style(
      'label[for = "slider1"] {
    color: red;
    font-size: 20px;
    }'
    )
  ),
  actionButton("language",label="language", icon=icon("flag")),
  htmlOutput("text3", container = tags$h3),
  sliderInput("slider1", label="slider1", 0, 10, 5)

)

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


  tr <- function(text){sapply(text, function(s) trads[[s]][[input$language%%2+1]], USE.NAMES=FALSE)}

  output$text3 = renderText({tr("text3")})

  observeEvent(input$language, {
    updateSliderInput(session, "slider1", label=tr("titl3"))
  })

}

shinyApp(ui, server)

hope this helps!