突出顯示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

另一種方法是，在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)
    })
  }
)
}

Answer 2

您可以在元素中添加事件偵聽器，並在其中向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)