R Shiny and Heatmaps - no apparent error for debugging

Question

I am trying to create a script to generate heatmaps in R shiny. I attach the script below

library(shiny)
options(shiny.maxRequestSize = 50*1024^2)
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput('expression_table','Expression file (xlsx format)'),
      selectInput('normalization','Normalize the values with', choices = c('None','CPM','LogCPM','Z-score','Log only')),
      
      fileInput('metadata','Metadata file (xlsx format)'),
      textInput('annotcol', 'Annotation column of metadata file', value = NULL),
      
      textInput('gene_list','List of genes to plot (1 gene per line)', value = NULL),
      
      textInput('heatmap_title','Heatmap title', value = 'Heatmap title'),
      selectInput('color_scale','Choose your color scale', choices = c('Blue-White-Red',
                                                                       'Red-White-Blue',
                                                                       'Green-Black-Purple',
                                                                       'Purple-Black-Green')
                  ),
      
      sliderInput('colsize','Column labels size', min=0, max=20, step=1, value=8 ),
      sliderInput('colkm','Number of Column clusters', min=0, max=10, step=1, value=1 ),
      selectInput('coldend','Show column dendrogram', choices = c(TRUE,FALSE)),
      
      sliderInput('rowsize','Row labels size', min=0, max=20, step=1, value=8 ),
      sliderInput('rowkm','Number of Row clusters', min=0, max=10, step=1, value=1 ),
      selectInput('rowdend','Show row dendrogram', choices = c(TRUE,FALSE)),
      
      actionButton('click','Generate Heatmap')
    ),
    
    mainPanel(
     plotOutput('heatmap') 
    )
  )
  
)

server <- function(input, output, session) {
  library(ComplexHeatmap)
  library(circlize)
  library(dplyr)
  library(openxlsx)
  library(edgeR)
  library(stringr)
  
    expression <- reactive({
    read.xlsx(input$expression_table, rowNames = TRUE, colNames=TRUE)
  })
  
  expression_normalized <- reactive({
    if(input$normalization == 'CPM'){
      as.data.frame(cpm(expression))
    } else if(input$normalization == 'LogCPM'){
      as.data.frame(log(cpm(expression)+1))
    } else if(input$normalization == 'Z-score'){
      as.data.frame(t(scale(t(cpm(expression))))) 
    } else if(input$normalization == 'None'){
      read.xlsx(input$expression_table, rowNames = TRUE, colNames=TRUE)
    } else if(input$normalization == 'Log only'){
      as.data.frame(log(expression + 1))
    } 
  })
  
  metadata <- reactive({
    read.xlsx(input$metadata, rowNames = TRUE, colNames=TRUE)
  })
  
  expression_isolated <- reactive({
    if(!is.null(input$gene_list)){
      genes_list <- unlist(strsplit(input$gene_list, split = '\n'))
      expression_normalized %>% filter(rownames(.) %in% genes_list)
    } else {
      expression_normalized
    }
  })

  CS <- reactive({
    if(input$color_scale == 'Blue-White-Red'){
      colorRamp2(c(min(expression_isolated),0,max(expression_isolated)), 
                 c("steelblue3","white","firebrick3"))
    } else if(input$color_scale == 'Red-White-Blue'){
      colorRamp2(c(min(expression_isolated),0,max(expression_isolated)), 
                 c("firebrick3","white","steelblue3"))
    } else if(input$color_scale == 'Green-Black-Purple'){
      colorRamp2(c(min(expression_isolated),0,max(expression_isolated)), 
                 c("olivedrab3","black","mediumorchid3"))
    } else if(input$color_scale == 'Purple-Black-Green'){
      colorRamp2(c(min(expression_isolated),0,max(expression_isolated)), 
                 c("mediumorchid3","black","olivedrab3"))
    } 
  })
  
  #output
  eventReactive(input$click, {
    output$heatmap <-  renderPlot({
    
    if(!is.null(input$annotcol)) {
    Heatmap(as.matrix(expression_isolated), 
            col = CS, 
            
            row_names_gp = gpar(fontsize = input$rowsize), 
            column_names_gp = gpar(fontsize = input$colsize), 
            column_km = input$colkm,
            row_km= input$rowkm,
            show_row_dend = input$rowdend, 
            show_column_dend = input$coldend, 
            column_title = input$heatmap_title,
            top_annotation = HeatmapAnnotation(Condition = metadata[,input$annotcol], which = 'column') 
                                               
    )
    } else {
      Heatmap(as.matrix(expression_isolated), 
              col = CS, 
              row_names_gp = gpar(fontsize = input$rowsize), 
              column_names_gp = gpar(fontsize = input$colsize), 
              column_km = input$colkm,
              row_km= input$rowkm,
              show_row_dend = input$rowdend, 
              show_column_dend = input$coldend, 
              column_title = input$heatmap_title
              
      )
    }
    
  })
  })
    
}

shinyApp(ui, server)`

The application runs fine and generates the UI. However, when I upload the excel file with the data and press 'Generate Heatmap' I get no response and no error.

I also used observeEvent instead of eventReactive. When I used observeEvent for the click handling I get the following error: "Error in as.vector: cannot coerce type 'closure' to vector of type 'any'"

The file input is a standard excel file with rownames in the first column, headers in the first row and numeric values for data, i.e.

      SAMPLE1 SAMPLE2 SAMPLE3
IFNI    10       11     13
IFNII   11       16     15
TP53    45       22     56

Anyone know what's going on?

> sessionInfo()
R version 4.2.0 (2022-04-22)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Monterey 12.4

Matrix products: default
LAPACK: /Library/Frameworks/R.framework/Versions/4.2/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] stringr_1.5.0         edgeR_3.38.4          limma_3.52.4          openxlsx_4.2.5.1     
[5] dplyr_1.0.10          circlize_0.4.15       ComplexHeatmap_2.13.1 shiny_1.7.4          

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.10         locfit_1.5-9.7      lattice_0.20-45     png_0.1-8          
 [5] assertthat_0.2.1    digest_0.6.31       foreach_1.5.2       utf8_1.2.2         
 [9] mime_0.12           R6_2.5.1            stats4_4.2.0        pillar_1.8.1       
[13] GlobalOptions_0.1.2 rlang_1.0.6         rstudioapi_0.14     jquerylib_0.1.4    
[17] S4Vectors_0.36.1    GetoptLong_1.0.5    textshaping_0.3.6   compiler_4.2.0     
[21] httpuv_1.6.8        systemfonts_1.0.4   pkgconfig_2.0.3     BiocGenerics_0.44.0
[25] shape_1.4.6         htmltools_0.5.4     tidyselect_1.2.0    tibble_3.1.8       
[29] IRanges_2.32.0      codetools_0.2-18    matrixStats_0.63.0  fansi_1.0.4        
[33] crayon_1.5.2        later_1.3.0         jsonlite_1.8.4      xtable_1.8-4       
[37] lifecycle_1.0.3     DBI_1.1.3           magrittr_2.0.3      zip_2.2.2          
[41] cli_3.6.0           stringi_1.7.12      cachem_1.0.6        promises_1.2.0.1   
[45] doParallel_1.0.17   bslib_0.4.2         ellipsis_0.3.2      ragg_1.2.5         
[49] generics_0.1.3      vctrs_0.5.2         rjson_0.2.21        RColorBrewer_1.1-3 
[53] iterators_1.0.14    tools_4.2.0         glue_1.6.2          parallel_4.2.0     
[57] fastmap_1.1.0       clue_0.3-63         colorspace_2.1-0    cluster_2.1.4      
[61] memoise_2.0.1       sass_0.4.5         

Answer 1

BLUF: change input$metadata to input$metadata$datapath.

If you read ?shiny::fileInput and go down to the "Server value:" section, it reads:

Server value:

     A 'data.frame' that contains one row for each selected file, and
     following columns:

     'name' The filename provided by the web browser. This is *not* the
          path to read to get at the actual data that was uploaded (see
          'datapath' column).

     'size' The size of the uploaded data, in bytes.

     'type' The MIME type reported by the browser (for example,
          'text/plain'), or empty string if the browser didn't know.

     'datapath' The path to a temp file that contains the data that was
          uploaded. This file may be deleted if the user performs
          another upload operation.

By using read.xlsx(input$metadata, ...), you are passing a data.frame to read.xlsx, which obviously doesn't work. There will likely be nothing in the shiny app, since you're not capturing warnings or errors. You should have seen something like:

read.xlsx(data.frame(name="myfile", datapath="myfile.xlsx"))
# Error in file(description = xlsxFile) : invalid 'description' argument

Multiple recommendations:

1. Change your code to use input$metadata$datapath;
2. Use req and possible validate/need, since you can avoid trying to read NULL (which can happen due to the order of reactivity) and, if not met, sometimes you can provide clear verbiage in the app interface itself.
3. Use tryCatch for anything that is even somewhat out of your control. By doing so, you give yourself more information and ability to recover when something goes wrong.

At a minimum, this is your fix.

  metadata <- reactive({
    read.xlsx(input$metadata$datapath, rowNames = TRUE, colNames=TRUE)
  })

But perhaps this app presents the other recommendations clearly:

library(shiny)
shinyApp(
  ui = fluidPage(
    fileInput("metadata", "MetaData"),
    plotOutput("plot")
  ),
  server = function(input, output, session) {
    mydata <- reactive({
      req(input$metadata)
      res <- tryCatch(
        openxlsx::read.xlsx(input$metadata$datapath, rowNames = TRUE, colNames = TRUE),
        error = function(e) e
      )
      validate(
        need(
          !inherits(res, "error"),
          paste("There was a problem reading your file:",
                paste(conditionMessage(res), collapse = "; "))
        )
      )
    })
    output$plot <- renderPlot({
      req(mydata())
      plot(y ~ x, data = mydata())
    })
  }
)

The error message is in the place the plot should normally show up. If there are multiple components that use mydata(), the error message in this example will be shown in all of the components (that support validate/need rendering). You can limit this by moving the validate(..) statement out of mydata <- and into one (or more) dependent components, though all components would then need to either check for req(!inherits(mydata(), "error")) or some other way communicate what happened.