带有闪亮工具提示BS的反应式单选按钮

Question

我想使用 shinyBS 创建一个带有工具提示的 radioButtons 小部件。我想要实现的是在 tooltip 中创建一个具有 3 个具有不同信息的按钮的小部件。基于此 solution 它创建了 3 个具有不同 id 值的独立单选按钮。是否可以用一个带有 3 个按钮（即一个 id 值）的单选小部件来做同样的事情？

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

初始答案：为单选按钮创建工具提示

迟到的答案，但在这里：

如您所见，shinyBS 的 tooltip 功能是专为 selection by id 设计的。你想要比这更精细的东西，所以我们需要构造一些新函数来替换更粗糙的 bsTooltip。

新功能称为 radioTooltip，基本上是 bsTooltip 的翻版。还需要一个参数，即您希望将工具提示分配给 radioButton 的 choice。这允许更精细的 selection。现在的区别在于元素在文档中的 selected 方式。在不过多讨论 JavaScript 细节的情况下，我们 select 具有给定 Id 的元素并保存提供的 radioButton choice （内部元素，因此您将获得的值input$radioButtonId).

代码如下。我建议你试试看。

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)

玩得开心！

编辑：为 selectInput/selectizeInput

创建工具提示

对于selectInput来说，不能只改一点，而是要有一个全新的功能。主要有一个原因。虽然 radioButtons 的所有选择都清晰可见并且就在那里，但 selectizeInput 移动选择、重新呈现它们、仅在它们首次显示时呈现它们等等。发生了很多事情。这就是为什么这个解决方案会抓取周围的 div 并不断监听正在添加的 childNodes。剩下的只是（希望有效）过滤。

示例代码如下：

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)

请注意，工具提示也会存在 updateSelectizeInput，并且可能会有最初不存在的选项的工具提示。

如果人们有兴趣，我可以向 shinyBS 人员发送功能请求，以便可能将其包含到他们的工作中。

Answer 2

您可以使用 jQuery 向单选按钮添加 id 属性：

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)

带有闪亮工具提示BS的反应式单选按钮

reactive radioButtons with tooltipBS in shiny

r

shiny

shinybs

初始答案：为单选按钮创建工具提示

编辑：为 selectInput/selectizeInput