闪亮的 DTedit 问题:与 selectInput 和 Observe 事件结合使用时,添加新行会传递给连续的 data.frame。我怎样才能避免这种情况?

problem with DTedit in shiny: adding new row is pass to successive data.frame when combined with selectInput and Observe event. How can I avoid this?

我正在开发一款供用户查看某些数据的应用程序。目标是根据他们的知识编辑、删除和添加新数据。我有两个 selecInput。第一个select一组。第二个,select 来自该组的一个单元(参见虚拟数据)。例如,当有人尝试向数据 a1 添加新行,然后在第二个 selecInput 中更改为 a2 时,dtedit 会将那一行添加到 a2 data.frame 中。

我试过从 observeEvent 环境之外定义 dtedit 数据框,但它是一样的。有人可以帮我解决这个问题吗?谢谢。这是复制我的问题的代码:

library(shiny)
library(DTedit)
df1 <-  data.frame(A = c('a1', 'a2', 'a3'), 
                   B = c('b1', 'b2', 'b3'), 
                   C = c('c1', 'c2', 'c3'))

df2 <- list(a1=data.frame(Symbol = factor(rep('a1', 3), levels = 'a1'), 
                         Class = factor(c('Good', 'Bad', 'Neutral'), levels =c('Good', 'Bad', 'Neutral')), 
                         Status = factor(c('old', 'old', 'old'), levels = c('old', 'new'))), 
            a2 = data.frame(Symbol = factor(rep('a2', 3), levels = 'a2'), 
                            Class = factor(c('Good', 'Bad', 'Neutral'), levels =c('Good', 'Bad', 'Neutral')), 
                            Status = factor(c('old', 'old', 'old'), levels = c('old', 'new'))), 
            a3 = data.frame(Symbol = factor(rep('a3', 3), levels = 'a3'), 
                            Class = factor(c('Good', 'Bad', 'Neutral'), levels =c('Good', 'Bad', 'Neutral')), 

                            Status = factor(c('old', 'old', 'old'), levels = c('old', 'new'))),
            b1 =data.frame(Symbol = factor(), Class = factor(), Status = factor()), 
            b2 =data.frame(Symbol = factor(), Class = factor(), Status = factor()), 
            b3=data.frame(Symbol = factor(), Class = factor(), Status = factor()), 

            c1=data.frame(Symbol = factor(), Class = factor(), Status = factor()),
            c2 =data.frame(Symbol = factor(), Class = factor(), Status = factor()),
            c3=data.frame(Symbol = factor(), Class = factor(), Status = factor()))

ui <-  fluidPage(

  fluidRow(
    column(4, 
           selectInput(inputId = 'condition1', 
                       'First Condition', 
                       choices = c('A', 'B', 'C')),
           uiOutput("conditionalTab")),
    column(6,
           uiOutput('tableFiltered'))
    )
  )

server <- function(input, output, session){
  output$conditionalTab <- renderUI({
    selectInput("User", "Second condition",
                choices = df1[[input$condition1]], 
                selected = "")
  })

  observeEvent(input$User, {
    df_edit <- df2[[input$User]]

    DTedit::dtedit(input, output, name = 'tableFiltered', 
                  thedata = df_edit

                  )


  })



}

shinyApp(ui = ui, server = server)
library(shiny)
library(DTedit)
df1 <- data.frame(
  A = c("a1", "a2", "a3"),
  B = c("b1", "b2", "b3"),
  C = c("c1", "c2", "c3"),
  stringsAsFactors = FALSE
)

prototype_dataframe <-
  data.frame(
    Symbol = factor(levels = c("alpha", "beta", "gamma")),
    Class = factor(levels = c(1, 2, 3)),
    Status = factor(levels = c("Active", "Inactive", "Unknown"))
    )

df2 <- list(
  a1 = data.frame(
    Symbol = factor(rep("a1", 3), levels = "a1"),
    Class = factor(c("Good", "Bad", "Neutral"), levels = c("Good", "Bad", "Neutral")),
    Status = factor(c("old", "old", "old"), levels = c("old", "new"))
  ),
  a2 = data.frame(
    Symbol = factor(rep("a2", 3), levels = "a2"),
    Class = factor(c("Good", "Bad", "Neutral"), levels = c("Good", "Bad", "Neutral")),
    Status = factor(c("old", "old", "old"), levels = c("old", "new"))
  ),
  a3 = data.frame(
    Symbol = factor(rep("a3", 3), levels = "a3"),
    Class = factor(c("Good", "Bad", "Neutral"), levels = c("Good", "Bad", "Neutral")),

    Status = factor(c("old", "old", "old"), levels = c("old", "new"))
  ),
  b1 = prototype_dataframe,
  b2 = prototype_dataframe,
  b3 = prototype_dataframe,

  c1 = prototype_dataframe,
  c2 = prototype_dataframe,
  c3 = prototype_dataframe
)

ui <- fluidPage(
  fluidRow(
    column(
      4,
      selectInput(
        inputId = "condition1",
        "First Condition",
        choices = c("A", "B", "C")
      ),
      uiOutput("conditionalTab")
    ),
    column(
      6,
      uiOutput("tableFiltered")
    )
  )
)

server <- function(input, output, session) {
  output$conditionalTab <- renderUI({
    selectInput("User", "Second condition",
      choices = df1[[input$condition1]],
      selected = ""
    )
  })

  dt_results <- list() # get ready to be filled!
  lapply(
    # create a dtedit and observeEvent for each dataframe
    names(df2),
    # go through all the 'names' of df2 dataframes
    function(i) {
      dt_results[[i]] <- DTedit::dtedit(
        input, output,
        name = paste0("tableFiltered", i),
        # e.g. 'tableFiltereda1', 'tableFiltereda2' ...
        thedata = df2[[i]]
      )
      observeEvent(dt_results[[i]]$thedata, ignoreInit = TRUE, {
        # store results back into df2
        # some 'persistence' (though not stored in a file)
        df2[[i]] <<- dt_results[[i]]$thedata
      })
    }
  )

  observeEvent(input$User, priority = 0, {
    output$tableFiltered <- renderUI({
      uiOutput(paste0("tableFiltered", input$User))
    })
  })
}

shinyApp(ui = ui, server = server)

谢谢巴尔塔扎。

我需要重新编写代码才能以预期的方式实际获得它 运行。原始代码没有给表 B 和 C 提供有用的选项,也没有将结果写回 df2,这让您更难看出您看到的问题。

最终看来,尝试更改 input$User 会严重混淆 dteditoutput$tableFiltered 的每次重新定义都会读取一些先前的输入(例如添加一行数据)导致额外的添加行。

奇怪的是,即使我为每个 dtedit 对象(使用 paste0("tableFiltered", input$User))分别命名,也会发生这种情况,导致每个 [=] 分别命名为 input 13=] 对象。我怀疑 shiny 可能有问题,这里...

但是当所有单独的 dtedit 对象被提前定义(或者,在替代解决方案中,显示!)时,问题 不会 发生,这是按照 Dynamic UI elements in Shiny, by Statworx (also on R-bloggers).

中的示例,我在下面的 lapply 解决方案中做了什么

下面的解决方案确实需要更多 CPU 时间来建立,如果需要创建数百个对象,或者数据帧 df2 动态变化,则可能不切实际。

此解决方案适用于 jbryer/dtedit and also an extended version of dtedit DavidPatShuiFong/dtedit