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

Posted 2023-05-08

【中文标题】R 带有单独悬停下拉选择的闪亮组按钮

【英文标题】：R Shiny group buttons with individual hover dropdown selection

【发布时间】：2020-11-29 14:16:12

【问题描述】：

我希望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)

【问题讨论】：

工作就像一个魅力。 Stéphane，感谢 JS 修复。这非常快，非常感谢。

【参考方案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"]]变量中。

【讨论】：

一个小观察：label = "Select a fruit" 没有显示。

@Rppa 是的，对。如果要显示标签，请将 text: $(selector) 替换为 text: $(selector).parent().parent()。

我想有条件地更新服务器代码中的RadioGroupButtons，我将如何相应地调整下拉菜单？说，observeEvent(input$select1, if(input$select1=='Apple') updateRadioGroupButtons( session, inputId = "THE_INPUT_ID", label = "Make NEW choice:",choices = c('D',"A ")) ) # 说 D 需要不同的选择 pear 和 peach。

@Rppa 我明白了。请打开一个新问题。

@Rppa 是的，请参阅我的编辑。顺便问一下，你为什么取消选中这个答案？