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 :
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
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)