Выделите R блестящий selectInput элемент, не нажимая на него - PullRequest
Новая
       13

Выделите R блестящий selectInput элемент, не нажимая на него

0 голосов
/ 11 сентября 2018

Можно ли сделать реактивный блестящий вывод, который напрямую показывает, на что указывает мышь пользователя?

Чтобы проиллюстрировать в следующем воспроизводимом примере, я бы хотел, чтобы это блестящее приложение печатало то, что находится под курсором мыши, без необходимости нажимать на него. 

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)

Заранее спасибо

Ответы [ 2 ]

0 голосов
/ 11 сентября 2018

Другой способ, используя некоторый Javascript в опции onInitialize.Опция выбирается, если курсор мыши остается на одну секунду на этой опции.Вы можете выбрать другое значение задержки.Я считаю, что задержка полезна.Это позволяет перемещать курсор по выпадающему меню, не выбирая параметр, когда курсор касается его.

enter image description here

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)
    })
  }
)
}
0 голосов
/ 11 сентября 2018

Вы можете добавить прослушиватель событий для вашего элемента, в котором вы отправляете сообщение на 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)
...