更改checkboxGroupInput标签的字体标记(即粗体,斜体)

时间:2016-03-02 19:43:29

标签: r formatting shiny labels checkboxlist

我正在使用Shiny in R创建一个网络应用程序。我有一个数据集,我在地图上绘制。使用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()函数的解决方案似乎也不起作用,或者......我做错了。

有什么想法吗?

这是一个简单的Shiny接口示例,使用上述方法(不起作用):

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

1 个答案:

答案 0 :(得分:0)

现在我找到了解决方案。不是很优雅,可能容易出错,但它确实有效。我发现&lt;和&gt;由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))