CODEWITHSUNDEEP
rshinyreactive-programmingshiny-server
Guus
Guus

Reputation: 233

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

EDIT Reproducible example at the end.

I found a similar problem described here, but using reactive() doesn't solve my issue.

I'm working on an app where users can upload files with a FileInput, so far it can handle FASTQ and CSV files (focus on CSV here). All uploaded files are saved as RData, which can then be selected in a selectinput where they're loaded again. This selectinput runs basically everything, since after it is evaluated it will trigger some reactive UI to display the CSV. I also noticed when printing that when I select a new file and then select rows it still prints the rows from the previous file.

I started using Shiny this January, I first followed the tutorial on the Shiny page and I've lurked several blogs and StackOverflow questions, so I'm confident that I'm making a ton of mistakes with the reactiveness and other Shiny specific things.

The selectinput observer:

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")
    )
  )
})

Selecting rows:

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 when I click rows:

**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

Example:

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)

Upvotes: 1

Views: 3218

Answers (1)

Guus
Guus

Reputation: 233

So it turns out I was completely overthinking this. Since the nested observe() was the problem, and trying to fix it with reactive() and eventReactive() and nothing working I came to the conclusion that I should just remove the observeEvent() calls from my LoadCSV.R script, bringing the observes outside of the observeEvent that I was using to check for my selectinput() element.

Now everything works as intended..

Upvotes: 2

Related Questions