library(shiny)
library(purrr)
library(glue)
library(dplyr)

shinyApp(
  ui = fluidPage(
    DT::dataTableOutput("x1"),
    
    # javascript for making sure to display correct value
    tags$script(
      paste0(
        "Shiny.addCustomMessageHandler('update',
          function(message) {
            document.getElementById(message.id).value = message.value;
          }
        );"
      )
    )
  ),
  
  server = function(input, output, session) {
    data <- reactiveValues(
      table = tibble(
        # unique_row_identifier can be a unique character or number
        unique_row_identifier = paste0("row_number_", 1:10e3),
        value_to_modify = sample(0:10, 10e3, replace = TRUE)
      )
    )
    
    # update the data in R
    observeEvent(input$input_change, {
      row <- input$input_change$id == data$table$unique_row_identifier
      data$table$value_to_modify[row] <- input$input_change$value
    })
    
    output$x1 <- DT::renderDataTable(
      {
        # isolate input data so that an update doesn't cause a rerendering
        isolate(data$table) %>% 
          # render a number input
          mutate(input = glue::glue(
            # the id of the input element is needed to be able to render the correct value (see javascript code above)
            "<input id='input_{unique_row_identifier}' type='number' \\
            min='0' max='5' step='1' \\
            value='{value_to_modify}' \\
            style='width: 100%' \\
            onchange='Shiny.onInputChange(\"input_change\", {{id: \"{unique_row_identifier}\", value: this.value}})'/>"
            # the quotes in id: \"{unique_row_identifier}\" are only needed if unique_row_identifier is a character
          ))
      },
      escape = 1,
      options = list(stateSave = TRUE) # necessary for displaying the correct values in the input column
    )
    
    # call script to display correct values
    observeEvent(input$x1_state, {
      rows <- input$x1_rows_current
      ids <- glue::glue("input_{data$table$unique_row_identifier[rows]}")
      vals <- data$table$value_to_modify[rows]
      
      purrr::walk2(
        ids, vals,
        ~ session$sendCustomMessage("update", list(id = .x, value = .y))
      )
    })
  }
)