Is there a way to prevent observeEvent() from triggering while still entering text in an input box?

[adrarc]

I have attempted to make a reproducible example below, although keep in mind that in my app there are many more dependencies.

Basically, I made inputs corresponding to what is in a dataTable. The placeholder for each input is taken directly from the data.
I used lapply() to generate observeEvents for each input boxes, and made it so that if the user changes the value in the inputs, it is sent to the dataset and reflected in the table. This works great and is quite fast!

My problem however, is that if I take my time to write a Petal.Length of 5.33, as soon as I type the number '5', the observeEvent is triggered. If I am quick on the keyboard I can write the number before the event is triggered, but if I take just a 0.1 second too long the event is triggered.

Is there a way for the observeEvent to be triggered only once I have clicked out of the input box? I don't really want to add a 'submit' button at the end of the row, for instance.

Please see my code below:

library(shinyWidgets)
library(dplyr)
library(DT)
library(shinysurveys)

#creating dummy dataset from iris.
dataset <- iris[match(c('setosa','versicolor','virginica'), iris$Species),c(5,1,2,3,4)]
rownames(dataset) <- NULL


# Define UI
ui <- fluidPage(
  
  tags$div(style='box-shadow: 0px 0px 6px rgba(0, 0, 0, 0.25);padding: 28px;width: 500px;margin-bottom: 10px;',
    radioGroupButtons('spSelector','', choices = as.character(dataset$Species), direction = "horizontal", individual = TRUE),
    uiOutput('entryInputs')
  ),
  dataTableOutput('table', width = '500px')
  
)

# Define server logic
server <- function(input, output) {
  
  DataSet <- reactiveVal()
  DataSet(dataset) #storing dataset as a reactiveVal DataSet()
  
  # Below is the renderUI for the input fields
  output$entryInputs <- renderUI({
    species <- input$spSelector
    tagList(
      div(class = 'entryBox',style='display:flex;',
          GetInputBox(species,'Sepal.Length'),
          GetInputBox(species,'Sepal.Width'),
          GetInputBox(species,'Petal.Length'),
          GetInputBox(species,'Petal.Width'),

      )
    )
  })
  
  #function to pull a row from the dataset, depending on which species is selected 
  GetRow <- function(species){
    temp <- DataSet()
    vars<- c('Sepal.Length','Sepal.Width','Petal.Length','Petal.Width')
    grab <- temp[which(temp$Species == species),vars] %>% unlist() %>% as.vector()
    return(grab)
  }
  
  #function to return a numberInput() and assign placeholder if the data cell already has a value.
  # I know, there is probably a cleaner way to do it, but for now it works well. 
  GetInputBox <- function(species,get){
    vars<- c('Sepal.Length','Sepal.Width','Petal.Length','Petal.Width')
    vals <- GetRow(species)
    val = vals[which(vars == get)]
    
    inputList <- list()
    inputList[[1]] <- list(numberInput(paste0('input','Sepal.Length'),label = 'Sepal.Length',placeholder = '---', value = ''),
                           numberInput(paste0('input','Sepal.Length'),label = 'Sepal.Length',placeholder = '---', value = val))
    inputList[[2]] <- list(numberInput(paste0('input','Sepal.Width'),label = 'Sepal.Width',placeholder = '---', value = ''),
                           numberInput(paste0('input','Sepal.Width'),label = 'Sepal.Width',placeholder = '---', value = val))
    inputList[[3]] <- list(numberInput(paste0('input','Petal.Length'),label = 'Petal.Length',placeholder = '---', value = ''),
                           numberInput(paste0('input','Petal.Length'),label = 'Petal.Length',placeholder = '---', value = val))
    inputList[[4]] <- list(numberInput(paste0('input','Petal.Width'),label = 'Petal.Width',placeholder = '---', value = ''),
                           numberInput(paste0('input','Petal.Width'),label = 'Petal.Width',placeholder = '---', value = val))
    
    names(inputList) <- vars
    if(is.na(val)){
      return(inputList[get][[1]][[1]])
    } else {
      return(inputList[get][[1]][[2]])
    }
  }
  
  #making the table
  output$table <- renderDataTable({
    datatable(DataSet(), options = list(dom = 't', autoWidth = TRUE, columnDefs = list(list(width = '50px', targets = "_all"))))
    
  })
  
  #using lapply() to generat the observeEvents and push the inputs to the dataframe/DataSet(). 
  observe({
    vars<- c('Sepal.Length','Sepal.Width','Petal.Length','Petal.Width')
    lapply(1:length(vars), function(i){
      
      observeEvent(input[[paste0('input',vars[i])]],{
        temp <- DataSet()
        temp[which(temp$Species == input$spSelector),vars[i]] <- input[[paste0('input',vars[i])]]
        DataSet(temp)
      })
    })
  })
}

shinyApp(ui, server)

[nirgrahamuk]

This sort of thing has a solution by way of shiny::debounce()
Shiny - Slow down a reactive expression with debounce/throttle — debounce (rstudio.com)

Alternatively, you could use an additional control, typically a button to act as the trigger to downstream functions, and just read the value of the frequently invalidated input only on the button press and not at other time.

[ismirsehregal]

Please link crossposts.

[adrarc]

Apologies, my post was on pending approval for a while which is why I cross-posted. Thank you again for your great answer.

[ismirsehregal]

@adrarc ok, that's reasonable - here you can find some info on that.

Regarding your off-topic SO post (here such a post isn't off-topic) check this:

Posit

Posit

https://www.shinyproxy.io/documentation/configuration/#container-back-ends

R on Kubernetes - serverless Shiny, R APIs and scheduled scripts

[adrarc]

@ismirsehregal These are very valuable documentation. Thank you for following up with my off-topic post!
All the best