R Shiny - 动态显示/隐藏可编辑的数据表

Question

I want to create a tabsetPanel that displays a selection of dataframes based on a selectizeInput , while also allowing for permanent edits of the data. I use editable DataTables to render the dataframes but couldn't find a way to save the edits. This example code illustrates my problem:

library(shiny)
library(shinyWidgets)
library(shinyjs)
library(DT)

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            selectizeInput(inputId = "dataframes", label = "select dataframes", 
                           choices = c("iris", "mtcars", "DNase", "ChickWeight"), multiple = TRUE, options = list(create = T))
        ),
        mainPanel(
            uiOutput("dataframes_rendered")
        )
    )
)

server <- function(input, output) {
    output$dataframes_rendered =  renderUI({
        # create one tab per df
        tabs = lapply(input$dataframes, function(df){
            output[[df]] = DT::renderDT(get(df), editable = T, rownames = F, options = list(dom = "t"))
            tabPanel(title = df, value = NULL, dataTableOutput(outputId = df), br())
        })

        # create tabsetPanel
        do.call(tabsetPanel, c(tabs, id = "df_tabset"))
    })
}

shinyApp(ui = ui, server = server)

I understand why the edits are not saved in my example (the dataframes are re-rendered with every change in the selectizeInput) but, so far, everything I tried to to save the edits and re-render the editeed tables did not work.

Answer 1

Please try the below:

library(shiny)
library(shinyWidgets)
library(shinyjs)
library(DT)

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            selectizeInput(inputId = "dataframes", label = "select dataframes", 
                           choices = c("iris", "mtcars", "DNase", "ChickWeight"), multiple = TRUE, options = list(create = T))
        ),
        mainPanel(
            tabsetPanel(id = "df_tabset")
        )
    )
)

server <- function(input, output, session) {

    tables <- reactiveValues(
        iris = iris,
        mtcars = mtcars,
        DNase = DNase,
        ChickWeight = ChickWeight,
        df_tabset = NULL
    )

    observeEvent(input$dataframes, {
        if (length(input$dataframes) > length(tables$df_tabset)) {
            df = input$dataframes[! input$dataframes %in% tables$df_tabset]
            output[[df]] = renderDT(tables[[df]], editable = T, rownames = F, options = list(dom = "t"))
            appendTab(inputId = "df_tabset", select = TRUE,
                      tabPanel(title = df, value = df, DTOutput(outputId = df))
            )
            tables$df_tabset = input$dataframes
        } else {
            df = tables$df_tabset[! tables$df_tabset %in% input$dataframes]
            removeTab(inputId = "df_tabset", target = df)
            tables$df_tabset = input$dataframes
        }

    }, ignoreNULL = FALSE, ignoreInit = TRUE)

    observeEvent(input$iris_cell_edit, {
        tables$iris[input$iris_cell_edit$row, input$iris_cell_edit$col + 1] = input$iris_cell_edit$value
    })

    observeEvent(input$mtcars_cell_edit, {
        tables$mtcars[input$mtcars_cell_edit$row, input$mtcars_cell_edit$col + 1] = input$mtcars_cell_edit$value
    })

    observeEvent(input$DNase_cell_edit, {
        tables$DNase[input$DNase_cell_edit$row, input$DNase_cell_edit$col + 1] = input$DNase_cell_edit$value
    })

    observeEvent(input$ChickWeight_cell_edit, {
        tables$ChickWeight[input$ChickWeight_cell_edit$row, input$ChickWeight_cell_edit$col + 1] = input$ChickWeight_cell_edit$value
    })

}

shinyApp(ui = ui, server = server)

I also made a change to your code by adding and removing tabs rather than rerendering all of them each time.

The select = TRUE takes you to the added tab but this can be changed to the default of FALSE to remain on the current tab.

The main way of saving changes is to use reactives / reactiveValues . See DT Shiny and examples .

Update

Based on the comment below, I now create each observeEvent() as needed.

library(shiny)
library(shinyWidgets)
library(shinyjs)
library(DT)

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            selectizeInput(inputId = "dataframes", label = "select dataframes", 
                           choices = c("iris", "mtcars", "DNase", "ChickWeight"), multiple = TRUE, options = list(create = T))
        ),
        mainPanel(
            tabsetPanel(id = "df_tabset")
        )
    )
)

server <- function(input, output, session) {

    tables <- reactiveValues(
        iris = iris,
        mtcars = mtcars,
        DNase = DNase,
        ChickWeight = ChickWeight,
        df_tabset = NULL
    )

    observeEvent(input$dataframes, {
        if (length(input$dataframes) > length(tables$df_tabset)) {
            df = input$dataframes[! input$dataframes %in% tables$df_tabset]
            output[[df]] = renderDT(tables[[df]], editable = T, rownames = F, options = list(dom = "t"))
            appendTab(inputId = "df_tabset", select = TRUE,
                      tabPanel(title = df, value = df, DTOutput(outputId = df))
            )
            observeEvent(input[[paste0(df, '_cell_edit')]], {
                tables[[df]][input[[paste0(df, '_cell_edit')]]$row, input[[paste0(df, '_cell_edit')]]$col + 1] = input[[paste0(df, '_cell_edit')]]$value
            })
            tables$df_tabset = input$dataframes
        } else {
            df = tables$df_tabset[! tables$df_tabset %in% input$dataframes]
            removeTab(inputId = "df_tabset", target = df)
            tables$df_tabset = input$dataframes
        }

    }, ignoreNULL = FALSE, ignoreInit = TRUE)

}

shinyApp(ui = ui, server = server)