Shiny: Add a hover button on select input choice

Question

The problem: I am trying to add 'hover text' to the choices available in the select input/multi input function in shiny. According to a different user, ShinyBS's tooltip function is only designed for selection by id. Thus, I am trying to use something finer than that to achieve my outcome.

This is great solution that I am trying to modify. The solution involves creating a new function called selectizeInput: (according to the creator of the function)

"[] moves the choices around, renders them anew, renders them only when they are first shown and so on. A lot of things happen. This is why this solution grabs the surrounding div and listens constantly to childNodes being added."

I don't really understand a lot of what is going on with the function, but here is an example of some reproducible code. Included is the user function selectizeInput referenced above. As you can see, I am trying to use this function to add a hover text in my multiInput function. I want to to add functionality, so that when one hovers over 'group 1' the text 'group 1 definition' pops up.

I am open to using a completely different solution to add this feature!

What I have tried: Any suggestions are greatly appreciated! I would ideally use multiInput, but it selectInput with multiple set to TRUE is also a good work around. However, there are some other issues that occur when I do this.

1. Once I select a choice, the labels of the remaining choices do not show. For example when I select group 1 and group 3, I can't see the label for group 2 when I hover over it.

2. The text box that contains the label (in the drop down) is very narrow--it's not easy to read the definition

3. Once selected, the definition is partially hidden

Here is my code:

     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

Something like this ?

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