downPlot.R 2.4 KB
Newer Older
dmattek's avatar
dmattek committed
1 2 3 4 5
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for downloading pdf of the plot
dmattek's avatar
dmattek committed
6 7 8 9 10 11 12
# Use:
# in ui.R
# downPlotUI('uniqueID', "your_label")
#
# in server.R
# callModule(downPlot, "uniqueID", 'fname.pdf', input_plot_to_save)

dmattek's avatar
dmattek committed
13
# UI ----
dmattek's avatar
dmattek committed
14 15 16 17 18 19 20 21
downPlotUI <- function(id, label = "Download Plot") {
  ns <- NS(id)
  
  tagList(
    # Label to display as h4 header
    h4(label),
    
    fluidRow(
dmattek's avatar
dmattek committed
22 23 24 25 26 27 28 29 30 31 32
      # CSS to make label next to text input
      # From: https://stackoverflow.com/a/45299050/1898713
      tags$head(
        tags$style(type="text/css", 
        "#inline label{ display: table-cell; text-align: center; vertical-align: middle; } #inline .form-group { display: table-row;}")
      ),
      

      column(3,
             uiOutput(ns('uiDownButton'))
             ),
dmattek's avatar
dmattek committed
33 34
      column(
        3,
dmattek's avatar
dmattek committed
35 36 37 38
        tags$div(id = "inline", 
                 numericInput(
                   ns('inPlotWidth'),
                   "Width [in]",
majpark21's avatar
majpark21 committed
39
                   11,
dmattek's avatar
dmattek committed
40 41 42
                   min = 1,
                   width = 100
                   )
dmattek's avatar
dmattek committed
43 44 45 46
        )
      ),
      column(
        3,
dmattek's avatar
dmattek committed
47 48 49 50
        tags$div(id = "inline", 
                 numericInput(
                   ns('inPlotHeight'),
                   "Height [in]",
majpark21's avatar
majpark21 committed
51
                   8.5,
dmattek's avatar
dmattek committed
52 53 54
                   min = 1,
                   width = 100
                 )
dmattek's avatar
dmattek committed
55
        )
dmattek's avatar
dmattek committed
56
      )
dmattek's avatar
dmattek committed
57 58 59 60
    )
  )
}

dmattek's avatar
dmattek committed
61 62
# SERVER ----

dmattek's avatar
dmattek committed
63 64
downPlot <- function(input, output, session, in.fname, in.plot, in.gg = FALSE) {

dmattek's avatar
dmattek committed
65 66 67
  output$uiDownButton = renderUI({
    ns <- session$ns
    
68
    if (in.fname() %like% 'pdf') {
dmattek's avatar
dmattek committed
69 70 71 72 73 74 75
      downloadButton(ns('downPlot'), 'PDF')
    } else {
      downloadButton(ns('downPlot'), 'PNG')
    }
    
  })
  
dmattek's avatar
dmattek committed
76 77
  output$downPlot <- downloadHandler(
    filename = function() {
78 79
      cat(in.fname(), "\n")
      in.fname()
dmattek's avatar
dmattek committed
80 81 82 83 84 85 86 87 88 89 90 91
    },
    
    content = function(file) {
      if (in.gg) {
        ggsave(
          file,
          limitsize = FALSE,
          in.plot(),
          width  = input$inPlotWidth,
          height = input$inPlotHeight
        )
      } else {
92
        if (in.fname() %like% 'pdf') {
dmattek's avatar
Mod:  
dmattek committed
93 94 95 96 97 98 99 100 101
          pdf(file,
              width  = input$inPlotWidth,
              height = input$inPlotHeight)
        } else {
          png(file,
              width  = input$inPlotWidth,
              height = input$inPlotHeight, units = 'in', res = 300)
        }
        
dmattek's avatar
dmattek committed
102 103 104 105 106 107 108 109
        
        in.plot()
        dev.off()
      }
    }
  )
  
}