CODEWITHSUNDEEP
rformattingshinylabelcheckboxlist
Anton
Anton

Reputation: 71

Change font markup (i.e. bold, italic) for checkboxGroupInput labels

I'm creating an web-app with Shiny in R. I have a dataset which I plot on the map. Using a checkboxGroupInput widget users are able to select categories they want to see on the map (or not). However, the dataset changes over time and not all categories are always available. To make clear which are available in the current set and which are not, I want to format the available categories as bold.

So far I've not been able to get a checkboxGroupInput widget to show with bold labels by the checkboxes. Is there a way to do that? I want some labels to be bold and others not. Also, using updateCheckboxGroupInput I'm able to change the options (i.e. show only available categories), but that not what I want/need.

I have tried for example:

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

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

But such an approach only displays the formatting tags as text in the user interface. Solutions using the HTML() function of Shiny doesn't seem to work either, or... I'm doing it wrong.

Any ideas?

Here is a simple Shiny interface example using the approach described above (which does not work):

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

The next example DOES work, but it is a solution when initializing the checkbox group. Enabling the observe function in the server part shows that the same solution does not work for updateCheckboxGroupInput. That makes sense, since that function does not return HTML code. I don't know how to access the output of that update function, or how to solve it otherwise.

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

Upvotes: 1

Views: 1719

Answers (1)

Anton
Anton

Reputation: 71

For now I found a solution. Not really elegant, and probably prone to errors, but it works. I found out that the < and > characters are escaped for HTML purposes by the htmltools function called escapeHtml. By temporarily replacing that function before the updateCheckboxGroupInput is called, by a dummy function, the text is not escaped. After the updateCheckboxGroupInput is called, htmlEscape of course needs to be restored.

An example that works. After launching the app, you need to check the first box to see it work:

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

Upvotes: 3

Related Questions