How can I get ggplot within Shiny to dynamically save a graph in the same scale as shown in the app?-CodePudding

I have found a few answers here that area similar to what I am looking for, but not quite what I need. I am hoping you can help out!

I have a large app with a lot of graphs that need to be saved if the user wants them. To somewhat automate saving, @stefan helped me out in Is it possible to have one function to download various ggplot plots?

All works great. However, when doing some exploratory data analysis the user might want to tweak the aspect ratio of their histograms . I have figured out how to allow the user to change the graph size in the app window, but I can't figure out how to get the saved version to match. It seems to take whatever setting you have the first time and then save all subsequent saves to that, regardless of setting.

That seems like a reactive issue, but I think I am sending the current width and height to the module that saves the graphic.

Here is a somewhat MRE:

library(shiny)
library(ggplot2)

######Save plot modules
downloadButtonUI <- function(id) {
  downloadButton(NS(id, "dl_plot"))
}
downloadSelectUI <- function(id) {
  pickerInput(NS(id, "format"), label = "Format: ", choices = c("eps","ps","tex","pdf","jpeg","tiff","png","bmp","svg","wmf","emf"),selected = "svg",width = "75px")
}
downloadServer <- function(id, plot,height=NA,width=NA) {
  moduleServer(id, function(input, output, session) {
    output$dl_plot <- downloadHandler(
      filename = function() {
        file_format <- tolower(input$format)
        paste0(id, ".", file_format)
      },
      content = function(file) {
        ggsave(file, plot = plot(),height = height, width=width, units = "px")
      }
    )
  })
}

ui <- fluidPage(

    titlePanel("Old Faithful Geyser Data"),

    sidebarLayout(
        sidebarPanel(
            sliderInput("hist_width",
                        "Width",
                        min = 300,
                        max = 1600,
                        value = 800,
                        step = 100),
            sliderInput("hist_height",
                        "Height",
                        min = 300,
                        max = 1600,
                        value = 800,
                        step = 100)
        ),

        # Show a plot of the generated distribution
        mainPanel(
           plotOutput("histo_plot",width = "auto",height = "auto"),
           fluidRow(
             column(3, downloadButtonUI("histoplot")),
             column(3,downloadSelectUI("histoplot")
                    )
           )
        )
    )
)

server <- function(input, output) {
  
  #global reactives
  hist_width<-reactive(input$hist_width)
  hist_height<-reactive(input$hist_height)
  
  ###Allows downloading of histograms
  output$histo_plot<-renderPlot(histo_plot(),width = hist_width,height = hist_height)
  
  downloadServer("histoplot", histo_plot, width=hist_width(),height = hist_height())
  ###

    histo_plot <- reactive({
        x    <- data.frame(faithful[, 2])
        names(x)<-"Data"
        
        # draw the histogram
        
        ggplot(x,aes(x=Data)) 
          geom_histogram() 
          ggtitle("Data")
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

CodePudding user response：

You should pass the hist_width and hist_height reactive functions to the module server, not their values :

downloadServer("histoplot", histo_plot, width=hist_width,height=hist_height)

And then call the values in the server itself:

ggsave(file, plot = plot(),height = height(), width=width(), units = "px")

Otherwise, the server get initialized with the first values it gets and doesn't update them.

library(shiny)
library(ggplot2)
library(shinyWidgets)

######Save plot modules
downloadButtonUI <- function(id) {
  downloadButton(NS(id, "dl_plot"))
}
downloadSelectUI <- function(id) {
  pickerInput(NS(id, "format"), label = "Format: ", choices = c("eps","ps","tex","pdf","jpeg","tiff","png","bmp","svg","wmf","emf"),selected = "svg",width = "75px")
}
downloadServer <- function(id, plot,height=NULL,width=NULL) {
  moduleServer(id, function(input, output, session) {
    output$dl_plot <- downloadHandler(
      filename = function() {
        file_format <- tolower(input$format)
        paste0(id, ".", file_format)
      },
      content = function(file) {
        ggsave(file, plot = plot(),height = height(), width=width(), units = "px")
      }
    )
  })
}

ui <- fluidPage(
  
  titlePanel("Old Faithful Geyser Data"),
  
  sidebarLayout(
    sidebarPanel(
      sliderInput("hist_width",
                  "Width",
                  min = 300,
                  max = 1600,
                  value = 800,
                  step = 100),
      sliderInput("hist_height",
                  "Height",
                  min = 300,
                  max = 1600,
                  value = 800,
                  step = 100)
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("histo_plot",width = "auto",height = "auto"),
      fluidRow(
        column(3, downloadButtonUI("histoplot")),
        column(3,downloadSelectUI("histoplot")
        )
      )
    )
  )
)

server <- function(input, output) {
  
  #global reactives
  hist_width<-reactive(input$hist_width)
  hist_height<-reactive(input$hist_height)
  
  ###Allows downloading of histograms
  output$histo_plot<-renderPlot(histo_plot(),width = hist_width,height = hist_height)
  
  downloadServer("histoplot", histo_plot, width=hist_width,height = hist_height)
  ###
  
  histo_plot <- reactive({
    x    <- data.frame(faithful[, 2])
    names(x)<-"Data"
    
    # draw the histogram
    
    ggplot(x,aes(x=Data)) 
      geom_histogram() 
      ggtitle("Data")
  })
}

# Run the application 
shinyApp(ui = ui, server = server)