Balazs Dukai Balazs Dukai -4 years ago 110
R Question

R Shiny key and actionButton binding to reactive values

I'm trying to make a Shiny App work where the user can manipulate

reactiveValues
with either buttons or keys. Thus a minimal example would be to increment or decrement a counter with either the Up/Down
actionButton
or the U/D keys. The user should be able to use the keys without clicking anywhere on the screen first.

Based on the examples here on SO (Using enter key with action button in R Shiny, Shiny Responds to Enter and R Shiny key input binding), I came up with the script below. However, it doesn't react at all to the U/D keys. Buttons work as expected. Once I click on a button, it gets sort of "stuck" and I can use either the Enter or Space keys to repeat the button clicks, but the U/D key has still no effect. Any idea what could be wrong?

And this is the code I wrote:

library(shiny)
shinyApp(ui <- pageWithSidebar(
headerPanel("Test keyboard control"),
sidebarPanel(
tags$script(
'tags$head(
$(document).keydown(function(e)){
if (e.keyCode == 85) {
$("#upButton").click();
} else if (e.keyCode == 68) {
$("#downButton").click();
}
});'
),
actionButton("downButton", "Down"),
actionButton("upButton", "Up")
),
mainPanel(htmlOutput("text"))
),

server <- function(session, input, output) {
vals <- reactiveValues(count = 0)

observeEvent(input$downButton, {vals$count <- vals$count - 1})
observeEvent(input$upButton, {vals$count <- vals$count + 1})

output$text <- renderText(paste("Counter is:", vals$count))
}
)

Answer Source

The problem is that the input event only captures the keycode of the pressed key, which stays the same once the key is pressed. Shiny however only reacts if the event data changes. You need to set the event data to something new every time; e.g. the current time stamp. Look at this working example:

library(shiny)
shinyApp(ui <- pageWithSidebar(
  headerPanel("Test keyboard control"),
  sidebarPanel(
    tags$script('$(document).on("keydown",
                 function (e) {
                 if(e.which == 68) {
                   Shiny.onInputChange("downButton", new Date());
                 } else if (e.which == 85) {
                   Shiny.onInputChange("upButton", new Date());
                 }
                 });
                '),
    actionButton("downButton", "Down"),
    actionButton("upButton", "Up")
  ),
  mainPanel(htmlOutput("text"))
),

server <- function(session, input, output) {
  vals <- reactiveValues(count = 0)

  observeEvent(input$downButton, {vals$count <- vals$count - 1})
  observeEvent(input$upButton, {vals$count <- vals$count + 1})

  output$text <- renderText(paste("Counter is:", vals$count))
}
)
Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download