Added download buttons to plots

Though I noted that 'grid.draw()' seems to work more or less like a 'print()', without returning anything when the function is called. Is there a workaround?

R/06-plots_and_app.R

@@ -29,18 +29,19 @@ add_logo_to_plot <- function(plot,
                              interpolate = TRUE,
                              ... ) {
 
+
   # Set up the layout for the main plot and logo
   layout <- grid::grid.layout(nrow = 1, ncol = 1)
-
-  # Create a new page with the specified layout
+#
+  ## Create a new page with the specified layout
   grid::grid.newpage()
   grid::pushViewport(grid::viewport(layout = layout))
-
-  # Plot the Venn diagram on the left
+#
+  ## Plot the Venn diagram on the left
   grid::pushViewport(grid::viewport(layout.pos.col = 1))
   print(plot, newpage = FALSE)
-
-  # Clear the viewport before adding the logo
+#
+  ## Clear the viewport before adding the logo
   grid::popViewport(1)
 
   # Getting logo
@@ -62,12 +63,13 @@ add_logo_to_plot <- function(plot,
   # Reset the viewport
   grid::popViewport(2)
 
+  return( grid::grid.grab(wrap.grobs = TRUE ) )
   #Return the combined graphical object
-  return(grid::grid.grab(wrap.grobs = TRUE))
 }
 
 
 
+
 #' Extracting list of uuid columns from biblioverlap results
 #'
 #' @description
@@ -138,6 +140,7 @@ plot_venn <- function(db_list, ...) {
   venn <- ggVennDiagram::ggVennDiagram(uuid, ...) +
     ggplot2::scale_fill_gradient(low = "#A7C7E7", high = "#08306B") +
     ggplot2::scale_x_continuous(expand = ggplot2::expansion(mult = .2))
+  #return ( venn )
   return ( add_logo_to_plot(venn) )
 }
 

inst/biblioverApp/app.R

@@ -2,6 +2,7 @@ library(shiny)
 library(DT)
 library(biblioverlap)
 library(dplyr)
+library(grDevices)
 
 # Load the UI and server components
 source('ui.R', local = TRUE)

inst/biblioverApp/server.R

@@ -188,36 +188,28 @@ server <- function(input, output, session) {
     return( read_datatable(table) )
   }, server = TRUE) ##Server is necessary because the db_list can be huge
 
-
   output$summary_table <- renderTable({
     summary_table <- calculate_results()$summary
     return( summary_table )
   }, width = '100%', striped = TRUE, bordered = TRUE, align = 'l')
 
 
+  #### Generating plots (reactive functions)
 
-  output$summary_plot <- renderPlot({
-    summary_df <- calculate_results()$summary
-    summary_plot <- biblioverlap::plot_matching_summary(summary_df,
-                                                        text_size = input$summary_text_size,
-                                                        size = input$summary_value_size)
-    return( summary_plot )
-  }, height = reactive( { input$plot_height } ),
-  width = reactive( { input$plot_width } )
-  )
+  summary_plot <- reactive( {
+    biblioverlap::plot_matching_summary(calculate_results()$summary,
+                                        text_size = input$summary_text_size,
+                                        size = input$summary_value_size)
+  })
 
-  output$venn <- renderPlot({
-    venn <- biblioverlap::plot_venn(calculate_results()$db_list,
+  venn_plot <- reactive( {
+    biblioverlap::plot_venn(calculate_results()$db_list,
                                     label = input$venn_label,
                                     label_color = input$venn_label_color,
                                     label_size = input$venn_label_size,
                                     label_alpha = input$venn_label_alpha,
                                     set_size = input$venn_set_size )
-    return( venn )
-  }, height = reactive( { input$plot_height } ),
-  width = reactive( { input$plot_width } )
-  )
-
+    } )
 
   # Upset plots from UpSetR can hide its empty intersections if a NULL value is passed to its `empty.intersections` parameter
   # However, the NULL value can not be passed directly to the `selectInput()` shiny function
@@ -227,26 +219,67 @@ server <- function(input, output, session) {
     else {return(NULL)}
   })
 
+  upset_plot <- reactive ({
+    biblioverlap::plot_upset(calculate_results()$db_list,
+                             nsets = length(db_list),
+                             nintersects = input$nintersects,
+                             order.by = input$order.by,
+                             scale.intersections	= input$scale,
+                             empty.intersections = upset_empty_intersections(),
+                             scale.sets = input$scale,
+                             text.scale = input$text_size,
+                             show.numbers = input$show.numbers,
+                             mb.ratio = c(input$mb.ratio, 1 - input$mb.ratio)
+                             )
+    }  )
+
+  #Displaying plots in shinyApp (renderPlot functions)
+
+  output$summary_plot <- renderPlot({
+    summary_plot()
+  }, height = reactive( { input$plot_height } ),
+  width = reactive( { input$plot_width } )
+  )
 
+  output$venn <- renderPlot({
+    venn_plot()
+  }, height = reactive( { input$plot_height } ),
+  width = reactive( { input$plot_width } )
+  )
 
   output$upset <- renderPlot(   {
-    db_list <- calculate_results()$db_list
-    upset <- biblioverlap::plot_upset(db_list,
-                                      nsets = length(db_list),
-                                      nintersects = input$nintersects,
-                                      order.by = input$order.by,
-                                      scale.intersections	= input$scale,
-                                      empty.intersections = upset_empty_intersections(),
-                                      scale.sets = input$scale,
-                                      text.scale = input$text_size,
-                                      show.numbers = input$show.numbers,
-                                      mb.ratio = c(input$mb.ratio, 1 - input$mb.ratio)
-    )
-    return( upset )
+    upset_plot()
   }, height = reactive( { input$plot_height } ),
   width = reactive( { input$plot_width } )
   )
 
+  #Generating download handlers for each plot (downloadHandler functions)
+
+  #function to generate download handlers for the plots
+  download_plot <- function(name, plot_obj) {
+    downloadHandler(
+      filename = function() {
+        name
+      },
+      content = function(file) {
+        ggplot2::ggsave(file, plot = plot_obj,
+                        limitsize = FALSE,
+                        height = input$plot_height,
+                        width = input$plot_width,
+                        units = 'px', dpi = 'screen'
+        )
+      }
+    )
+  }
+
+
+  output$download_summary <- download_plot('summary_plot.png', summary_plot())
+
+  output$download_venn <- download_plot('venn_plot.png', venn_plot())
+
+  output$download_upset <- download_plot('upset_plot.png', upset_plot())
+
+
   # Function to merge multiple input_files
   merge_input_files <- reactive({
     input_files <- input$unmerged_files$datapath

inst/biblioverApp/ui.R

@@ -145,6 +145,8 @@ plot_settings <- tagList(
 
 results_summary_plot <- tabPanel("Summary",
                                  actionButton("modify_summary", "Modify plot", class = 'custom_button'),
+                                 downloadButton("download_summary", "Download plot", class = 'custom_button'),
+
                                  conditionalPanel(
                                    condition = "input.modify_summary % 2 == 1",
                                    fluidRow(
@@ -167,6 +169,7 @@ results_summary_plot <- tabPanel("Summary",
 
 results_venn <- tabPanel("Venn Diagram",
                          actionButton("modify_venn", "Modify plot", class = 'custom_button'),
+                         downloadButton("download_venn", "Download plot", class = 'custom_button'),
                          conditionalPanel(
                            condition = "input.modify_venn % 2 == 1",
                            fluidRow(
@@ -209,6 +212,7 @@ results_venn <- tabPanel("Venn Diagram",
 results_upset <-  tabPanel("UpSet Plot",
                            #tags$br(),
                            actionButton("modify_upset", "Modify plot", class = 'custom_button'),
+                           downloadButton("download_upset", "Download plot", class = 'custom_button'),
                            conditionalPanel(
                              condition = "input.modify_upset % 2 == 1",
                              fluidRow(