将R Shiny页面导出为PDF

时间:2016-10-26 21:36:06

标签: r shiny knitr r-markdown

我有一个大型的Shiny应用程序,它有许多提示,然后根据这些输入生成表格和绘图。我不使用rmarkdown或knitr或任何东西来格式化输出。我只使用标准的Shiny元素(sidebarPanel,mainPanel等)。对于图和表,我使用标准的反应式renderPlot和renderTable对象。 我正在寻找一种简单的方法来获得一个名为“导出为PDF”的按钮,该按钮将页面上的元素导出为PDF文档。

我已经研究过使用knitr和rmarkdown来生成一些带有一些花哨格式的文档(例如,参见herehere)。 问题是我似乎需要在一个downloadHandler对象中的Rmd文件或server.R中重新生成表和图,我想避免这种情况。

有没有办法更轻松地将页面输出为pdf。更具体地说,有没有办法直接引用Rmd文件中的输出表和图(即输出$对象),这样就不需要生成两次绘图和表格。

编辑:这是一些简化的代码。注意getDataset()是一个响应函数,它根据输入查询数据库。 我的目标是简单地添加一个“导出”按钮,用于导出已生成的图和表。 (另外作为旁注,有什么方法可以得到在所有被动元素之间共享的被动数据集?即不需要在每个对象中都有ds< - getDataset()?)

服务器

output$hist <- renderPlot({
  ds <- getDataset()
  # do data transformations

  ggplot(ds, aes(val)) +
    geom_histogram(binwidth = binSize, aes(fill = ..count..)) +
    labs(title = "val dist", x = "val", y = "Count") + 
    scale_fill_gradient("Count", low = "green", high = "red", guide = FALSE) +
    scale_x_continuous(limits = c(min(ds$val), quantile(ds$val, 0.99))) +
    geom_hline(yintercept=maxY, linetype=3)
})

output$time <- renderPlot({
  ds <- getDataset()
  # do data transformations
  ggplot(ds, aes(as.POSIXlt(unixTime, origin="1970-01-01", tz="UTC"), val), colour = val) +
    scale_y_continuous(limits = c(min(ds$val), quantile(ds$val, 0.99))) +
    labs(title = "Val Over Time", x = "Time (UTC)", y = "val (ms)") +
    geom_point(alpha = 0.3, size = 0.7) +
    geom_smooth()
})
output$stats <- renderTable({
  statsDf = getDataset()
  # do data transformations
  statsDf
})

UI

ui <- fluidPage(
  titlePanel("Results"),

  sidebarLayout(
    sidebarPanel(
      dateInput("startDateTime", "Start Date:", value = "2016-10-21"),
      textInput("startTime", "Start Time", "00:00:00"),
      br(),
      dateInput("endDateTime", "End Date:", value = "2016-10-21"),
      textInput("endTime", "End Time", value = "02:00:00"),
      br(),
      submitButton("Submit")
    ),
    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("Plots",
                           plotOutput("hist"),
                           plotOutput("time"),
                  tabPanel("Statistics", tableOutput("stats"))
      )
    )
  )
)

1 个答案:

答案 0 :(得分:8)

首先,您应该真正生成一个可重现的示例,而不仅仅是代码示例。我们应该复制并粘贴您的代码,它将运行。

想法

  1. 由于您使用ggplot2作为grid图表之王的gridExtra,我认为保存图表/表格的一个简单选项是使用grid.arrange包。使用arrangeGrobsreactiveValues,您可以将grob保存到预定义设备。然后,downloadhandler将进行下载。

  2. 为了不每次重新生成所有绘图,我认为一种解决方案是将它们保存在每次更改绘图时更新的全局变量中。这里library(shiny) shinyUI(fluidPage( # Application title titlePanel("Save ggplot plot/table without regenration"), # Sidebar with a slider input for number of bins sidebarLayout( sidebarPanel( downloadButton('export') ), # Show a plot of the generated distribution mainPanel( plotOutput("p1"), plotOutput("p2"), tableOutput("t1") ) ) )) 进行救援以存储情节和表格广告动态变量。

  3. 解决方案

    ui.R

    library(shiny)
    library(ggplot2)
    library(gridExtra)
    
    shinyServer(function(input, output) {
      ## vals will contain all plot and table grobs
      vals <- reactiveValues(p1=NULL,p2=NULL,t1=NULL)
    
      ## Note that we store the plot grob before returning it 
      output$p1 <- renderPlot({
        vals$p1 <- qplot(speed, dist, data = cars)
        vals$p1
      })
    
      output$p2 <- renderPlot({
        vals$p2 <- qplot(mpg, wt, data = mtcars, colour = cyl)
        vals$p2
      })
      ## same thing for th etable grob
      output$t1 <- renderTable({
        dx <- head(mtcars)
        vals$t1 <- tableGrob(dx)
        dx
      })
      ## clicking on the export button will generate a pdf file 
      ## containing all grobs
      output$export = downloadHandler(
        filename = function() {"plots.pdf"},
        content = function(file) {
         pdf(file, onefile = TRUE)
         grid.arrange(vals$p1,vals$p2,vals$t1) 
         dev.off()
        }
      )
    })
    

    server.R

    someDataService.get()
       .then(function(res) {
         var keys = Object.keys(res.data).splice(1,2);
         angular.forEach(keys, function(key){
            $scope[key] = res.data[key];
         });
         return $q.when();
       }