Binding issue when a DT is updated and no data has been changed

Question

So I have a functionnal app that allows the user to edit the rating of a game and this change being written directly into the database. For that I created selectInputs on each row so that you can rate each game, and an "Update Data" button to confirm the changes and writing them into the base. This process works perfectly fine as long as a change is made to the selectInputs before updating the data. If the "Update Data" button is clicked on but no slectInput has been changed since the last time it has been clicked on, then subsequent changes to the selectInputs and clicks on the "Update Data" button won't trigger anything.

The issue seems to come from the following points :

• The app writes into the database only if a line has been updated and only the lines that were updated
• The selectInput IDs are unbound every time the "Update Data" button is clicked on so that they can be recreated when the table updates (that way they don't keep in memory inputs from the first update)

Since the displayed table flicker once when updating everytime the underlying data is changed (whether through a selectInput or from a direct change in the database) but not when no change has been made, I think that the Shiny App doesn't generate or display the updated table as it is the same as the one currently displayed. And since I ask the app to unbind the selectInputs from the table everytime "Update Button" is clicked on (which are then recreated in the new DataTable), it probably creates a rupture where the displayed selectInputs are bound to nothing as no new table has been created.

Here is a reproducible exemple of the app and the issue in question :

### Libraries

{
  library(shiny)            # used to create the Shiny App
  library(bslib)            # used to create the framework of the Shiny App
  library(RMySQL)           # used to create and access the Database
  library(tidyverse)        # used for many things (mainly data manipulation)
  library(DT)               # used for creating interactive DataTable
}

### JS Module for bindings
# Unbinds the Select Input ids when "Update Data" is clicked

js <- c(
  "$('#updateButton').on('click', function() {",
  "  Shiny.unbindAll(table.table().node());",
  "});"
)


### SQL

# Initialize the dummy database
VGRatings <- tibble(
  ID = 1:11,
  Video_Game = c("The Legend of Zelda : Breath of the Wild", "God of War", "The Witcher 3 : Wild Hunt", "Deep Rock Galactic", 
                 "Tunic", "Stellaris", "Mass Effect : Legendary Edition", "Metroid Dread", "Hollow Knight", "Hades", "Okami"),
  Rating = c(10, 9, 10, 8, 7, 8, rep("NA", 5))
)

con <- dbConnect(drv = RSQLite::SQLite(), dbname = ":memory:")
dbWriteTable(conn = con, name = "DummyDB", value = VGRatings)

# Queries
QDisplay <- "SELECT ID, Video_Game, Rating FROM DummyDB"
QEdit <- "UPDATE DummyDB SET Rating = '%s' WHERE ID = %d"


### Useful functions

# Create levels to choose from in the Select Input
factorOptions <- function(factor_levels) {
  optionList <- ""
  for (i in factor_levels) {optionList <- paste0(optionList, '<option value="', i, '">', i, '</option>\n')}
  return(optionList)
}

# Create the Select Input with ID and corresponding entry from the datatable
mySelectInput <- function(id_list, selected_factors, factor_levels) {
  select_input <- paste0('<select id="single_select_', id_list, '"style="width: 100%;">\n', 
                         sprintf('<option value="%s" selected>%s</option>\n', selected_factors, selected_factors), 
                         factorOptions(factor_levels), '</select>')
  return(select_input)
}

# Preset options for the displayed table
displayTable <- function(data) {
  displayed_table <- datatable(
    data = data    , 
    selection = 'none', escape = FALSE, rownames = FALSE, callback = JS(js), extensions = "KeyTable",
    options = list(
      keys = TRUE,
      pageLength = 15,
      preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
      drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
    )
  )
  return(displayed_table)
}


### Shiny App

ui <- page_sidebar(
  sidebar = card_body(actionButton("updateButton", "Update Data")),
  card(DTOutput("interactiveTable"))
)

server <- function(input, output, session) {
  # Fetch the underlying data
  VG_data <- reactiveVal()
  observe(VG_data(dbGetQuery(con, QDisplay) %>% as_tibble()))
  
  # Initialize the DataTable
  output$interactiveTable <- renderDT({displayTable(data = VG_data() %>% mutate(Select_Rating = mySelectInput(ID, Rating, 1:10)))})
  
  observeEvent(input$updateButton, {
    # Write the new rating (onlyf or the lines that have been edited) and update the database
    for (h in VG_data()$ID) {
      h_input <- as.character(input[[paste0("single_select_", h)]])
      current_h <- filter(VG_data(), ID == h)$Rating
      
      if (h_input != current_h) {dbGetQuery(con, sprintf(QEdit, h_input, h))}
    }
    
    # Update the underlying data
    VG_data(dbGetQuery(con, QDisplay) %>% as_tibble())
  })
  
  session$onSessionEnded(function() {
    dbDisconnect(con)
    stopApp()})
}


shinyApp(ui, server)

Edit : trimmed the code and the text

Answer 1

I found a workaround to this issue and it does come from the shiny not rewriting the displayed DataTable if it is the same as the one currently displayed.

By adding

VG_data(tibble(temp = 0))

into the observeEvent (between the for loop and the actual data update), it changes VG_data to a basically empty data table, which then forces the shiny to rewrite the table even if no changes were made in the selectInputs.

Here is the full corrected code :

### Libraries

{
  library(shiny)            # used to create the Shiny App
  library(bslib)            # used to create the framework of the Shiny App
  library(RMySQL)           # used to create and access the Database
  library(tidyverse)        # used for many things (mainly data manipulation)
  library(DT)               # used for creating interactive DataTable
}

### JS Module for bindings
# Unbinds the Select Input ids when "Update Data" is clicked

js <- c(
  "$('#updateButton').on('click', function() {",
  "  Shiny.unbindAll(table.table().node());",
  "});"
)


# Initialize the dummy database
VGRatings <- tibble(
  ID = 1:11,
  Video_Game = c("The Legend of Zelda : Breath of the Wild", "God of War", "The Witcher 3 : Wild Hunt", "Deep Rock Galactic", 
                 "Tunic", "Stellaris", "Mass Effect : Legendary Edition", "Metroid Dread", "Hollow Knight", "Hades", "Okami"),
  Rating = c(10, 9, 10, 8, 7, 8, rep("NA", 5))
)

con <- dbConnect(drv = RSQLite::SQLite(), dbname = ":memory:")
dbWriteTable(conn = con, name = "DummyDB", value = VGRatings)

# Queries
QDisplay <- "SELECT ID, Video_Game, Rating FROM DummyDB"
QEdit <- "UPDATE DummyDB SET Rating = '%s' WHERE ID = %d"


### Useful functions

# Create levels to choose from in the Select Input
factorOptions <- function(factor_levels) {
  optionList <- ""
  for (i in factor_levels) {optionList <- paste0(optionList, '<option value="', i, '">', i, '</option>\n')}
  return(optionList)
}

# Create the Select Input with ID and corresponding entry from the datatable
mySelectInput <- function(id_list, selected_factors, factor_levels) {
  select_input <- paste0('<select id="single_select_', id_list, '"style="width: 100%;">\n', 
                         sprintf('<option value="%s" selected>%s</option>\n', selected_factors, selected_factors), 
                         factorOptions(factor_levels), '</select>')
  return(select_input)
}

# Preset options for the displayed table
displayTable <- function(data) {
  displayed_table <- datatable(
    data = data    , 
    selection = 'none', escape = FALSE, rownames = FALSE, callback = JS(js), extensions = "KeyTable",
    options = list(
      keys = TRUE,
      pageLength = 15,
      preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
      drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
    )
  )
  return(displayed_table)
}


### Shiny App

ui <- page_sidebar(
  sidebar = card_body(actionButton("updateButton", "Update Data")),
  card(DTOutput("interactiveTable"))
)

server <- function(input, output, session) {
  # Fetch the underlying data
  VG_data <- reactiveVal()
  observe(VG_data(dbGetQuery(con, QDisplay) %>% as_tibble()))
  
  # Initialize the DataTable
  output$interactiveTable <- renderDT({displayTable(data = VG_data() %>% mutate(Select_Rating = mySelectInput(ID, Rating, 1:10)))})
  
  observeEvent(input$updateButton, {
    # Write the new rating (onlyf or the lines that have been edited) and update the database
    for (h in VG_data()$ID) {
      h_input <- as.character(input[[paste0("single_select_", h)]])
      current_h <- filter(VG_data(), ID == h)$Rating
      
      if (h_input != current_h) {dbGetQuery(con, sprintf(QEdit, h_input, h))}
    }
    
    # Forces the underlying data to reinit before update
    VG_data(tibble(temp = 0))
    # Update the underlying data
    VG_data(dbGetQuery(con, QDisplay) %>% as_tibble())
  })
  
  session$onSessionEnded(function() {
    dbDisconnect(con)
    stopApp()})
}


shinyApp(ui, server)