R Shiny - 动态 show/hide 可编辑数据表

Question

我想创建一个 tabsetPanel 来显示基于 selectizeInput 的数据框选择，同时还允许对数据进行永久编辑。我使用 editable 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 and 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)

R Shiny - 动态 show/hide 可编辑数据表

R Shiny - Dynamically show/hide editable datatables

r

shiny

datatables-1.10