R Shiny and Heatmaps - no apparent error for debugging - r

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:
Change your code to use input$metadata$datapath;
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.
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.