observeEvent()中的嵌套observeEvent()过于频繁地执行

时间:2017-03-13 13:18:08

标签: r shiny reactive-programming shiny-server

编辑最后的可重复示例。

我发现了here描述的类似问题,但使用reactive()并未解决我的问题。

我正在开发一个应用程序,用户可以使用FileInput上传文件,到目前为止它可以处理FASTQ和CSV文件(这里关注CSV)。所有上传的文件都保存为RData,然后可以在selectinput中再次加载它们。这个selectinput基本上可以运行所有内容,因为在评估之后它会触发一些反应式UI来显示CSV。我还注意到在打印时,当我选择一个新文件然后选择行时,它仍会打印上一个文件中的行。

我今年1月份开始使用Shiny,我首先按照Shiny页面上的教程进行操作,并且我潜伏了几个博客和StackOverflow问题,所以我有信心我在反应性和其他Shiny上犯了很多错误具体的事情。

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用户界面

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)

1 个答案:

答案 0 :(得分:0)

事实证明我完全是在思考这个问题。 由于嵌套的observe()是问题所在,并尝试使用reactive()eventReactive()修复它并且没有任何工作,我得出结论我应该从我的LoadCSV中删除observeEvent()调用.R脚本,将我用于检查selectinput()元素的observeEvent之外的观察结果。

现在一切都按预期进行..