Maintain table order and page selection in Shiny JS call to edit cell in DT

The code below replicates the problem. I have an app for users to update values and I need to refresh the page after they update the values because the colors need to update, but I haven’t been able to make it so pagination and ordering are preserved after the edits. GPT helped write a minimal working example but couldn’t solve the issue

ui <- fluidPage(
  tags$head(
    tags$script(HTML("
      // Custom handler: update the select element and row color without redrawing.
      Shiny.addCustomMessageHandler('updateDropdown', function(message) {
        var tableEl = $('#demo_table table');
        if (!tableEl.length) {
          console.warn('Table element not found');
          return;
        }
        var table = tableEl.DataTable();
        var colIndex = 2; // Category column index.
        var rowIndexes = table.rows().indexes().filter(function(idx) {
          return table.row(idx).data()[0] == message.row;
        });
        if (rowIndexes.length > 0) {
          var rowIndex = rowIndexes[0];
          var cellNode = table.cell(rowIndex, colIndex).node();
          $(cellNode).find('select').val(message.new_value);
          $(table.row(rowIndex).node()).css('background-color', message.new_color);
        }
      });
    "))
  ),
  DTOutput("demo_table")
)

server <- function(input, output, session) {
  # Create reactive data.
  data <- reactiveVal(data.frame(
    ID = 1:100,
    Value = sample(1:1000, 100),
    Category = sample(c("A", "B", "C"), 100, replace = TRUE),
    stringsAsFactors = FALSE
  ))
  
  # Helper function to create dropdown HTML.
  createDropdown <- function(row_id, current) {
    sprintf(
      '<select data-row="%s" onchange="Shiny.setInputValue('category_change', {row: %s, value: this.value, nonce: Math.random()})">
         <option value="A" %s>A</option>
         <option value="B" %s>B</option>
         <option value="C" %s>C</option>
       </select>',
      row_id, row_id,
      ifelse(current == "A", "selected", ""),
      ifelse(current == "B", "selected", ""),
      ifelse(current == "C", "selected", "")
    )
  }
  
  # Render the table only once by isolating the reactive data.
  output$demo_table <- renderDT({
    df <- isolate(data())
    # Replace Category column with dropdown HTML.
    df$Category <- sapply(df$ID, function(id) {
      cat <- data()[data()$ID == id, "Category"]
      createDropdown(id, cat)
    })
    datatable(
      df,
      escape = FALSE,
      rownames = FALSE,
      options = list(
        pageLength = 10,
        stateSave = TRUE,
        order = list(list(1, "asc")),
        rowCallback = JS("function(row, data, index) {
          // Set hidden row id.
          $(row).attr('data-row-id', data[0]);
          // Color rows based on Value.
          var val = parseInt(data[1]);
          $(row).css('background-color', val > 500 ? 'lightblue' : 'white');
        }")
      )
    )
  }, server = TRUE)
  
  proxy <- dataTableProxy("demo_table")
  
  # When the dropdown value changes, update the data and replace the table data.
  observeEvent(input$category_change, {
    req(input$category_change)
    info <- input$category_change
    df <- data()
    row_idx <- which(df$ID == info$row)
    if (length(row_idx) == 0) return()
    
    # Update the underlying data.
    df$Category[row_idx] <- info$value
    data(df)
    
    # Rebuild the table data with the updated dropdown HTML.
    new_df <- isolate(data())
    new_df$Category <- sapply(new_df$ID, function(id) {
      cur <- df[df$ID == id, "Category"]
      createDropdown(id, cur)
    })
    
    # Update the table without resetting pagination.
    replaceData(proxy, new_df, resetPaging = FALSE)
  })
}

shinyApp(ui, server)

I tried tweaking the JS by directly updating the DOM but that didn’t work. GPT has given me many solutions but the problem always persists. It works if it’s a single page. I have looked at other posts – the problem in here is similar, but they don’t use JS as the option is not a dropdown, so I wasn’t able to replicate the solution

Blockquote