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

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)