From a2b9662094e24077e1d8b604aa7b9fc201492c2c Mon Sep 17 00:00:00 2001 From: Nick-Eagles Date: Thu, 31 Oct 2024 15:25:53 -0400 Subject: [PATCH] Also catch and display warnings from vis_grid_gene() when it occurs in the Gene grid (static). Part of #83 --- R/app_server.R | 66 +++++++++++++++++++++++++++++++++++--------------- R/app_ui.R | 1 + 2 files changed, 47 insertions(+), 20 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 6dd46c1f..03e68ae6 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -267,28 +267,37 @@ app_server <- function(input, output, session) { static_gene_grid <- reactive({ input$gene_grid_update - plots <- - vis_grid_gene( - spe, - geneid = isolate(input$geneid), - multi_gene_method = input$multi_gene_method, - assayname = isolate(input$assayname), - minCount = isolate(input$minCount), - return_plots = TRUE, - spatial = isolate(input$grid_spatial_gene), - cont_colors = isolate(cont_colors()), - image_id = isolate(input$imageid), - alpha = isolate(input$alphalevel), - point_size = isolate(input$pointsize), - sample_order = isolate(input$gene_grid_samples), - auto_crop = isolate(input$auto_crop), - is_stitched = is_stitched - ) - cowplot::plot_grid( + gene_grid_warnings = NULL + withCallingHandlers({ + plots <- + vis_grid_gene( + spe, + geneid = isolate(input$geneid), + multi_gene_method = input$multi_gene_method, + assayname = isolate(input$assayname), + minCount = isolate(input$minCount), + return_plots = TRUE, + spatial = isolate(input$grid_spatial_gene), + cont_colors = isolate(cont_colors()), + image_id = isolate(input$imageid), + alpha = isolate(input$alphalevel), + point_size = isolate(input$pointsize), + sample_order = isolate(input$gene_grid_samples), + auto_crop = isolate(input$auto_crop), + is_stitched = is_stitched + ) + }, warning = function(w) { + gene_grid_warnings <<- c(gene_grid_warnings, conditionMessage(w)) + invokeRestart("muffleWarning") + }) + + p_result = cowplot::plot_grid( plotlist = plots, nrow = isolate(input$gene_grid_nrow), ncol = isolate(input$gene_grid_ncol) ) + + return(list(p = p_result, gene_grid_warnings = gene_grid_warnings)) }) editImg_manipulations <- reactive({ @@ -474,7 +483,7 @@ app_server <- function(input, output, session) { height = 8 * isolate(input$gene_grid_nrow), width = 8 * isolate(input$gene_grid_ncol) ) - print(static_gene_grid()) + print(static_gene_grid()['p']) dev.off() } ) @@ -576,12 +585,29 @@ app_server <- function(input, output, session) { output$gene_grid <- renderPlot( { - print(static_gene_grid()) + print(static_gene_grid()[['p']]) }, width = "auto", height = "auto" ) + output$gene_grid_warnings <- renderText({ + # Since 'static_gene_grid()' is invoked twice (once also in the + # assignment of 'output$gene_grid'), we silence any errors that occur + # in this second invocation to not duplicate error messages + these_warnings = NULL + temp = try( + { these_warnings = static_gene_grid()[['gene_grid_warnings']] }, + silent = TRUE + ) + + if (!is.null(these_warnings)) { + paste("Warnings:", paste(these_warnings, collapse = "; ")) + } else { + "" + } + }) + output$editImg_plot <- renderPlot( { plot(editImg_manipulations()) diff --git a/R/app_ui.R b/R/app_ui.R index 4e92425a..208a2352 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -423,6 +423,7 @@ app_ui <- function() { actionButton("gene_grid_update", label = "Update grid plot"), downloadButton("downloadPlotGeneGrid", "Download PDF"), uiOutput("gene_grid_static"), + textOutput("gene_grid_warnings"), helpText("Click the 'upgrade grid plot' button above to re-make this plot."), tags$br(), tags$br(),