RadioButton reactivos con tooltipBS en brillante

shiny shinybs

Question

Quiero crear un widget de radioButtons con información sobre herramientas usando shinyBS . Lo que quiero lograr es crear un widget con 3 botones con información diferente en la información sobre tooltip . Basado en esta solución , se crearon 3 botones de radio separados con diferentes valores de identificación. ¿Es posible hacer lo mismo pero con un widget de radio con 3 botones (es decir, con un valor de identificación)?

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)

Answer 1

Respuesta inicial: Crear información sobre herramientas para radioButtons

Última respuesta, pero aquí va:

Como has visto, la función de información sobre herramientas de shinyBS solo está diseñada para la selección por ID. Desea algo mucho mejor que eso, por lo que debemos construir una nueva función para reemplazar la bsTooltip más bsTooltip .

La nueva función se llama radioTooltip y es básicamente una estafa de bsTooltip . Se necesita una argumentación más, a saber, la choice del radioButton le radioButton la información sobre herramientas. Esto permite una selección más fina. La diferencia ahora es la forma en que se selecciona el elemento en el documento. Sin entrar demasiado en los detalles de JavaScript, seleccionamos el elemento con Id determinado y manteniendo la choice radioButton suministrada (la interna, por lo que el valor que obtendría con la input$radioButtonId ).

Código a continuación. Te sugiero que lo pruebes.

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)

¡Que te diviertas!

Editar: Crear información sobre herramientas para selectInput / selectizeInput

Para selectInput uno no puede simplemente cambiar un bit, pero tiene que haber una función completamente nueva. Hay principalmente una razón. Mientras que los radioButtons tienen todas sus opciones claramente visibles y justo allí, selectizeInput mueve las opciones, las vuelve a presentar, las renderiza solo cuando se muestran por primera vez, y así sucesivamente. Suceden muchas cosas Esta es la razón por la cual esta solución toma el div circundante y escucha constantemente el childNodes de childNodes . El resto es solo (con suerte eficiente) filtrado.

Ejemplo de código a continuación:

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)

Tenga en cuenta que la información sobre herramientas también sobrevive a updateSelectizeInput y puede haber información sobre herramientas para las opciones que inicialmente no existen.

Si la gente está interesada, podría enviar una solicitud de función a los chicos shinyBS para posiblemente incluir esto en su trabajo.

Answer 2

Puede usar jQuery para agregar un atributo id a los botones de opción:

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)