So I am currently trying to create a Shiny App that would allow the user to chose the category associated with an entry, change it, and this change being directly written into the corresponding database. For that I used both RMySQL and DT libraries to configure Select Inputs displayed on each row with all the categories to chose from, as well as an “Update Data” button to confirm the changes and execute the SQL queries to write them into the database.
However, the app seems to work only the first time that the “Update Data” button is used after launching the app. From what I noticed, it seems to be related to the Select Input ids : they are first defined when the DataTable is initialized (with “single_input6” being associated with the row “ID : 6” for exemple), and are then recreated the same way when the DataTable is updated after the “Update Data” button has been clicked. However, the value associated with those inputs stay the same as the ones that were selected when the “Update Data” button was clicked the first time.
It could be that the ids are still binded to their initial values, or that the initial DataTable wasn’t replaced by the new one and so still exist. I don’t know however what exactly causes the issue or how to fix it.
Below are the images showing how the App works (1., 2.), where it doesn’t (3.) and what makes me think the ids are not correctly binded (4.) :
1. The App the first time it is launch](https://i.stack.imgur.com/I3DoH.png)
2. The App after selecting “Egyptien” for the row ID : 6 and cliking on “Update Data”
3. The App after then selecting “Grec” for the row ID : 6 and cliking on “Update Data” (nothing has changed)
4. The console prints used for debug. The first “Egyptien” was displayed during the 2. image update, the second “Egyptien” was displayed during the 3. image update
Here is the SQL queries to create the MySQL dummy database used as an exemple :
### Initialize the two MySQL Databases used in the code
# The Databases are not important in themselves but are handy to test and tinker what I need
CREATE TABLE Z_TEST (ID INT PRIMARY KEY NOT NULL, Divinite VARCHAR(20), ID_pantheon INT);
CREATE TABLE Z_TEST2 (id_pantheon INT PRIMARY KEY NOT NULL, nom_pantheon VARCHAR(20));
INSERT INTO Z_TEST VALUES
(1, "Quetzalcoatl", 5),
(2, "Odin", 3),
(3, "Ra", 2),
(4, "Zeus", 1),
(5, "Tiamat", 4),
(6, "Isis", 0),
(7, "Hades", 0),
(8, "Thot", 0),
(9, "Thor", 0),
(10, "Persephone", 0),
(11, "Amatsu", 0);
INSERT INTO Z_TEST2 VALUES
(1, "Grec"),
(2, "Egyptien"),
(3, "Nordique"),
(4, "Sumerien"),
(5, "Azteque"),
(6, "Japonais");
### Display each Database and their join
SELECT * FROM Z_TEST;
SELECT * FROM Z_TEST2;
SELECT ID, Divinite, Z_TEST.ID_pantheon, nom_pantheon FROM Z_TEST LEFT JOIN Z_TEST2 ON Z_TEST.ID_pantheon = Z_TEST2.id_pantheon;
Here is the R code used for the Shiny App :
### Libraries
{
library(shiny) # used to create the Shiny App
library(bslib) # used to create the Shiny App
library(RMySQL) # used to access the Database
library(lares) # used to import logins for the Database
library(tidyverse) # used for many things (mainly data manipulation)
library(DT) # used for creating interactive DataTable
# library(DTedit) # used for better editing of DataTable (judged not enought intuitive for the user)
}
### JS Module for keyboard shortcut (Not Important)
# Allows the use of arrow keys to move from cell to celle and the Enter key to confirm an edit
js <- c(
"table.on('key', function(e, datatable, key, cell, originalEvent){",
" var targetName = originalEvent.target.localName;",
" if(key == 13 && targetName == 'body'){",
" $(cell.node()).trigger('dblclick.dt');",
" }",
"});",
"table.on('keydown', function(e){",
" var keys = [9,13,37,38,39,40];",
" if(e.target.localName == 'input' && keys.indexOf(e.keyCode) > -1){",
" $(e.target).trigger('blur');",
" }",
"});",
"table.on('key-focus', function(e, datatable, cell, originalEvent){",
" var targetName = originalEvent.target.localName;",
" var type = originalEvent.type;",
" if(type == 'keydown' && targetName == 'input'){",
" if([9,37,38,39,40].indexOf(originalEvent.keyCode) > -1){",
" $(cell.node()).trigger('dblclick.dt');",
" }",
" }",
"});"
)
### Queries (Not Important)
QDisplay <- "
SELECT ID, Divinite, Z_TEST.ID_pantheon, nom_pantheon
FROM Z_TEST LEFT JOIN Z_TEST2 ON Z_TEST.ID_pantheon = Z_TEST2.id_pantheon
"
QEdit <- "
UPDATE Z_TEST
SET %s = '%s'
WHERE ID = %d
"
QRef <- "
SELECT nom_pantheon FROM Z_TEST2
"
### --- YOU MUST EDIT THE FOLLOWING PART BEFORE RUNNING THE CODE --- ###
### Database Connection (Important)
# Connect to a MySQL Database using appropriate credentials, then close the connection
# IMPORTANT : Requires a config.yml file to be setup with corresponding credentials if you want to use the get_creds function as is
# Otherwise, you can simply replace the get_creds("cirrina_as")$[...] by putting the plain-text credentials in their place
mydbGetQuery <- function(Query) {
DB <- dbConnect (
MySQL(),
dbname = get_creds("dummy_db")$dbname,
host = get_creds("dummy_db")$host,
user = get_creds("dummy_db")$user,
password = get_creds("dummy_db")$password
)
data <- dbGetQuery(DB, Query)
dbDisconnect(DB)
return(data)
}
### Automatic generation of row Select Input (somewhat Important)
# Create levels to choose from in the Select Input
factorOptions <- function(select_factors) {
a <- ""
for (i in select_factors) {
a <- paste0(a, '<option value="', i, '">', i, '</option>n')}
return(a)
}
# Create the Select Input with ID and corresponding entry from the joined table
mySelectInput <- function(selected_factor, select_factors) {
b <- c()
for (j in 1:length(selected_factor)) {
b <- c(b, paste0('<select id="single_select', j, '"style="width: 100%;">n',
sprintf('<option value="%s" selected>%s</option>n', selected_factor[j], selected_factor[j]),
factorOptions(select_factors), '</select>'))
}
return(b)
}
# Get the reference levels for the Select Input
panth_level <- mydbGetQuery(QRef) %>% as_tibble() %>% pull(nom_pantheon)
### Shiny App (Important)
shinyApp(
ui = fluidPage(
DTOutput('interactiveTable'),
actionButton("updateButton", "Update Data")
),
server = function(input, output, session) {
# Fetch the underlying data
panth_data <- reactiveVal()
observe(panth_data(mydbGetQuery(QDisplay) %>% as_tibble()))
# Initialize the DataTable
output$interactiveTable <- renderDT({
datatable(data = bind_cols(panth_data(), tibble(Test = mySelectInput(panth_data()$nom_pantheon, panth_level))),
selection = 'none', escape = FALSE, rownames = FALSE, editable = list(target = 'cell', disable = list(columns = c(0, 2))),
callback = JS(js), extensions = "KeyTable",
options = list(
keys = TRUE,
preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
)
)
})
# If the button is clicked, apply the changes made with the Select Input directly to the database
# Note : for now, only the sixth row (ID : 6, Divinite : Isis) is made responsive to any change done with selectors
# Changing the "6" of "single_select6" and "sprintf(QEdit, "ID_pantheon", i, 6)" for another number will make another entry
# responsive instead
observeEvent(input$updateButton, {
# for debug
print(input$single_select6)
# Fetch the corresponding ID of the selected pantheon and update the database
i <- mydbGetQuery(sprintf("SELECT id_pantheon FROM Z_TEST2 WHERE nom_pantheon = '%s'", as.character(input$single_select6)))$id_pantheon
mydbGetQuery(sprintf(QEdit, "ID_pantheon", i, 6))
# Update the Datable
output$interactiveTable <- renderDT({
updated_data <- mydbGetQuery(QDisplay) %>% as_tibble()
datatable(data = bind_cols(updated_data, tibble(Test = mySelectInput(updated_data$nom_pantheon, panth_level))),
selection = 'none', escape = FALSE, rownames = FALSE, editable = list(target = 'cell', disable = list(columns = c(0, 2))),
callback = JS(js), extensions = "KeyTable", options = list(
keys = TRUE,
preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}'))
)
})
})
### Attempt to edit the Data everytime the input is modified rather than waiting for a Button input
# observeEvent(input$single_select6, {
# print(input$single_select6)
#
# i <- mydbGetQuery(sprintf("SELECT id_pantheon FROM Z_TEST2 WHERE nom_pantheon = '%s'", as.character(input$single_select6)))$id_pantheon
# mydbGetQuery(sprintf(QEdit, "ID_pantheon", i,
# # d6()[input$x6_cell_edit$row,]$ID
# 6
# ))
#
# output$x6 <- renderDT({
# updated_data <- mydbGetQuery(QDisplay) %>% as_tibble()
# datatable(data = bind_cols(updated_data, tibble(Test = test2(updated_data$nom_pantheon, d))),
# selection = 'none', escape = FALSE, rownames = FALSE, editable = list(target = 'cell', disable = list(columns = c(0, 2))),
# callback = JS(js), extensions = "KeyTable", options = list(keys = TRUE))
# })
#
# reset("single_select6")
# })
}
)
Important Notes :
- The SQL dummy database must first be created for the code to work properly as is
- You must edit the “mydbGetQuery” function by replacing the credentials inside with either the one associated with your MySQL database in your config.yml file (if you intend to use
lares) or directly with the plain-text credentials (simplest option)
- Only the row ID : 6, Divinite : Isis can be updated by changing the Select Input Value and then clicking on “Update Data”. This is by design as to debug a single row first.
- Closing and launching the App again will make the first new update work, before returning the same result again
