用DT :: datatable预防无限反应循环

时间:2016-05-26 14:47:11

标签: r shiny reactive-programming dt

我正在构建一个闪亮的应用程序,我使用DT::datatable为用户提供数据库中的记录列表。每条记录都与一个主题相关联,当在datatable对象中单击一行时,它会从SQL数据库中检索该记录数据。

检索所有数据并生成UI组件以显示它的操作可能需要大约一秒或更长时间,具体取决于此时服务器的性能。在此延迟中,如果用户单击第二行,应用程序将进入一个被动循环 - 它会不断在两行之间切换并永不停止。

是否有机制防止这种情况发生?下面给出的应用程序再现了问题。我理想的解决方案是:

  1. 使用DT::datatable对象作为界面来选择记录
  2. 一次只允许选择一条记录。
  3. 将所选值存储在reactiveValues列表中。有时我需要刷新datatable,但我不想丢失所选行。
  4. 要么在第一次选择完成之前禁止其他选择,要么在事件处理时不识别任何其他选择。
  5. 在下面的代码中,我通过重新采样mtcars 100,000次来对事件进行了长时间的延迟。注意当快速连续选择两行时,表格上方的值如何在两个选定值之间切换。

    library(shiny)
    library(DT)
    
    # User Interface Definition
    ui <- shinyUI(
      fluidPage(
        wellPanel(
          textOutput("selected")
        ),
        DT::dataTableOutput("datatable")
      )
    )
    
    #* Server Definition
    server <- shinyServer(function(input, output, session){
      RV <- reactiveValues(
        row = NULL
      )
    
      observeEvent(
        input[["datatable_rows_selected"]],
        {
          #* Create a slow event by resampling mtcars a lot.
          set.seed(pi * exp(1))
          fit <- lm(mpg ~ qsec + factor(am), 
                    data = mtcars[sample(1:nrow(mtcars), 100000, replace = TRUE), ])
          RV$row <- input[["datatable_rows_selected"]]  
        }
      )
    
      output$selected <- 
        renderPrint(
          RV$row
        )
    
      output$datatable <- 
        DT::renderDataTable({
          rownames(mtcars) <- NULL
          DT::datatable(mtcars,
                        selection = list(mode = "single",
                                         target = "row",
                                         selected = RV$row)
          )
        })
    })
    
    shinyApp(ui = ui, server = server)
    

    跟进

    根据@ warmoverflow的评论,我写了下面的代码。它让我停止循环。但它也会禁用行选择功能。到目前为止,我发现在没有创建初始问题的情况下恢复它的唯一方法是使用操作按钮。

    library(shiny)
    library(DT)
    
    # User Interface Definition
    ui <- shinyUI(
      fluidPage(
        wellPanel(
          textOutput("selected")
        ),
        DT::dataTableOutput("datatable"),
        actionButton("reset", "Reset")
      )
    )
    
    #* Server Definition
    server <- shinyServer(function(input, output, session){
      RV <- reactiveValues(
        row = NULL,
        selection_mode = "single"
      )
    
      observeEvent(
        input[["datatable_rows_selected"]],
        {
          RV$selection_mode <- "none"
    
          #* Create a slow event by resampling mtcars a lot.
          set.seed(pi * exp(1))
          fit <- lm(mpg ~ qsec + factor(am), 
                    data = mtcars[sample(1:nrow(mtcars), 100000, replace = TRUE), ])
          RV$row <- input[["datatable_rows_selected"]]  
        }
      )
    
      observeEvent(
        input[["reset"]],
        {
          RV$selection_mode <- "single"
        }
      )
    
      output$selected <- 
        renderPrint(
          RV$row
        )
    
      output$datatable <- 
        DT::renderDataTable({
          rownames(mtcars) <- NULL
          DT::datatable(mtcars,
                        selection = list(mode = RV$selection_mode,
                                         target = "row",
                                         selected = RV$row)
          )
        })
    })
    
    shinyApp(ui = ui, server = server)
    

0 个答案:

没有答案