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

Question

我正在用R中的Shiny创建一个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) 

但是这种方法只显示格式的标签，在用户界面中的文本。使用Shiny的HTML()功能的解决方案似乎也不起作用，或者...我做错了。

任何想法？

下面是使用以上描述的方法（其不工作）一个简单的闪亮接口例如：

library("shiny") 

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

server = function(input, output) {} 

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

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

下一个例子的工作，但初始化复选框团时，它是一个解决方案。在服务器部分中启用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)) 

Answer 1

现在我找到了解决方案。不是很优雅，并且可能容易出错，但它很有效。我发现<和>字符被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))