在 Shiny 中检测箭头键（光标键）答案

【问题标题】：Detecting arrow key (cursor key) in Shiny在 Shiny 中检测箭头键（光标键）
【发布时间】：2019-06-14 14:31:14
【问题描述】：

我想在我的 Shiny 应用程序中将操作链接到箭头/光标键。该操作已与按下上一个和下一个按钮相关联。所以我想分别向它添加 eventExpr “cursor right”和“cursor left”。这是一个接一个的情节。这是 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)```

【问题讨论】：

标签： shiny

【解决方案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)

【讨论】：