R Shiny and Heatmaps - no apparent error for debugging
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
Solution
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
reqand possiblevalidate/need, since you can avoid trying to readNULL(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
tryCatchfor 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.
- Converting the row of a data.table to a vector
- ggplot multi-line log-log labels
- dplyr filter vector by position in pipe %>%
- Removing white spaces in a histogram?
- How to assign and match land cover type from Corine to a dataframe with a set of lon lat coordinates?
- Error in list2env(list, envir = .GlobalEnv) : names(x) must be a character vector of the same length as x
- How to traverse hclust internal node in R
- How are the abbreviations from the par function like mgp, mar, mai, deciphered?
- How to map over function with multiple arguments (and changing data)?
- Join/fill in data based on both row and column values
- How to plot a Log Pearson III distribution using `ggplot2` in R?
- Variable names and Easystats reports
- R plotly(): Adding regression line to a correlation scatter plot
- How to Use ifelse Statements in R
- Creating subgraphs from neighbors with max weight in R using igraph
- merge based on id and dates with missing data
- Automatically adjust the size of the text inside each bar on a bar plot using ggplot2 in R
- gghighlight and facet_wrap one always highlighted
- Mask and Crop functions in Terra R
- How to use a variable in dplyr::filter?
- Changing R Temporary Files
- How do you add a general label to facets in ggplot2?
- change colour of controls in R DT datatable
- Click Button Within Datatable to Display Popup Twice in a row
- How to display values in filter with ascending order
- Select Data From Column in Data Table
- Warning: Error in dataTableOutput: unused argument (height = "auto")
- How to have cells with rounded corners in {gt}?
- Two colours in the same box
- Change color of datatable filter dropdown box