Shiny 应用程序中的 DT：使用 UP 和 DOWN 键盘按钮一次选择一行

Question

I have a DT object embed in a Shiny app. With the code below, I am able to select one row at the time with a left click of the mouse:

library(DT)
library(shiny)
library(tidyverse)

ui <- fluidPage(
  
  fluidRow(
    
    column(width = 12,
           DTOutput(outputId = "table",
                    width = "100%"))
    
  )
  
)

server <- function(input, output, session) {
  
  output$table <- renderDT({
    
    datatable(data = iris,
              selection = "single",
              rownames = FALSE,
              escape = FALSE,
              extension = "KeyTable",
              options = list(pageLength = 10,
                             autoWidth = FALSE,
                             scrollX = TRUE,
                             keys = TRUE,
                             columnDefs = list(list(
                               targets = 4,
                               render = JS(
                                 "function(data, type, row, meta) {",
                                 "return type === 'display' && data != null && data.length > 125 ?",
                                 "'<span title=\"' + data + '\">' + data.substr(0, 125) + '...</span>' : data;",
                                 "}")
                             ))),
              class = "display")
    
  })
  
}

shinyApp(ui = ui,
         server = server)

However, I would like to obtain the same result with the UP and DOWN arrow of the keyboard. In this way, I can select (and automatically deselect) a row only through these two buttons, which is useful when the table is pretty long and there are lots of rows to check. Thanks for your help!

EDIT : I've modified the code to insert the extension "KeyTable" as suggested by silentdevildoll . Although I can move in the table's cells with the keyboard, I am still not able to select them with the UP and DOWN arrow.

Answer 1

combined and adapted from different sources but mainly https://laustep.github.io/stlahblog/posts/DTcallbacks.html#select-rows-on-click-and-drag

Key points:

• you need the event key-focus , which is the event triggered because KeyTable already handles the arrow keys to move on the grid.
• in contrast, key would only handle events that are not handled by key-focus or other built-in KeyTable functionality. https://datatables.net/reference/event/#keytable
• You need server=FALSE in the renderDT call. If you use server-side handling, the indexes will be incorrect if there has been any sorting applied.
• Shiny complains about the Select extension which apparently clashes with Shiny's select functionality. However it seems to be working fine. I just overwrite the existing {outputname}_rows_selected input so the latest entry wins, both click and arrow row selection work.
• Not sure how to better handle initial clicking; it can be that you have to click on the table twice before the keys get activated (seen by the blue highlight on the selected cell)

library(shiny)
library(DT)

js_select_dt <- c(
  "var dt = table.table().node();",
  "var tblID = $(dt).closest('.datatables').attr('id');",
  "var inputName = tblID + '_rows_selected'",
  "var incrementName = tblID + '_rows_selected2_increment'",
  "table.on('key-focus', function(e, datatable, cell, originalEvent){",
  "  if (originalEvent.type === 'keydown'){",
  "    table.rows().deselect(); ",
  "    table.row(cell[0][0].row).select();",
  "    row = table.rows({selected: true})",
  # Note: this ID is zero-based so add one
  "    Shiny.setInputValue(inputName, [parseInt(row[0]) + 1]);",
  "  }",
  "});"
)


ui <- fluidPage(
  textOutput("selectedRow"),
  DT::DTOutput("irisTable")
)

server <- function(input, output) {
  output$irisTable<- DT::renderDT({
    iris %>%
      datatable(
        # This datatable uses both shiny's select for conventional selection
        # and keytable + select for selection by keyboard (callback js_select_dt, see above).
        # The keyboard-selected row just overwrites the regular input$peaksTable_rows_selected
        # field.
        selection = "single",
        editable = FALSE, 
        callback = JS(js_select_dt),
        extensions = c("KeyTable", "Select"),
        options = list(
          keys = TRUE,
          # keys = list(keys = c(38, 40))
          select = TRUE
        )
      )
  }, server=FALSE)
  
  output$selectedRow <- renderText(input$irisTable_rows_selected)
}

runApp(shinyApp(ui, server))