Fast automatic focus jump to next text input in R Shiny

Question

I am currently trying to create a data entry mask with R Shiny. The primary focus is on a fast and correct data entry of paper questionnaires.

Therefore I have adapted a template provided by Dean Attali (https://gist.github.com/daattali/c4db11d81f3c46a7c4a5) to my needs. You can find a simplified example below. The main thing is that the focus jumps to the next input field after an input. I have been able to do this with the help of shinyjs and a JS function. After I noticed that very fast successive inputs still end up in the same field, I used shinyjs again and limited the number of characters for the item fields to 1. Unfortunately, this led to the fact that quickly successive entries are no longer registered - the refocus seems to be too slow.

So I'm looking for a solution that results in - for example - a 1 in each item field (i_1 to i_4) after hitting the 1 key quickly four times. Do you see any possibility here? I am very grateful for all hints.

library(shiny)
library(shinyFeedback)
library(DT)
library(shinyjs)

# Functions ####

# JS refocus function
jscode <- "
shinyjs.refocus = function(e_id) {
  document.getElementById(e_id).focus();
}"

# Save the following variables ####
fields <- c("id", "i_1", "i_2", "i_3", "i_4", "rater")

# Output directory ####
outputDir <- "data"

# Save function ####
saveData <- function(data) {
  data <- t(data)
  # Create a unique file name
  fileName <- sprintf("%s_%s.csv", as.integer(Sys.time()), digest::digest(data))
  # Write the file to the local system
  write.csv(
    x = data,
    file = file.path(outputDir, fileName),
    row.names = FALSE, quote = TRUE
  )
}

# Load function ####
loadData <- function() {
  # Read all the files into a list
  files <- list.files(outputDir, full.names = TRUE)
  data <- lapply(files, read.csv, stringsAsFactors = FALSE)
  # Concatenate all data together into one data.frame
  data <- do.call(rbind, data)
  data
}

shinyApp(
  
# UI part ####
  ui = fluidPage(
    
    # activate shinyjs and extendShinyjs
    useShinyjs(),
    extendShinyjs(text = jscode, functions = "refocus"),
    
    # activate shiny feedback
    shinyFeedback::useShinyFeedback(),
    
    # rater drop down menu ####
    selectInput("rater", "Rater", c("DC", "DG", "EE", "FR", "IC", "JM", "JP", "KJ", "MP", "NP", "ZZ")),
    
    br(),
    
    # data capturing ####
    h4('Identificator'),
    textInput("id", "id1 (format: ##-###)", ""),
    
    h4('First set of items'),
    fluidRow(
      column(2,
             textInput("i_1", "i_1 (1,2,3,9)", "")),
      column(2,
             textInput("i_2", "i_2 (1,2,3,9)", "")),
      column(2,
             textInput("i_3", "i_3 (1,2,3,9)", "")),
      column(2,
             textInput("i_4", "i_4 (1,2,3,4,9)", ""))
    ),
    
    br(),
    fluidRow(
      column(1,
             actionButton("submit", "Submit")),
      column(1,
             actionButton("clear", "Clear all"))
    ),
    
    br(),
    br(),
    
    # show saved data
    DT::dataTableOutput("responses", width = 300), tags$hr()
  ),

# Server part ####
  server = function(input, output, session) {
    
    # Initial focus on first scan 
    js$refocus("id")
    
    # Limit character length of items ####
    shinyjs::runjs("$('#i_1').attr('maxlength',1)")
    shinyjs::runjs("$('#i_2').attr('maxlength',1)")
    shinyjs::runjs("$('#i_3').attr('maxlength',1)")
    shinyjs::runjs("$('#i_4').attr('maxlength',1)")

    # Jump to next item ####
    observeEvent(input$id, {
      if(nchar(input$id) == 6) {
        js$refocus("i_1")
      }
    })
    
    observeEvent(input$i_1, {
      if(nchar(input$i_1) == 1) {
        js$refocus("i_2")
      }
    })
    
    observeEvent(input$i_2, {
      if(nchar(input$i_2) == 1) {
        js$refocus("i_3")
      }
    })
    
    observeEvent(input$i_3, {
      if(nchar(input$i_3) == 1) {
        js$refocus("i_4")
      }
    })
    
    observeEvent(input$i_4, {
      if(nchar(input$i_4) == 1) {
        js$refocus("submit")
      }
    })
    
    # Data Validation ####
    observeEvent(input$id,
                 shinyFeedback::feedbackWarning(
                   "id", 
                   substr(input$id, 3, 3) != "-" | nchar(input$id) != 6,
                   "Please enter valid id format (##-###)"
                 )
    )
    
    observeEvent(input$i_1,
                 shinyFeedback::feedbackWarning(
                   "i_1", 
                   !input$i_1  %in% c("",'1','2','3','9'),
                   "Please enter valid item response code (1, 2, 3, 9)"
                 )
    )
    
    observeEvent(input$i_2,
                 shinyFeedback::feedbackWarning(
                   "i_2", 
                   !input$i_2  %in% c("",'1','2','3','9'),
                   "Please enter valid item response code (1, 2, 3, 9)"
                 )
    )
    
    observeEvent(input$i_3,
                 shinyFeedback::feedbackWarning(
                   "i_3", 
                   !input$i_3  %in% c("",'1','2','3','9'),
                   "Please enter valid item response code (1, 2, 3, 9)"
                 )
    )
    
    observeEvent(input$i_4,
                 shinyFeedback::feedbackWarning(
                   "i_4", 
                   !input$i_4  %in% c("",'1','2','3','4', '9'),
                   "Please enter valid item response code (1, 2, 3, 4, 9)"
                 )
    )
    
        # Whenever a field is filled, aggregate all form data ####
    formData <- reactive({
      data <- sapply(fields, function(x) input[[x]])
      data
    })
    
    # Submit Button ####
    observeEvent(input$submit, {
      
      # Save Data ####
      saveData(formData())
      
      # Clear all text inputs and checkbox ####
      updateTextInput(session, "id", "id (format: ##-###)", "")
      updateTextInput(session, "i_1", "i_1 (1,2,3,9)", "")
      updateTextInput(session, "i_2", "i_2 (1,2,3,9)", "")
      updateTextInput(session, "i_3", "i_3 (1,2,3,9)", "")
      updateTextInput(session, "i_4", "i_4 (1,2,3,4,9)", "")
      js$refocus("id")
    })
    
    # Clear All Button ####
    observeEvent(input$clear, {
      
      # Clear all text inputs ####
      updateTextInput(session, "id", "id (format: ##-###)", "")
      updateTextInput(session, "i_1", "i_1 (1,2,3,9)", "")
      updateTextInput(session, "i_2", "i_2 (1,2,3,9)", "")
      updateTextInput(session, "i_3", "i_3 (1,2,3,9)", "")
      updateTextInput(session, "i_4", "i_4 (1,2,3,4,9)", "")
      js$refocus("id")
    })
    
    # Show the previous responses
    # (update with current response when Submit is clicked)
    output$responses <- DT::renderDataTable({
      input$submit
      loadData()
    })  
  }
)

PS: I would like to point out that the automatic focus is the central problem here. In case of a very fast data input, information is lost with the current solution. The questionnaires and test booklets entered sometimes contain up to 100 answers, which are organised into individual item groups. If, for example, it is obvious at first glance that a 1 must be entered for each answer from an item group, then this is done so quickly that the current code would not register it. This could result in the user slipping and entering subsequent items in the wrong window. Would it be possible to simulate a keypress after entering a character in certain text boxes?

Answer 1

this is not making the app super fast but I think it improves performance as well as user experience.

Some things interfering with your app

1. You are having two different observers for each input$i_*. This redundancy impacts negatively in your app performance.
2. You're setting the maximum length of the inputs to 1 with calls like shinyjs::runjs("$('#i_1').attr('maxlength',1)"). There's no need to check their length again within the observers.
3. If the user puts a wrong value, the focus still goes to the next input. This is not desired because the user has to return to the previous input manually.
4. Your are checking inputs equal to the empty string ''.

Changes I would apply

1. Make more use of the req() function. This evaluates if its argument isTruthy(). If it is not truthy, it raises a type of error catched by shiny that stops the execution within the observer.
2. observe() instead of observeEvent(). What you are observing is the same than what you are using to compare and decide if you focus the next input. It is easy to switch to observe().
3. Assign higher priority to the observer. By default it is 0. I'm using 1 in the following code. This may not impact a lot, but it is something to consider when developing larger apps.

Then, I've deleted everything under # Jump to next item #### and under # Data Validation ####, and replaced those redundant observers with the following

    # Check input and jumpt to the next item
    observe({
      req(input$id)
      bad_input = substr(input$id, 3, 3) != "-" | nchar(input$id) != 6
      feedbackWarning(
        "id", bad_input, "Please enter valid id format (##-###)"
      )
      if (bad_input) req(FALSE)
      js$refocus("i_1")
    }, priority = 1)
    
    observe({
      req(input$i_1)
      bad_input = !input$i_1 %in% c('1','2','3','9') 
      feedbackWarning(
        "i_1", bad_input, "Please enter valid item response code (1, 2, 3, 9)"
      )
      if (bad_input) req(FALSE)
      js$refocus("i_2")
    }, priority = 1)
    
    observe({
      req(input$i_2)
      bad_input = !input$i_2 %in% c('1','2','3','9') 
      feedbackWarning(
        "i_2", bad_input, "Please enter valid item response code (1, 2, 3, 9)"
      )
      if (bad_input) req(FALSE)
      js$refocus("i_3")
    }, priority = 1)
    
    observe({
      req(input$i_3)
      bad_input = !input$i_3 %in% c('1','2','3','9') 
      feedbackWarning(
        "i_3", bad_input, "Please enter valid item response code (1, 2, 3, 9)"
      )
      if (bad_input) req(FALSE)
      js$refocus("i_4")
    }, priority = 1)
    
    observe({
      req(input$i_4)
      bad_input = !input$i_4 %in% c('1','2','3','9') 
      feedbackWarning(
        "i_4", bad_input, "Please enter valid item response code (1, 2, 3, 9)"
      )
      if (bad_input) req(FALSE)
      js$refocus("submit")
    }, priority = 1)

The req() in the very beginning of the observers make sure the code is not executed when the inputs are empty (in this case, equal to the string '').

EDIT

I just forgot to mention that if you attach packages with library() it does not make sense to use package::function(). You either attach the package and use the function name, or you don't attach the package and you call like previously mentioned. I would only use pkg::fn() calls if the fn() in my pkg is also found in another (attached) package.