R 带有单独悬停下拉选择的闪亮组按钮

Question

我希望radioGroupbuttons 在悬停时为组按钮的每个成员显示一个下拉菜单。该按钮的左键单击功能已用于其他目的。我有以下代码使用 bspopover 在悬停时显示文本而不是下拉菜单。即使对于此处的纯文本，bspopover 也无法正常工作。任何解决此问题的建议将不胜感激。我需要的每个按钮 A B C 的悬停下拉列表的解决方案可能与我在这里使用 radioGroupButtons 和 bspopover 尝试的不同。如果您有其他方法，请分享。谢谢！

How to make Twitter Bootstrap menu dropdown on hover rather than click 有一个 twitterbootstrap 解决方案，看起来很相关，但我还不熟悉 JS。

library(shiny)
library(shinyWidgets)
library(shinyBS)

  ui =
    fluidPage(
        radioGroupButtons(inputId = "somevalue1",individual=T,label = "Make a choice: ",choices = c("A", "B", "C")),
        verbatimTextOutput("value1")
      )
  server =
    function(input, output, session) {
      addPopover(session, "somevalue1", "Data", content = paste0("This wasn't easy"), trigger = 'hover')
      # wish to make the content above a dropdown selection, say between apple and banana for each choice A B C.
    }
  shinyApp(ui, server)

Answer 1

这是一种使用 qTip2 JavaScript 库的方法。

为了使用它，你必须download文件jquery.qtip.min.css和jquery.qtip.min.js，并把这些Shiny 应用的 www 子文件夹中的两个文件。

library(shiny)
library(shinyWidgets)

js <- "
$(document).ready(function(){

  $('#THE_INPUT_ID .radiobtn').each(function(i, $el){
    var selector = '#select' + (i+1);
    $(this).qtip({
      overwrite: true,
      content: {
        text: $(selector)
      },
      position: {
        my: 'top left',
        at: 'bottom right'
      },
      show: {
        ready: false
      },
      hide: {
        event: 'unfocus'
      },
      events: {
        blur: function(event, api) {
          api.elements.tooltip.hide();
        }
      },
      style: {
        classes: 'qtip-blue qtip-rounded'
      }
    });
  });

});
"

ui <- fluidPage(

  tags$head(
    tags$link(rel = "stylesheet", href = "jquery.qtip.min.css"),
    tags$script(src = "jquery.qtip.min.js"),
    tags$script(HTML(js))
  ),

  br(),

  radioGroupButtons(
    inputId = "THE_INPUT_ID",
    individual = TRUE,
    label = "Make a choice: ",
    choices = c("A", "B", "C")
  ),

  br(), br(), br(),

  verbatimTextOutput("selection1"),
  verbatimTextOutput("selection2"),
  verbatimTextOutput("selection3"),

  div(
    style = "display: none;",
    selectInput(
      "select1",
      label = "Select a fruit",
      choices = c("Apple", "Banana"),
      selectize = FALSE
    ),
    selectInput(
      "select2",
      label = "Select a fruit",
      choices = c("Lemon", "Orange"),
      selectize = FALSE
    ),
    selectInput(
      "select3",
      label = "Select a fruit",
      choices = c("Strawberry", "Pineapple"),
      selectize = FALSE
    )
  )

)

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

  output[["selection1"]] <- renderPrint(input[["select1"]])
  output[["selection2"]] <- renderPrint(input[["select2"]])
  output[["selection3"]] <- renderPrint(input[["select3"]])

}

shinyApp(ui, server)

---

编辑

要观察悬停在哪个按钮上，请将此 show 选项添加到 events 选项：

    events: {
      blur: function(event, api) {
        api.elements.tooltip.hide();
      },
      show: function(event, api) {
        Shiny.setInputValue('hovered', value);
      }
    }

那么悬停的按钮在input[["hovered"]]变量中。