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)

突出显示R闪亮的selectInput项目，而无需单击它

2 个答案: