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)

检测Shiny中的箭头键（光标键）

1 个答案: