突出显示 R 闪亮的 selectInput 项目而不单击它

Question

是否可以制作一个反应性的闪亮输出，直接显示用户鼠标指向的内容？

为了说明，在以下可复制的示例中，我希望这个 Shiny 应用程序无需单击即可打印鼠标光标下方的内容。

library(shiny)

ui <-fluidPage(
   titlePanel("Transports"),

sidebarLayout(
   sidebarPanel(
      selectInput("var", 
              label = "Variable to display when user moves the mouse over it",  
              choices = c("car", "boat","plane"),selected = "car")

      ),

mainPanel(
  textOutput("selected_var")
         )
    )
)

server <- function(input, output) {

   output$selected_var <- renderText({ 
      paste("You have selected the", input$var)
   })

}
shinyApp(ui = ui,server = server)

提前致谢

Answer 1

您可以向您的元素添加一个事件侦听器，您可以在其中向shiny 发送消息，然后您可以显示该消息：

library(shiny)
library(shinyjs)

ui <-fluidPage(
   useShinyjs(debug = TRUE),
   titlePanel("Transports"),

sidebarLayout(
   sidebarPanel(
      selectInput("var", 
              label = "Variable to display when user moves the mouse over it",  
              choices = c("car", "boat","plane"),selected = "car")

      ),

mainPanel(
  textOutput("selected_var")
         )
    )
)

server <- function(input, output) {
   runjs("$('.selectize-control').on('mouseenter', '.selectize-dropdown-content div', function() {Shiny.setInputValue('selected', $(this).data('value'));})")
   output$selected_var <- renderText({ 
      paste("You have selected the", input$selected)
   })

}
shinyApp(ui = ui,server = server)

Answer 2

另一种方式，在onInitialize 选项中使用一些Javascript。如果鼠标光标在此选项上停留一秒钟，则选择该选项。您可以选择另一个延迟值。我发现延迟很有用。它允许在下拉菜单中移动光标，而无需在光标触摸时选择选项。

library(shiny)

jscode <- "function(){
var delay = 1000; // 1000ms = 1s
var setTimeoutConst;
$('.selectize-control')
  .on('mouseenter', '.selectize-dropdown-content div .option', function(){
    var $this = $(this);
    clearTimeout(setTimeoutConst);
    setTimeoutConst = setTimeout(function(){
      $this.click();
    }, delay);
  } 
).on('mouseleave', function(){
  clearTimeout(setTimeoutConst);
  });
}"
shinyApp(
  ui = fluidPage(
    selectizeInput("state", "Choose a state:",
                   list(`East Coast` = c("NY", "NJ", "CT"),
                        `West Coast` = c("WA", "OR", "CA"),
                        `Midwest` = c("MN", "WI", "IA")),
                   options = list(onInitialize = I(jscode))
    ),
    textOutput("result")
  ),
  server = function(input, output) {
    output$result <- renderText({
      paste("You chose", input$state)
    })
  }
)
}