reactive radioButtons with tooltipBS in shiny

问题

I want to create a radioButtons widget with tooltip using shinyBS. What I want to achieve is to create one widget with 3 buttons with different info in tooltip. Based on this solution it was created 3 separate radio buttons with different id values. Is it possible to do the same thing but with one radio widget with 3 buttons (i.e. with one id value)?

library(shiny)
library(shinyBS)

ui <- shinyUI(
  fluidPage(
    fluidRow(
      column(3,
             HTML("<div class='container'><br>
                  <h1>Test</h1>
                  <div>
                  <label id='radio_venue_1'> 
                  <input type='radio' value='1' role='button'> button 1 
                  </label>
                  </div>
                  <div>
                  <label id='radio_venue_2'>
                  <input type='radio' value='2' role='button'> button 2
                  </label>
                  </div>
                  <div>
                  <label id='radio_venue_3'>
                  <input type='radio' value='3' role='button'> button 3
                  </label>
                  </div>
                  </div>")), 
      bsTooltip(id = "radio_venue_1", title = "Button 1 Explanation", placement = "right", trigger = "hover"),
      bsTooltip(id = "radio_venue_2", title = "Button 2 Explanation", placement = "right", trigger = "hover"),
      bsTooltip(id = "radio_venue_3", title = "Button 3 Explanation", placement = "right", trigger = "hover"),
      column(9,'Plot')
      )
    )
  )

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

回答1:

Initial answer: Creating tooltips for radioButtons

Late answer, but here it goes:

As you have seen, shinyBS's tooltip function is only designed for selection by id. You want something much finer than that, so we need to construct some new function to replace the coarser bsTooltip.

The new function is called radioTooltip and is basically a ripoff from bsTooltip. It takes one more arguement, namely the choice of the radioButton you want the tooltip to be assigned to. This allows for finer selection. The difference is now the way the element is selected on the document. Without going too much into JavaScript details, we select the element with given Id and holding the supplied radioButton choice (the internal one, so the value you'd get with input$radioButtonId).

Code below. I suggest you try it out.

library(shiny)
library(shinyBS)

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

ui <- shinyUI(
  fluidPage(
    fluidRow(
      column(3,
        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"),
      column(9,'Plot')
      )
    )
  )

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

Have fun!

Edit: Creating tooltips for selectInput/selectizeInput

For selectInput one cannot just change a bit, but there has to be a whole new function. There is mainly one reason. While radioButtons have all their choices plainly visible and right there, selectizeInput 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. The rest is just (hopefully efficient) filtering.

Example Code below:

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(
    actionButton("but", "Change choices!"),
    selectizeInput(inputId = "lala", label = "Label!", choices = LETTERS),
    selectizeTooltip(id = "lala", choice = "c", title = "Tooltip for c", placement = "right"),
    selectizeTooltip(id = "lala", choice = "C", title = "Tooltip for C", placement = "right"),
    selectizeTooltip(id = "lala", choice = "F", title = "Tooltip for F", placement = "right")
  )
)

server <- function(input, output, session){
  observeEvent(input$but, {
    updateSelectizeInput(session, "lala", choices = c("C", letters))
  })
}

shinyApp(ui, server)

Note that the tooltips also survive updateSelectizeInput and there can be tooltips for choices that initially don't exist.

If people are interested, I could send a feature request to the shinyBS guys to possibly include this into their work.

回答2:

You can use jQuery to add an id attribute to the radio buttons:

library(shiny)
library(shinyBS)

js <- '$("#radioSelection :input").each(function() {
    $(this).attr("id", "radio_" + $(this).val());
});'

ui <- shinyUI(
  fluidPage(
    fluidRow(
      column(3,
             radioButtons("radioSelection", label = "So many options!", choices = c("A", "B", "C"))
      ),
      tags$script(js),
      bsTooltip("radio_A", title="Tooltip for A"),
      bsTooltip("radio_B", title="Tooltip for B"),
      bsTooltip("radio_C", title="Tooltip for C"),
      column(9,'Plot')
    )
  )
)

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

runApp(list(ui = ui, server = server), launch.browser = TRUE)

来源：https://stackoverflow.com/questions/36132204/reactive-radiobuttons-with-tooltipbs-in-shiny

标签

Shiny

shinybs