Creating tooltip for radioGroupButtons while using bslib

I want to get a tooltip for a shinywidgets::radiogroupButton (or shiny::radioButton) that warns the user about the consequences of choosing each option, separately. I want to achieve the exact same output mentioned in this answer. The problem is the aforementioned solution won't work y I lay out my dashboard using bslib.

This is the function defined in the post

# function created to display tooltips
radioTooltip <- 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() {
      setTimeout(function() {
        $('input', $('#", id, "')).each(function(){
          if(this.getAttribute('value') == '", choice, "') {
            opts = $.extend(", options, ", {html: true});
            $(this.parentElement).tooltip('destroy');
            $(this.parentElement).tooltip(opts);
          }
        })
      }, 500)
    });
  ")))
  htmltools::attachDependencies(bsTag, shinyBS:::shinyBSDep)
}

This is what I'd like to see working:

library(shiny)
library(bslib)

# small shiny app
ui <- page_sidebar(title = "App ",
    sidebar = sidebar(
      shinyWidgets::radioGroupButtons("radioSelection", label = "So many options!", choices = c("A", "B", "C")),
      radioTooltip(id = "radioSelection", choice = "A", title = "Button 1 Explanation", placement = "right", trigger = "hover"),
      radioTooltip(id = "radioSelection", choice = "B", title = "Button 2 Explanation", placement = "right", trigger = "hover"),
      radioTooltip(id = "radioSelection", choice = "C", title = "Button 3 Explanation", placement = "right", trigger = "hover")
    ),
    page_fillable(
      column(9,'Plot')
      )
    )

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

For reference, this work perfectly, the only difference is that no bslib functions are used here

## it works perfectly if you instead run:
ui <- shinyUI(
  fluidPage(
    fluidRow(
      column(3,
        radioGroupButtons("radioSelection", label = "So many options!", choices = c("A", "B", "C"))
      ),
      radioTooltip(id = "radioSelection", choice = "A", title = "Button 1 Explanation", placement = "right", trigger = "hover"),
      radioTooltip(id = "radioSelection", choice = "B", title = "Button 2 Explanation", placement = "right", trigger = "hover"),
      radioTooltip(id = "radioSelection", choice = "C", title = "Button 3 Explanation", placement = "right", trigger = "hover"),
      column(9,'Plot')
      )
    )
  )

I tried to use the functions defined above. It stops working when you lay out the dashboard using bslib functions.

Solution

You have to:

replace destroy with dispose
remove the html dependency
use ordinary radio buttons, not those of shinyWidgets

radioTooltip <- 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() {
      setTimeout(function() {
        $('input', $('#", id, "')).each(function(){
          if(this.getAttribute('value') == '", choice, "') {
            opts = $.extend(", options, ", {html: true});
            $(this.parentElement).tooltip('dispose');
            $(this.parentElement).tooltip(opts);
          }
        })
      }, 500)
    });
  ")))
}

library(shiny)
library(bslib)

# small shiny app
ui <- page_sidebar(
  title = "App ",
  sidebar = sidebar(
    radioButtons("radioSelection", label = "So many options!", choices = c("A", "B", "C")),
    radioTooltip(id = "radioSelection", choice = "A", title = "Button 1 Explanation", placement = "right", trigger = "hover"),
    radioTooltip(id = "radioSelection", choice = "B", title = "Button 2 Explanation", placement = "right", trigger = "hover"),
    radioTooltip(id = "radioSelection", choice = "C", title = "Button 3 Explanation", placement = "right", trigger = "hover")
  ),
  page_fillable(
    column(9,'Plot')
  )
)

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

shinyApp(ui = ui, server = server)