Shiny：在 select 輸入選項上添加 hover 按鈕

Question

問題：我正在嘗試將“懸停文本”添加到 shiny 中的 select 輸入/多輸入 function 中的可用選項中。 根據另一位用戶的說法，ShinyBS 的工具提示 function 僅設計用於按 id 選擇。 因此，我試圖使用比這更好的東西來實現我的結果。

這是我正在嘗試修改的絕佳解決方案。 該解決方案涉及創建一個名為selectizeInput的新 function ：（根據函數的創建者）

“[] 移動選項，重新呈現它們，僅在它們第一次顯示時呈現它們等等。很多事情都會發生。這就是為什么這個解決方案會抓取周圍的 div 並不斷監聽正在添加的子節點。”

我不太了解 function 發生了什么，但這里是一些可重現代碼的示例。 包括上面提到的用戶 function selectizeInput 。 如您所見，我正在嘗試使用此 function 在我的multiInput中添加 hover 文本。 我想添加功能，以便當將鼠標懸停在“第 1 組”上時，會彈出“第 1 組定義”文本。

我願意使用完全不同的解決方案來添加此功能！

我嘗試過的：非常感謝任何建議，我最好使用 multiInput。 但是，將多個設置為 TRUE 的 selectInput 也是一個很好的解決方法。 當我這樣做時，還會出現其他一些問題。

1. 一旦我選擇了select，剩下的選項的標簽就不顯示了。 例如，當我 select 第 1 組和第 3 組時，當我在 hover 上看到第 2 組的 label 時，我看不到它。

2. 包含 label 的文本框（在下拉列表中）非常狹窄——不容易閱讀定義

3. 選擇后，定義將部分隱藏

這是我的代碼：

     library(shiny)
     library(shinyBS)
    
     selectizeTooltip <- function(id, choice, title, placement = "bottom", trigger = "hover", options = NULL){
    
       options = shinyBS:::buildTooltipOrPopoverOptionsList(title, placement, trigger, options)
       options = paste0("{'", paste(names(options), options, sep = "': '", collapse = "', '"), "'}")
       bsTag <- shiny::tags$script(shiny::HTML(paste0("
         $(document).ready(function() {
           var opts = $.extend(", options, ", {html: true});
           var selectizeParent = document.getElementById('", id, "').parentElement;
           var observer = new MutationObserver(function(mutations) {
             mutations.forEach(function(mutation){
               $(mutation.addedNodes).filter('div').filter(function(){return(this.getAttribute('data-value') == '", choice, "');}).each(function() {
                 $(this).tooltip('destroy');
                 $(this).tooltip(opts);
               });
             });
           });
           observer.observe(selectizeParent, { subtree: true, childList: true });
         });
       ")))
       htmltools::attachDependencies(bsTag, shinyBS:::shinyBSDep)
     }
    
    
     ui <- fluidPage(theme = shinytheme("superhero"),  # shinythemes::themeSelector(), #
    
    
                     br(),
                     br(),
                     headerPanel(h2(" ", align = 'center')),
                     br(),
                     sidebarLayout(
                       sidebarPanel(
                         uiOutput("choose_prog"),
    
                         uiOutput("choose_name"),
                         br(),
                         selectizeTooltip(id="choose_name", choice = "group 1", title = "group 1 definition this is a long definition that does not really display well within the narrow text box", placement = "right", trigger = "hover"),
                         selectizeTooltip(id="choose_name", choice = "group 2", title = "group 2 definition this is another long definition. WHen group 1 and group 3 is is selected, you no longer see this definition", placement = "right", trigger = "hover"),
                         selectizeTooltip(id="choose_name", choice = "group 3", title = "group 3 definition this does not show if all of the other groups are selected ", placement = "right", trigger = "hover"),
    
    
                       ),
    
                       mainPanel(
                         plotOutput("plot"),
                       )
                     )
    
     )
    
     server <- function(input, output) {
    
       # Drop down selection to chose the program 
       output$choose_prog <- renderUI({
         selectInput("program", 
                     label = HTML('<FONT color="orange"><FONT size="4pt">Select a Program:'),
                     choices = c("A","B","C"))
       })
    
    
       # Drop down for name
       output$choose_name <- renderUI({
    
         # SelectInput works, but this only allows the selection of a SINGLE option
         selectInput("names",
                    label = HTML('<FONT color="orange"><FONT size="4pt">Select user group of interest:'),
                    choices = c("group 1", "group 2", "group 3"), 
                    multiple = T)
    
    
         # multiInput("names", 
         #            label = HTML('<FONT color="orange"><FONT size="4pt">Select user group of interest:'),
         #            choices = c("group 1", "group 2", "group 3"))
         # 
    
    
       })
    
       observeEvent(input$choose_name, {
         updateSelectizeInput(session, "choose_name", choices =  c("group 1", "group 2", "group 3"))
       })
     }
    
     shinyApp(ui = ui, server = server)

Answer 1

像這樣的東西？

library(shiny)

shinyApp(
  ui = fluidPage(
    br(),
    selectizeInput(
      "slctz", "Select something:",
      choices = NULL, 
      options = list( 
        options = list(
          list(label = "Choice 1", value = "value1", tooltip = "tooltip1"),
          list(label = "Choice 2", value = "value2", tooltip = "tooltip2")
        ),
        #items = list("Option 1"),
        valueField = "value", 
        labelField = "label",
        render = I("{
      item: function(item, escape) { 
        return '<span>' + item.label + '</span>'; 
      },
      option: function(item, escape) { 
        return '<span title=\"' + item.tooltip + '\">' + item.label + '</span>'; 
      }
    }")
      )
    )
  ),
  server = function(input, output) {}
)