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

Question

我想创建一个tabsetPanel，它显示基于selectizeInput 的数据框选择，同时还允许对数据进行永久编辑。我使用可编辑的DataTables 来渲染数据框，但找不到保存编辑的方法。这个示例代码说明了我的问题：

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)

我理解为什么在我的示例中没有保存编辑（数据框会随着 selectizeInput 中的每次更改而重新渲染），但是到目前为止，我尝试保存编辑并重新渲染已编辑表的所有操作都没有工作。

Answer 1

请尝试以下方法：

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)

我还通过添加和删除选项卡而不是每次都重新呈现所有选项卡来更改您的代码。

select = TRUE 会将您带到添加的选项卡，但可以将其更改为默认值 FALSE 以保留在当前选项卡上。

保存更改的主要方式是使用reactives/reactiveValues。请参阅DT Shiny 和examples。

更新

根据下面的评论，我现在根据需要创建每个 observeEvent()。

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)