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