Dynamically create editable DT in shiny app

Question

I want to create an app that has the following flow:

1. The user selects some data groups
2. Those groups become dynamic tabs, with each of those tabs containing a subset editable DT with the respective group
3. Each tab contains an additional reactive DT that reacts to changes in editable DataTable created in #2 (in the example below, simply multiplying numeric columns by two)

Here is an example that does #1 and #2. However, #3 does not work because the information that is normally exposed with an editable DT does not appear in my input, likely due to some scoping or order of rendering issue.

library(shiny)
library(DT)
library(dplyr)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel = 
      sidebarPanel(
        selectInput("cars", "Pick a vehicle", rownames(mtcars), multiple = T),
        actionButton("add", "Create Tabs")
      ),
    mainPanel = 
      mainPanel(
        tabsetPanel(
          id = "panel"
        )
      )
  )
)

server <- function(input, output, session) {
  
  df <- tibble::rownames_to_column(mtcars, "car")
  data <- reactiveVal()
  observe({
    req(df, input$cars)
    # Step 1) split data by user input groups
    df |>
      filter(car %in% input$cars) |>
      split(~ car) |>
      data()
  })
  
  observeEvent(input$add, {
    req(input$cars, data())
    
    # Step 2) Editable DT with respective group
    # Creates output$<car name>
    lapply(input$cars, \(x) { output[[x]] <- renderDT(data()[[x]], 
                                                      rownames = F,
                                                      editable = "cell",
                                                      selection = "none")
    })
    
    # Step 3) Reactive DT that responds to user changes
    # Creates output$<car name>tbl
    lapply(input$cars, \(x) { output[[paste0(x, "tbl")]] <- renderDT({
      mutate(data()[[x]], across(where(is.numeric), ~ . * 2))
      })
    })
    
    # insert dynamic tabs with data
    lapply(input$cars, \(x) {
      insertTab("panel", tabPanel(x, 
                                  DTOutput(x), # access output$<car name>
                                  br(),
                                  DTOutput(paste0(x, "tbl")) # access output$<car name>
      )
      )
    })
    # input does not contain input$<vehicle selection>_cell_edit
    print(names(input)) # [1] "cars"  "add"   "panel"
  })
}

shinyApp(ui, server)

---

You can see in this example that upon changing mpg to 10, the second table does not reactively show 10*2 = 20.

Normally when you create a DT on the server side like output$table <- renderDT(iris , editable = "cell") you gain access to information stored in the input object (see 2.2 DataTables Information). One of those being input$table_cell_edit (input$table_ bc the assignment is output$table <-) that you can use to create a reactive event.

Since I need to do this dynamically, I cannot hardcode assignments in this manner. lapply does work to the extent that I can reference dynamically created items (see DTOutput(...)). However, you can see from the print statement that the DataTable information is not created to capture user interactions when output assignment is done via lapply.

This SO question had a similar issue, but no response. Same with this DT GitHub issue that also was closed due to no response.

Question

So, my problem is how do I dynamically create editable DT in my output object so that I can access input object information about edits to create a chain of reactions?

Answer

In any response it would be great to see code that accomplishes 1-3 above, but also:

• Adjusts the data underlying the first table when the user edits
• Adjusts the data underlying the second table when the user edits the first table
• Provide more detail about why my code does not work (how can I access DataTables output$<car name> and output$<car name>tbl, but no input information is accessible?)

Footloose

Answer 1

TL;DR: Your code would work if you simply added the logic to handle the edits and “didn’t worry about it.” To understand why requires some details.

You correctly note that when your observer runs, the inputs that you create in it are not immediately reflected in the input object. The values in input are read-only in server code. They are sent by the client-side JavaScript at the beginning of each reactive cycle. When you call appendTab() you essentially send some HTML from the server R process to the client web browser, and ask it to be included on the page with JavaScript. It is only in the next reactive cycle that the client-side code will have been executed and the dynamically created input values have been included.

However, inputs not existing does not mean you can’t use them. The input object is after all essentially a fancy list that keeps track of which keys were requested. If a key is accessed that does not exist, you simply get NULL back as with regular R lists. Importantly though, the input object still registers the reactive dependency on the key, so when that key later on is assigned a value, the contexts in which it was requested get invalidated and everything gets updated accordingly.

You mention being able to “access” the created outputs. However, calling DTOutput() does not access any data from the output object. It simply creates some HTML code which the client-side JavaScript can interpret to populate with the results sent from the R process; try just executing DT::DTOutput("foo") in the console. When you assign the DT::renderDT() results to the output object, you create the results for JS to handle.

Putting the pieces together, here’s the code for an app with the behaviours you were looking for:

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("cars", "Pick vehicles", rownames(mtcars), multiple = TRUE)
    ),
    mainPanel(tabsetPanel(id = "tabset"))
  )
)

server <- function(input, output, session) {
  # Keep track of user-edited data
  car_datasets <- reactiveValues()

  # Create tabs for selections as needed
  observeEvent(input$cars, {
    added_cars <- setdiff(input$cars, names(car_datasets))
    lapply(added_cars, function(car) {
      # Populate initial data
      car_datasets[[car]] <- mtcars[car, ]

      # Create UI panel
      appendTab("tabset", tabPanel(
        title = car,
        DT::DTOutput(NS(car)("original")),
        DT::DTOutput(NS(car)("transformed"))
      ), select = TRUE)

      # Create outputs
      output[[NS(car)("original")]] <- DT::renderDT({
        DT::datatable(car_datasets[[car]], editable = "cell", selection = "none")
      })
      output[[NS(car)("transformed")]] <- DT::renderDT({
        dplyr::mutate_if(car_datasets[[car]], is.numeric, \(x) x * 2)
      })

      # Create observer to handle edits
      edit_input_id <- paste0(NS(car)("original"), "_cell_edit")
      observeEvent(input[[edit_input_id]], {
        car_datasets[[car]] <- DT::editData(car_datasets[[car]], input[[edit_input_id]])
      })
    })
  })
}

shinyApp(ui, server)

Repetitive

+1 thank you -- this is very interesting. Do you mind adding a bit more detail about how this reacts during an edit? You have a nested observeEvent(input[[edit_input_id]]...) that reacts when the first table is edited and it reacts even though the parent observeEvent event expression has not changed. This nested observer is also within an lapply so does everything within the lapply rerun upon an edit? Or does just observeEvent(input[[edit_input_id]]...) run which in turn causes DT::renderDT to react and reassign to output[[NS(car)("transformed")]]? – Footloose

@Footloose Calling observeEvent() creates a persistent observer. Often nested observers are a bad idea, because re-execution of the parent observer would also re-create any child observers, duplicating them. Here we avoid that by only running the creation code once for each car: we only lapply() over added_cars. On a cell edit, only the code inside the one corresponding input[[edit_input_id]] observer is re-executed. And indeed that causes the corresponding DT::renderDT() to subsequently re-execute via the shared car_datasets[[car]] reactive value having been modified. – Repetitive

So what happens if there is a functionality where the user can remove a tab and then re-add it. Is that child observer duplicated in that case? – Footloose

If implemented without care then yes that could very well happen. There would be two identical child observers and both would run the same code on an edit. You could mitigate that by destroying the child observer when you remove a tab (keep track of the return values of observeEvent() and call $destroy() on them when you remove a tab), or if the observer wouldn't need to change when the tab is re-added, just keep the original observer around and make sure not to re-create it when you show the tab again. – Repetitive

I made a quick Gist to showcase keeping track of and destroying nested observers. Maybe it will clarify that a bit: gist.github.com/mikmart/31eac2805e9670c0ac0c37652831221b – Repetitive

Answer 2

The code below should achieve your objectives. I didn't need to do anything but add the "# APPLY EDITS" section, it looks like the necessary inputs for editing are created when a tab is opened.

I've also added options = list(dom = "t") in a couple places to remove clutter from the tables (this gets rid of features like "search" that you might not need for your final application, see https://datatables.net/reference/option/dom for more details), and set rownames = F for the modified tables. Note that without rownames, we need the + 1 in input[[paste0(x, "_cell_edit")]][["col"]] + 1 to get the correct column as of DT (version 0.27).

Hope this helps! I apologize if this answer is inconsistent with usual conventions, I am new to Stack Overflow.

library(shiny)
library(DT)
library(dplyr)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel = 
      sidebarPanel(
        selectInput("cars", "Pick a vehicle", rownames(mtcars), multiple = T),
        actionButton("add", "Create Tabs"),
        actionButton("update", "Update")
      ),
    mainPanel = 
      mainPanel(
        tabsetPanel(
          id = "panel"
        )
      )
  )
)

server <- function(input, output, session) {
  
  df <- tibble::rownames_to_column(mtcars, "car")
  data <- reactiveVal()
  observe({
    req(df, input$cars)
    # Step 1) split data by user input groups
    df |>
      filter(car %in% input$cars) |>
      split(~ car) |>
      data()
  })
  
  observeEvent(input$add, {
    req(input$cars, data())
    
    # Step 2) Editable DT with respective group
    # Creates output$<car name>
    lapply(input$cars, \(x) { output[[x]] <- renderDT(data()[[x]], 
                                                      rownames = F,
                                                      editable = "cell",
                                                      selection = "none",
                                                      options = list(dom = "t"))
    })
    
    # Step 3) Reactive DT that responds to user changes
    # Creates output$<car name>tbl
    lapply(input$cars, \(x) { output[[paste0(x, "tbl")]] <- renderDT(rownames = F, options = list(dom = "t"), {
      mutate(data()[[x]], across(where(is.numeric), ~ . * 2))
    })
    })
    
    # insert dynamic tabs with data
    lapply(input$cars, \(x) {
      insertTab("panel", tabPanel(x, 
                                  DTOutput(x), # access output$<car name>
                                  br(),
                                  DTOutput(paste0(x, "tbl")) # access output$<car name>
      )
      )
    })
    # input does not contain input$<vehicle selection>_cell_edit
    print(names(input)) # [1] "cars"  "add"   "panel"
  })
  
  # APPLY EDITS
  observeEvent(input$update, {
    
    lapply(input$cars, \(x) {
      holder <- as.data.frame(data()[[x]])
      holder[input[[paste0(x, "_cell_edit")]][["row"]], input[[paste0(x, "_cell_edit")]][["col"]] + 1] <- input[[paste0(x, "_cell_edit")]][["value"]]
      df[which(df == holder[1, 1], arr.ind = T)[1], ] <- holder
      df <<- df
    })
    
    data(df |>
           filter(car %in% input$cars) |>
           split(~ car))
    
    print("edit saved")
  })
}

shinyApp(ui, server)

Contemplative

+1 this is very helpful and a great first answer on SO. I put a print(names(input)) in the observeEvent that you added. <car>_cell_edit does not exist, yet you are still able to access it with input[[paste0(x, "_cell_edit")]]? – Footloose

A follow up, when I select "Create Tabs" a second time, the print statement does show all the <car>_cell_edit and other DataTable information. – Footloose