I am creating a Shiny app that displays a table and allows the user to edit existing rows or add new rows. The user can click any edit button in the table to open a modal dialog to edit the corresponding row, or can click a separate action button to add a new entry. The app uses modules. One module displays the table and handles the edit capability, and a second module handles the addition of new entries.
I've noticed strange behavior involving DT:datatable and Shiny. I'm using DT version 0.17, Shiny version 1.6.0, and R version 4.0.4.
In my example below, when filtering is enabled in the table by setting filter = "top" in DT::datatable(), the action button in the modal dialog for adding a new entry doesn't work. If filter = "none" or if the table is hidden by commenting out, everything works. I've created a reproducible example using mtcars to illustrate this behavior. In this example, the data are kept in a csv file and the two modules read and write to the file. In my real app, the data are in a database. In my real app, I've noticed other strange behavior too. Mainly, when the table filtering is enabled, the inputs in the modal dialog for adding a new entry become taller and the shinyvalidate alerts don't appear.
I wonder if this is a bug in Shiny or DT or if there's a problem with my code. Any help figuring this out would be greatly appreciated.
The code below illustrates the issue. To make the code work as expected, comment out tableUI("Cars") and callModule(tableServer, id = "Cars") in the main app section or set filter = "none" in DT::datatable().
# Libraries require(shiny) require(DT) # Create some data write.csv(data.frame(id = 1:5, car = rownames(mtcars)[1:5], mtcars[1:5, c("mpg", "cyl")]), file = "mtcars.csv", row.names = F) # Creates vector of edit buttons to insert in dataframe ButtonInput <- function(FUN, len, id, ...) { inputs <- character(len) for (i in seq_len(len)) { inputs[i] <- as.character(FUN(paste0(id, i), ...)) } inputs } # Updates data in csv from values in list update_data <- function(fileName, newValues, rowNum) { myData <- read.csv(fileName) for(colName in names(newValues)) { myData[rowNum, colName] <- newValues[[colName]] } write.csv(myData, file = fileName, row.names = F) } # Inserts data at top of csv file insert_data <- function(fileName, newValues) { myData <- read.csv(fileName) newData <- data.frame(car = newValues$car, mpg = newValues$mpg, cyl = newValues$cyl, id = NA) myData <- rbind(newData, myData) myData$id <- 1:nrow(myData) write.csv(myData, file = fileName, row.names = F) } # Table module ## tableUI <- function(id) { ns <- NS(id) fluidPage( DTOutput(ns("myTable")) ) } tableServer <- function(input, output, session) { # Get the row number for edit button that was clicked SelectedRow <- reactive({ req(input$select_button) splitButtonID <- strsplit(input$select_button, "_")[[1]] selectedRow <- as.numeric(splitButtonID[length(splitButtonID)]) return(selectedRow) }) # Checks for updates to mtcars.csv and returns it read_data <- reactivePoll( intervalMillis = 1000, session = session, checkFunc = function() read.csv("mtcars.csv"), valueFunc = function() read.csv("mtcars.csv") ) # Create dataframe with edit buttons in first column output$myTable <- renderDataTable({ outputDF <- data.frame( Edit = ButtonInput( FUN = actionButton, len = nrow(read_data()), id = session$ns("button_"), label = "Edit", onclick = paste0('Shiny.setInputValue(\"', session$ns("select_button"), '\", this.id, {priority: \"event\"})') ), read_data()[, c("car", "mpg", "cyl")] ) # When filter = "none", submission works. # When it's "top" or "bottom", submission doesn't work. DT::datatable( data = outputDF, filter = "top", rownames = F, escape = F ) }) # Show menu to edit entries when any edit button clicked observeEvent(input$select_button, { old_data <- read_data()[SelectedRow(), ] showModal(modalDialog( title = "Edit existing entry", easyClose = T, fluidPage( textInput(session$ns("edit_car"), label = "car", value = old_data$car), textInput(session$ns("edit_mpg"), label = "mpg", value = old_data$mpg), textInput(session$ns("edit_cyl"), label = "cyl", value = old_data$cyl), actionButton(session$ns("submit"), label = "Submit") ) )) }) # Update table when submit is clicked observeEvent(input$submit, { withProgress(message = "Updating data...", value = 0.5, { update_list <- as.list(read_data()[SelectedRow(), ]) update_list$car <- input$edit_car update_list$mpg <- input$edit_mpg update_list$cyl <- input$edit_cyl rowID <- update_list$id update_data("mtcars.csv", newValues = update_list, rowNum = rowID) }) showModal(modalDialog( title = "Thank you", "Your data have been updated." )) }) } ################################################################################ ## Insert module insertDataUI <- function(id) { ns <- NS(id) fluidPage( selectizeInput(ns("new_car"), label = "car", choices = c("bmw 325", "ford f150", "toyota camry", "porsche 911"), selected = NULL, options = list(create = T)), selectizeInput(ns("new_mpg"), label = "mpg", choices = 10:40, selected = NULL, options = list(create = T)), selectizeInput(ns("new_cyl"), label = "cyl", choices = c(4,6,8), selected = NULL, options = list(create = T)), actionButton(ns("submit"), label = "Submit") ) } insertDataServer <- function(input, output, session) { # Insert new data in first row of table when submit is clicked observeEvent(input$submit, { insert_list <- list( car = input$new_car, mpg = input$new_mpg, cyl = input$new_cyl ) withProgress(message = "Inserting data...", value = 0.5, { insert_data("mtcars.csv", newValues = insert_list) }) showModal(modalDialog( title = "Thank you", "Your data have been inserted." )) }) } ################################################################################ ## Main ## shinyApp( ui = fluidPage( br(), actionButton("insertButton", label = "Insert new entry"), br(), br(), tableUI("Cars") ), server = function(input, output, session) { callModule(tableServer, id = "Cars") observeEvent(input$insertButton, { callModule(insertDataServer, id = "insertMenu") showModal(modalDialog( title = "Insert new entry", easyClose = T, insertDataUI("insertMenu") )) }) } ) 
没有评论:
发表评论