Нестандартная оценка для обновления формата с updateInputSlider: ошибка?

Question

У меня есть блестящее приложение, которое имеет функциональность для перевода своего текста между несколькими языками, используя некоторые RenderText и ActionButton для переключения между языками. Вот мое приложение:

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)

Он работает нормально, за исключением того, что моя метка слайдера изначально была отформатирована с тегом html h3()и когда я использую updatesliderinput Я теряю этот тег, и он возвращается к простому тексту. Я попытался добавить тег в переводе с paste0или другой синтаксис с eval но он печатает в тексте результат вставки вместо его запуска или выдает ошибку. Какие-нибудь идеи, чтобы перевести, поддерживая формат? Спасибо

Примечание: у меня та же проблема с одним текстом, содержащим ссылку URL.

Answer 1

Это действительно швы, вы нашли ошибку в updateSliderInput Вот. Он может обрабатывать только чистые строки и без тегов HTML. В качестве обходного пути я бы порекомендовал вам добавить что-то подобное в начало вашего интерфейса.

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

но измените css на то, что вам нравится (возможно, скопируйте правила css для тега h2), а затем всегда передавайте только строку в параметр label. Таким образом, стиль всегда остается неизменным.

мой полный код

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)

надеюсь это поможет!