observeEvent() 中的嵌套 observeEvent() 执行得太频繁

Question

编辑最后的可重现示例。

我发现中描述的类似问题，但使用 reactive() 无法解决我的问题。

我正在开发一个应用程序，用户可以在其中上传带有 FileInput 的文件，目前它可以处理 FASTQ 和 CSV 文件（此处重点关注 CSV）。所有上传的文件都保存为 RData，然后可以 selected 在 selectinput 中再次加载它们。这个 selectinput 基本上运行所有的东西，因为在它被评估之后它会触发一些反应 UI 来显示 CSV。我在打印时还注意到，当我 select 一个新文件然后 select 行时，它仍然打印前一个文件中的行。

我今年 1 月开始使用 Shiny，我首先按照 Shiny 页面上的教程进行操作，并且潜伏了几个博客和 Whosebug 问题，所以我相信我在反应性和其他闪亮的具体事物。

selectinput观察者：

observeEvent(input$selectfiles, ignoreInit = T, {
    if (!is.null(USER$Data)) {
      if (nchar(input$selectfiles) > 1){
        file <- paste0(input$selectfiles, ".RData")

        # FASTQ
        if (endsWith(input$selectfiles, ".fastq")){
          source("LoadFastQ.R", local = T)

        } else{

          # CSV
          source("LoadCSV.R", local = T)

        }
        # Force user to View tab once file is uploaded
        updateTabsetPanel(session, "inTabset", selected = "DataView")
      }
    }
  })

CSV UI

output$CSV <- renderDataTable({
  datatable(
    CSV_table,
    filter = list(position = 'top'),
    class = 'cell-border strip hover',
    options = list(
      search = list(regex = TRUE, caseInsensitive = TRUE),
      pageLength = 10
    )
  )
})

output$DataOutput <- renderUI({
  fluidPage(
    fluidRow(
      column(4,
             selectInput("CSV_identifier", "Identifier",
                         choices = c(colnames(CSV_table)),
                         selected = colnames(CSV_table)[1])
      ),
      column(
        12, offset = -1,
        dataTableOutput("CSV")
      )
    ),
      actionButton("clustbutton", "Clustering"),
      actionButton("corrbutton", "Correlation")
    )
  )
})

选择行：

observeEvent(input$CSV_rows_selected, ignoreInit = T, {
  print("### NEW SELECT ###")
  print(input$CSV_rows_selected)
  CSV_selected <<- CSV_table[input$CSV_rows_selected, input$CSV_identifier]
  print(CSV_selected)
  print(dim(CSV_table))
})

单击行时的输出：

**click**
[1] "### NEW SELECT ###"
[1] 1                      # index of row in CSV
[1] "A"                    # value of index of row in CSV
[1]   22 1642              # dim(CSV)

**click**
[1] "### NEW SELECT ###"
[1] 1 2
[1] "A" "B"
[1]   22 1642

** Selecting new file **
**click**
[1] "### NEW SELECT ###"
[1] 1
[1] "A"
[1]   22 1642
[1] "### NEW SELECT ###"
[1] 1
[1] "X"
[1] 10  5

**click**
[1] "### NEW SELECT ###"
[1] 1 2
[1] "A" "B"
[1]   22 1642
[1] "### NEW SELECT ###"
[1] 1 2
[1] "X" "Y"
[1] 10  5

示例：

source("http://bioconductor.org/biocLite.R")
packages <-
  c(
    "shiny",
    "DT",
    "data.table",
    "DESeq2",
    "fpc",
    "gplots",
    "SCAN.UPC",
    "digest",
    "shinyBS",
    "ggplot2",
    "reshape",
    "shinyjs",
    "squash"
  )
for (package in packages) {
  if (!package %in% installed.packages()){
    biocLite(package, ask = FALSE)
  }
  library(package, character.only = T)
}
rm(list=ls())
gc()

tableA <- data.frame(LETTERS[1:10], runif(10, 1, 100), stringsAsFactors = F)
tableB <- data.frame(LETTERS[11:20], runif(10, 1, 100), stringsAsFactors = F)

# Define UI for application that draws a histogram
ui <- navbarPage(
  title = "TEST", 
  id = "inTabset",

  # Tab 1 - Loading file
  tabPanel(
    title = "Load File",
    value = "loadfile",

    fluidRow(
      useShinyjs(),
      selectInput(
        "selectfiles",
        label = "Select loaded file",
        multiple = F,
        choices = c("tableA", "tableB"), selected = "tableA"
      )
    )
  ),

  # Tab 2 - View Data
  tabPanel(
    title = "View",
    value = "DataView",
    useShinyjs(),
    uiOutput("DataOutput")
  )
)


# Define server logic required to draw a histogram
server <- function(input, output, session) {

  # READ FILE AND RETURN DATA
  observeEvent(input$selectfiles, {
    # CSV
    CSV_table <- get(input$selectfiles)

    output$CSV <- renderDataTable({
      datatable(
        CSV_table,
        filter = list(position = 'top'),
        class = 'cell-border strip hover',
        options = list(
          search = list(regex = TRUE, caseInsensitive = TRUE),
          pageLength = 10
        )
      )
    })

    output$DataOutput <- renderUI({
      fluidPage(
        fluidRow(
          column(4,
                 selectInput("CSV_identifier", "Identifier",
                             choices = c(colnames(CSV_table)),
                             selected = colnames(CSV_table)[1])
          ),
          column(
            12, offset = -1,
            dataTableOutput("CSV")
          )
        ),
        fluidRow(
          bsModal("clusterDESeqplotwindow", "DESeq clustering", trigger = "clusterDESeq", size = 'large',
                  plotOutput("clusterDESeqplot"),
                  downloadButton("clusterDESeqplotDownload")
          ),
          bsModal("clusterUPCplotwindow", "UPC clustering", trigger = "clusterUPC", size = 'large',
                  plotOutput("clusterUPCplot"),
                  downloadButton("clusterUPCplotDownload")
          ),
          bsModal("clustering", "Clustering", trigger = "clustbutton", size = "large",
                  fluidRow(
                    column(5,
                           textOutput("bsModal_selected_rows"),
                           br(),
                           htmlOutput("bsModal_Log")
                    ),
                    column(6, offset = 1,
                           fileInput("metadata", "Add metadata"),
                           selectInput("CSV_clusterparam", "Select DE parameter", choices = c(colnames(CSV_table)), selected = c(colnames(CSV_table))[2])
                    )
                    ,
                    div(id = "clusterButtons",
                        column(4, align="center",
                               actionButton("clusterUPC", "UPC"),
                               actionButton("clusterDESeq", "DESeq")
                        )
                    )
                  )
          ),
          actionButton("clustbutton", "Clustering"),
          actionButton("corrbutton", "Correlation")
        )
      )
    })


    observeEvent(input$CSV_rows_selected, ignoreInit = T, {
      print("### NEW SELECT ###")
      print(input$CSV_rows_selected)
      CSV_selected <<- CSV_table[input$CSV_rows_selected, input$CSV_identifier]
      print(CSV_selected)
      print(dim(CSV_table))
      output$bsModal_selected_rows <- renderText(paste("Selected samples:", paste(CSV_selected, collapse = ", ")))
    })
  })

  session$onSessionEnded(stopApp)  
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

原来是我想多了。由于嵌套的 observe() 是问题所在，并尝试用 reactive() 和 eventReactive() 修复它但没有任何效果，我得出的结论是我应该从 observeEvent() 中删除调用 LoadCSV.R 脚本，将观察带到我用来检查我的 selectinput() 元素的 observeEvent 之外。

现在一切正常..

observeEvent() 中的嵌套 observeEvent() 执行得太频繁

Nested observeEvent() in observeEvent() gets executed too often

r

reactive-programming

shiny

shiny-server