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

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 , 并将这两个文件放在 中www Shiny 应用程序的子文件夹。

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"]]多变的。