R Shiny - Динамически отображать / скрывать редактируемые таблицы данных - PullRequest
Новая
       23

R Shiny - Динамически отображать / скрывать редактируемые таблицы данных

1 голос
/ 23 января 2020

Я хочу создать 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), но пока все, что я пытался сохранить изменения и заново отредактировать отредактированные таблицы не получилось.

1 Ответ

1 голос
/ 23 января 2020

Пожалуйста, попробуйте следующее: 

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 и примеры .

Обновление

На основе приведенного ниже комментария я теперь создаю каждый 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)
...