I want the user to see a different tooltip when hovering over grouped choices in selectizeInput. This was solved here for a flat vector of choices. i.e. choices = c("a", "b", "c", "d"). The difference is I would like this to work for a nested list of inputs, i.e. choices = list(first= c("a", "b"),second = c("c", "d"))

Here is an example that works for a flat vector of choices:

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 <- shinyUI(
  fluidPage(
    selectizeInput(inputId = "lala", label = "Label!", choices = c("a", "b", "c", "d")), # This changes in second example
    selectizeTooltip(id = "lala", choice = "a", title = "Tooltip for a", placement = "right"),
    selectizeTooltip(id = "lala", choice = "b", title = "Tooltip for b", placement = "right"),
    selectizeTooltip(id = "lala", choice = "c", title = "Tooltip for c", placement = "right"), 
    selectizeTooltip(id = "lala", choice = "d", title = "Tooltip for d", placement = "right")
    
  )
)

server <- function(input, output, session){
  observeEvent(input$lala,{
    print(input$lala)
  })
  
}

shinyApp(ui, server)

Here is the example that I want to get working

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 <- shinyUI(
  fluidPage(
    selectizeInput(inputId = "lala", label = "Label!", choices = list(`first` = c("a", "b"), 
                                                                      `second` = c("c", "d"))), # this is different
    selectizeTooltip(id = "lala", choice = "a", title = "Tooltip for a", placement = "right"),
    selectizeTooltip(id = "lala", choice = "b", title = "Tooltip for b", placement = "right"),
    selectizeTooltip(id = "lala", choice = "c", title = "Tooltip for c", placement = "right"), 
    selectizeTooltip(id = "lala", choice = "d", title = "Tooltip for d", placement = "right")
    
    # selectizeTooltip(id = "lala", choice = "first.a", title = "Tooltip for a", placement = "right"),
    # selectizeTooltip(id = "lala", choice = "first.b", title = "Tooltip for b", placement = "right"),
    # selectizeTooltip(id = "lala", choice = "second.c", title = "Tooltip for c", placement = "right"), 
    # selectizeTooltip(id = "lala", choice = "second.d", title = "Tooltip for d", placement = "right")
    
  )
)

server <- function(input, output, session){
  observeEvent(input$lala,{
    print(input$lala)
  })
}

shinyApp(ui, server)

I tried changing my choice to be id.choice (first.a) for example with no luck. I also tried bsTooltip with no luck. It appears that this function only allows you to have one tooltip whereas I need a tooltip for each choice in the selectizeInput.

I am open to different solutions like changing the structure of the choices in selectizeInput or using a different selector input, though I would like to be able to have groups of choices in any case. Or modifying the JS portion so it will recognize what I am looking for.

Thanks!

Here is a way.

library(shiny)

ui <- fluidPage(
  selectizeInput(
    inputId = "sel",
    label = "Animals",
    choices = NULL,
    options = list(
      options = list(
        list( species = 'mammal', value = "dog", name = "Dog"),
        list( species = 'mammal', value = "cat", name = "Cat"),
        list( species = 'mammal', value = "horse", name = "Horse"),
        list( species = 'mammal', value = "kangaroo", name = "Kangaroo"),
        list( species = 'bird', value = 'duck', name = 'Duck'),
        list( species = 'bird', value = 'chicken', name = 'Chicken'),
        list( species = 'bird', value = 'ostrich', name = 'Ostrich'),
        list( species = 'bird', value = 'seagull', name = 'Seagull'),
        list( species = 'reptile', value = 'snake', name = 'Snake'),
        list( species = 'reptile', value = 'lizard', name = 'Lizard'),
        list( species = 'reptile', value = 'alligator', name = 'Alligator'),
        list( species = 'reptile', value = 'turtle', name = 'Turtle')
      ),
      optgroups = list(
        list( value = 'mammal',  label = 'Mammal',  tooltip = 'Mammalia'),
        list( value = 'bird',    label = 'Bird',    tooltip = 'Aves'),
        list( value = 'reptile', label = 'Reptile', tooltip = 'Reptilia')
      ),
      optgroupField = "species",
      labelField = "name",
      render = I(
        "{optgroup_header: function(data, escape) {
            return '<div class=\"optgroup-header\"><span title=\"' + data.tooltip + '\">' + escape(data.label) + '</span></div>';
          }
        }"
      )
    )
  )
)

server <- function(input, output, session) {}

shinyApp(ui, server)

Edit: customized tooltips

library(shiny)
library(bslib)

css <- '
.tooltip {
  pointer-events: none;
}
.tooltip > .tooltip-inner {
  pointer-events: none;
  background-color: #73AD21;
  color: #FFFFFF;
  border: 1px solid green;
  padding: 8px;
  font-size: 20px;
  font-style: italic;
  text-align: justify;
  margin-left: 0;
  max-width: 1000px;
}
.tooltip > .arrow::before {
  border-right-color: #73AD21;
}
'

js <- "
function () {
  setTimeout(function(){$('[data-toggle=tooltip]').tooltip();}, 100);
}
"

ui <- fluidPage(
  theme = bs_theme(version = 4),
  tags$head(tags$style(HTML(css))),
  
  selectizeInput(
    inputId = "sel",
    label = "Animals",
    choices = NULL,
    options = list(
      options = list(
        list( species = 'mammal', value = "dog", name = "Dog"),
        list( species = 'mammal', value = "cat", name = "Cat"),
        list( species = 'mammal', value = "horse", name = "Horse"),
        list( species = 'mammal', value = "kangaroo", name = "Kangaroo"),
        list( species = 'bird', value = 'duck', name = 'Duck'),
        list( species = 'bird', value = 'chicken', name = 'Chicken'),
        list( species = 'bird', value = 'ostrich', name = 'Ostrich'),
        list( species = 'bird', value = 'seagull', name = 'Seagull'),
        list( species = 'reptile', value = 'snake', name = 'Snake'),
        list( species = 'reptile', value = 'lizard', name = 'Lizard'),
        list( species = 'reptile', value = 'alligator', name = 'Alligator'),
        list( species = 'reptile', value = 'turtle', name = 'Turtle')
      ),
      optgroups = list(
        list( value = 'mammal',  label = 'Mammal',  tooltip = 'Mammalia'),
        list( value = 'bird',    label = 'Bird',    tooltip = 'Aves'),
        list( value = 'reptile', label = 'Reptile', tooltip = 'Reptilia')
      ),
      optgroupField = "species",
      labelField = "name",
      render = I(
        "{optgroup_header: function(data, escape) {
            return '<div class=\"optgroup-header\"><span data-toggle=\"tooltip\" data-placement=\"right\" title=\"' + data.tooltip + '\">' + escape(data.label) + '</span></div>';
          }
        }"
      ),
      onDropdownOpen = I(js)
    )
  )
)

server <- function(input, output, session) {}

shinyApp(ui, server)

Edit

If you also want tooltips for the options, add a tooltip field in the list of options, and add a field option in the render option (see at the end):

      options = list(
        list( species = 'mammal', value = "dog", name = "Dog", tooltip = "it is a pet"),
        ......,
      ),
      optgroups = list(
        list( value = 'mammal',  label = 'Mammal',  tooltip = 'Mammalia'),
        list( value = 'bird',    label = 'Bird',    tooltip = 'Aves'),
        list( value = 'reptile', label = 'Reptile', tooltip = 'Reptilia')
      ),
      optgroupField = "species",
      labelField = "name",
      render = I(
        "{
          optgroup_header: function(data, escape) {
            return '<div class=\"optgroup-header\"><span title=\"' + data.tooltip + '\">' + escape(data.label) + '</span></div>';
          },
          option: function(data, escape) {
            return '<div><span title=\"' + data.tooltip + '\">' + escape(data.name) + '</span></div>';
          }
        }"
      )