更改checkboxGroupInput标签的字体标记（即粗体、斜体）

我正在创建一个在R中有光泽的web应用程序。我有一个数据集，我在地图上绘制。使用checkboxGroupInput小部件，用户可以选择他们想在地图上看到（或不想看到）的类别。但是，数据集会随着时间的推移而变化，并非所有类别都始终可用。为了弄清楚当前集合中哪些可用，哪些不可用，我想将可用类别的格式设置为粗体

到目前为止，我还无法获得一个通过复选框显示粗体标签的

checkboxGroupInput

小部件。有办法吗？我希望一些标签是粗体的，而另一些不是。此外，使用

updateCheckboxGroupInput

我可以更改选项（即仅显示可用类别），但这不是我想要/需要的

例如，我尝试过：

x <- list("<b>A</b>"=1, "<b>B</b>"=2, "C"=3)

checkboxGroupInput(inputId="test", label="this is a test", choices=x)

下一个示例确实有效，但在初始化复选框组时它是一个解决方案。在服务器部件中启用

observe

功能表明相同的解决方案不适用于

updateCheckboxGroupInput

。这是有道理的，因为该函数不返回HTML代码。我不知道如何访问更新函数的输出，或者如何解决它

library("shiny")

x <- list("<b>A</b>"=1, "<b>B</b>"=2, "C"=3)
y <- list("<b>D</b>"=1, "<b>E</b>"=2, "F"=3)

server = function(input, output, session) {
    # observe({
        # input$test
        # gsub("&gt;", ">", gsub("&lt;", "<", updateCheckboxGroupInput(session, "test", choices=y)))
    # })
}

ui = fluidPage(
    gsub("&gt;", ">", gsub("&lt;", "<", checkboxGroupInput(inputId="test", label="this is a test", choices=x)))
)

runApp(list(ui = ui, server = server))

库（“闪亮”）
现在我找到了一个解决办法。不是很优雅，可能容易出错，但它可以工作。我发现
htmltools
函数名为
escapeHtml
，用于HTML目的，对字符进行了转义。在调用
updateCheckboxGroupInput
之前，通过伪函数临时替换该函数，文本不会转义。调用
updateCheckboxGroupInput
后，
htmlEscape
当然需要恢复

一个有效的例子。启动应用程序后，您需要选中第一个框以查看它是否正常工作：

library("shiny")

x <- list("<b>A</b>"=1, "<b>B</b>"=2, "C"=3)
y <- list("<b>D</b>"=1, "<b>E</b>"=2, "F"=3)

server = function(input, output, session) {
    observe({
        value <- input$test

        if (length(value) > 0 && value == 1) {
            ## save htmlEscape function and replace htmlEscape
            saved.htmlEscape <- htmltools::htmlEscape
            assignInNamespace("htmlEscape", function(x, attribute) return(x), "htmltools")

            updateCheckboxGroupInput(session, "test", label="OK", choices=y)

            ## restore htmlEscape function
            assignInNamespace("htmlEscape", saved.htmlEscape, "htmltools")
        }
    })
}

ui = fluidPage(
    checkboxGroupInput(inputId="test", label="this is a test", choices=x)
)

runApp(list(ui = ui, server = server))

库（“闪亮”）
现在我找到了一个解决办法。不是很优雅，可能容易出错，但它可以工作。我发现
htmltools
函数名为
escapeHtml
，用于HTML目的，对字符进行了转义。在调用
updateCheckboxGroupInput
之前，通过伪函数临时替换该函数，文本不会转义。调用
updateCheckboxGroupInput
后，
htmlEscape
当然需要恢复

一个有效的例子。启动应用程序后，您需要选中第一个框以查看它是否正常工作：

library("shiny")

x <- list("<b>A</b>"=1, "<b>B</b>"=2, "C"=3)
y <- list("<b>D</b>"=1, "<b>E</b>"=2, "F"=3)

server = function(input, output, session) {
    observe({
        value <- input$test

        if (length(value) > 0 && value == 1) {
            ## save htmlEscape function and replace htmlEscape
            saved.htmlEscape <- htmltools::htmlEscape
            assignInNamespace("htmlEscape", function(x, attribute) return(x), "htmltools")

            updateCheckboxGroupInput(session, "test", label="OK", choices=y)

            ## restore htmlEscape function
            assignInNamespace("htmlEscape", saved.htmlEscape, "htmltools")
        }
    })
}

ui = fluidPage(
    checkboxGroupInput(inputId="test", label="this is a test", choices=x)
)

runApp(list(ui = ui, server = server))

库（“闪亮”）
x