如何在Shiny中獲取ggplot以動態保存與應用程式中顯示的比例相同的圖形？

我在這里找到了一些類似于我正在尋找的區域的答案，但不是我需要的。我希望你能幫忙！

我有一個帶有大量圖表的大型應用程式，如果用戶需要，需要保存它們。為了在某??種程度上自動保存，@stefan 幫助我解決了Is it possible to have a function to download various ggplot plots?

一切都很好。但是，在進行一些探索性資料分析時，用戶可能想要調整其直方圖的縱橫比。我已經弄清楚如何允許用戶在應用程式視窗中更改圖形大小，但我不知道如何讓保存的版本匹配。無論設定如何，它似乎都采用您第一次擁有的任何設定，然后將所有后續保存保存到該設定。

這似乎是一個反應性問題，但我認為我正在將當前寬度和高度發送到保存圖形的模塊。

這是一個有點 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)

uj5u.com熱心網友回復：

您應該將hist_width和hist_height反應函式傳遞給模塊服務器，而不是它們的值：

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

然后呼叫服務器本身的值：

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

否則，服務器將使用它獲得的第一個值進行初始化，并且不會更新它們。

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)

標籤：rggplot2闪亮的

上一篇：沒有明顯原因的Rmerge_element()錯誤（ggplot2）

下一篇：ggplot在geom_map下面的圖例中添加國家名稱