响应式Shiny秒表应用开发：如何忽略重复按键事件

我正在开发一款响应式Shiny秒表应用，核心需求如下：

• 记录试验时长：按下空格键（键码32）时开始计时，松开空格键时结束计时
• 记录试验间隔时长：从松开空格键到再次按下空格键的间隔时间
• 应用启动后秒表持续运行，按下空格键时秒表重置为0并在按住期间继续向上计时，松开空格键时同样重置为0重新计数

目前遇到的问题：无法实现按下或松开空格键时将自定义的timer()秒表重置为0。

原尝试代码 #

#install.packages("lubridate")
#install.packages("shiny")
library(lubridate)
library(shiny)

ui <- fluidPage(hr(),
                tags$script('
                            $(document).on("keydown", function (e) {
                            Shiny.onInputChange("space_down", e.which == 32);
                            });'
                ),
                ## keyup
                tags$script('
                            $(document).on("keyup", function (e) {
                            Shiny.onInputChange("space_released", e.which == 32);
                            });'
                ),
                tags$hr(),
                textOutput('stopwatch')
                
)

server <- function(input, output, session) {
  
  # Initialize the stopwatch, timer starts when shiny app opens.
  timer <- reactiveVal(0)
  update_interval = 0.01 # each interval increases the timer by one hundrendth of a second 
  
  # Output the stopwatch.
  output$stopwatch <- renderText({
    paste("Time passed: ", seconds_to_period(timer()))
  })
  
  # observer that invalidates every second. Increases timer by one update_interval.
  observe({
    invalidateLater(10, session)
    isolate({
        timer(round(timer()+update_interval,2))
    })
  })
  # observers for Keys == 32 (Spacebar)
  observeEvent(input$space_down, {timer(0)})
  observeEvent(input$space_released, {timer(0)})
}

shinyApp(ui, server)

解决方案代码 #

library(shinythemes)
library(shiny)
library(DT)
library(lubridate)
library(keys)

my_options <- options(digits.secs = 3) 

# Define UI for application that draws a histogram
ui <- fluidPage(
  title = NULL,
  theme = shinytheme("cerulean"),
  lang = NULL,
  hr(),
  tags$script(HTML('document.addEventListener("keypress", function(e) {
                                 if (!e.repeat) {
                                 Shiny.setInputValue("start", e.key == 32, {priority: "event"});
                                 }
                                  }
                                 );
                                  ')),
  tags$script(HTML('document.addEventListener("keyup", function(e) {
                                 if (!e.repeat) {
                                 Shiny.setInputValue("reset", e.key == 32, {priority: "event"});
                                 }
                                 }
                                 );
                                  ')),
  tags$script(HTML('document.addEventListener("keydown", function(e) {
                                 Shiny.setInputValue("stop", e.key == 83, {priority: "event"});
                                 }
                                 );
                                  ')),
    # Application title
    titlePanel("Tail Flick Latency StopWatch"),
    # Sidebar with a slider input for number of bins 
    sidebarPanel(
      textOutput('stopwatch'),
      ),
  
  tags$hr(),

        # Show a plot of the generated distribution
    mainPanel(
      DT::dataTableOutput("TailFlickTrials")
      )
    )


#create data frame with 0 rows and 5 columns
v <- reactiveValues()
v$df <- data.frame(Trial_Date = character(), Start_Time = numeric(), End_Time = numeric(), 
           TimeLapsed = numeric(), stringsAsFactors = FALSE)

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  
  start_timing <- as.numeric(Sys.time())
  
  tmp_Trial_Date <- character()
  tmp_Start_Time <- numeric(0)
  tmp_End_Time <- numeric(0)
    
  # observeEvent for the keydown event
  observeEvent(input$start,{
    start_timing <- as.numeric(Sys.time())
    # on keydown event erase values of tmp_End_Time and tmp_Time_Lapsed previous saved
    tmp_End_Time <- numeric(0)
    # on keydown, input new values for tmp_Trial_Date, and tmp_Start_Time        
    tmp_Trial_Date <- Sys.time()
    tmp_Start_Time <- Sys.time()
    # append tmp_Trial_date, tmp_Start_time to df
    # this method allows for the new row to have NA values for the End_Time and TimeLapsed columns. the code below will append those values to the row. 
    new_row <- head(v$df[NA,], 1)
    new_row[c('Trial_Date', 'Start_Time')] <- list(Trial_Date = tmp_Trial_Date, Start_Time = tmp_Start_Time)
    v$df <- rbind(v$df, new_row)
  })
  
  # observeEvent for the keyup event
  observeEvent(input$reset,{
    start_timing <- as.numeric(Sys.time())
    # on keyup event erase values of tmp_Trial_Date, and tmp_Start_Time, previously saved
    tmp_Trial_Date <- character()
    tmp_Start_Time <- numeric(0)
    # on keyup, input new values for tmp_End_Time and tmp_Time_Lapsed
    tmp_End_Time <- Sys.time()
    tmp_TimeLapsed <- round(as.numeric(difftime(tmp_End_Time, v$df[nrow(v$df), 2], units ="secs")),3)
    # append tmp_End_Time and tmp_Time_Lapsed to df's last row
    v$df[nrow(v$df), 3] <- tmp_End_Time
    v$df[nrow(v$df), 4] <- tmp_TimeLapsed
  })
  
  output$stopwatch <- renderText({
    as.numeric(Sys.time(), invalidateLater(100, session)) - start_timing
  })

  output$TailFlickTrials <- DT::renderDataTable({
    v$df
    })
  
  }

# Run the application 
shinyApp(ui = ui, server = server)

内容的提问来源于stack exchange，提问作者Jacob White