滑块文本输入的标签不显示

Question

我正在使用来自 shinyWidgets 包的 sliderTextInput 小部件。滑块工作正常，但我的滑块标签未显示。代替我的标签，显示“[object Object]”。我该如何纠正这个问题？这是我的代表。

# 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)

Answer 1

原因是label 需要一个字符串，而不是shiny.tag 类对象。即使你提供了 HTML 字符串，比如<b>xxxxx</b>，它仍然不起作用，因为这个函数的创建者不允许你输入 HTML，只能输入字符串。您提供的字符串将是您所看到的，没有 HTML 解析。

如果要动态添加颜色和字体粗细，请执行以下操作：

# 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)

如果样式不需要动态设置，更简单：

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)