Обнаружение стрелки (клавиши курсора) в Shiny

Question

Я хотел бы связать действие с клавишами со стрелками / курсором в моем приложении Shiny.Действие уже связано с нажатием предыдущей и следующей кнопок.Поэтому я хотел бы добавить к нему eventExpr «курсор вправо» и «курсор влево» соответственно.Это сюжет один за другим.Вот упрощенный пример с набором данных mtcars.

datasets <- list(mtcars, iris, PlantGrowth)

ui <- fluidPage(
  mainPanel(
    titlePanel("Simplified example"),
    tableOutput("cars"),
    actionButton("prevBtn", icon = icon("arrow-left"), ""),
    actionButton("nextBtn", icon = icon("arrow-right"), ""),
    verbatimTextOutput("rows")
  )
)

server <- function(input, output) {
  output$cars <- renderTable({
    head(dat())
  })

  dat <- reactive({
    if (is.null(rv$nr)) {
      d <- mtcars
    }
    else{
      d <- datasets[[rv$nr]]
    }
  })

  rv <- reactiveValues(nr = 1)

  set_nr <- function(direction) {
    rv$nr <- rv$nr + direction
  }

  observeEvent(input$nextBtn, { # here I would like add the sec. eventExpr.
    set_nr(1)
  })

  observeEvent(input$prevBtn, { # here I would like add the sec. eventExpr.
    set_nr(-1)
  })

  ro <- reactive({
    nrow(dat())
  })

  output$rows <- renderPrint({
    print(paste(as.character(ro()), "rows"))
  })

  vals <- reactiveValues(needThisForLater = reactive(30 * ro()))

}
shinyApp(ui = ui, server = server)```

Answer 1

Вы можете прикрепить обработчик событий keydown к документу:

datasets <- list(mtcars, iris, PlantGrowth)

js <- paste(
  "$(document).on('keydown', function(event){",
  "  var key = event.which;",
  "  if(key === 37){",
  "    Shiny.setInputValue('arrowLeft', true, {priority: 'event'});",
  "  } else if(key === 39){",
  "    Shiny.setInputValue('arrowRight', true, {priority: 'event'});",
  "  }",
  "});"
)

ui <- fluidPage(
  tags$head(tags$script(HTML(js))),
  mainPanel(
    titlePanel("Simplified example"),
    tableOutput("cars"),
    actionButton("prevBtn", icon = icon("arrow-left"), ""),
    actionButton("nextBtn", icon = icon("arrow-right"), ""),
    verbatimTextOutput("rows")
  )
)

server <- function(input, output) {
  output$cars <- renderTable({
    head(dat())
  })

  dat <- reactive({
    if (is.null(rv$nr)) {
      d <- mtcars
    }
    else{
      d <- datasets[[rv$nr]]
    }
  })

  rv <- reactiveValues(nr = 1)

  set_nr <- function(direction) {
    rv$nr <- rv$nr + direction
  }

  observeEvent(list(input$nextBtn, input$arrowRight), { 
    set_nr(1)
  })

  observeEvent(list(input$prevBtn, input$arrowLeft), { 
    set_nr(-1)
  })

  ro <- reactive({
    nrow(dat())
  })

  output$rows <- renderPrint({
    print(paste(as.character(ro()), "rows"))
  })

  vals <- reactiveValues(needThisForLater = reactive(30 * ro()))

}

shinyApp(ui = ui, server = server)