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)
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!
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.
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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With