将 rpivottable 输出导出为图像

Export rpivottable output as image

我最近开始使用 rPivotTable 制作一些令人印象深刻的图表和表格。我在闪亮的应用程序中使用 rPivotTable 。我想知道是否可以将 rPivotTable(Table、条形图、折线图等)的输出导出为 Web 浏览器中的图像。在 RStudio(没有 Shiny)中,它可以完成,因为查看器可以选择“导出”->“另存为图像”。有什么方法可以保存图表吗

数据透视表是一个 html 小部件,因此您可以使用 htmlwidgets::saveWidget 将 table 保存在 html 文件中,然后 webshot::webshot 将其导出到 png(或 pdf)。

library(shiny)
library(rpivotTable)
library(htmlwidgets)
library(webshot)

ui <- fluidPage(
  br(),
  rpivotTableOutput("pivotbl"),
  br(),
  downloadButton("export", "Export")
)

server <- function(input, output, session){

  pivotTable <- rpivotTable(
    Titanic,
    rows = "Survived",
    cols = c("Class","Sex"),
    aggregatorName = "Sum as Fraction of Columns",
    inclusions = list( Survived = list("Yes")),
    exclusions= list( Class = list( "Crew")),
    vals = "Freq",
    rendererName = "Table Barchart"
  )

  output[["pivotbl"]] <- renderRpivotTable({
    pivotTable
  })

  output[["export"]] <- downloadHandler(
    filename = function(){
      "pivotTable.png"
    },
    content = function(file){
      tmphtml <- tempfile(fileext = ".html")
      saveWidget(pivotTable, file = tmphtml)
      webshot(tmphtml, file = file)
    }
  )

}

shinyApp(ui, server)

编辑

这是一种仅导出图形的方法,使用 dom-to-image JavaScript 库。

下载文件 dom-to-image.min.js 并将其放入应用程序的 www 子文件夹中。

这是应用程序:

library(shiny)
library(rpivotTable)

js <- "
function filter(node){
  return (node.tagName !== 'i');
}
function exportPlot(filename){
  var plot = document.getElementsByClassName('pvtRendererArea');
  domtoimage.toPng(plot[0], {filter: filter, bgcolor: 'white'})
    .then(function (dataUrl) {
      var link = document.createElement('a');
      link.download = filename;
      link.href = dataUrl;
      link.click();
    });
}
Shiny.addCustomMessageHandler('export', exportPlot);
"

ui <- fluidPage(
  tags$head(
    tags$script(src = "dom-to-image.min.js"),
    tags$script(HTML(js))
  ),
  br(),
  rpivotTableOutput("pivotbl"),
  br(),
  actionButton("export", "Export")
)

server <- function(input, output, session){

  pivotTable <- rpivotTable(
    Titanic,
    rows = "Survived",
    cols = c("Class","Sex"),
    aggregatorName = "Sum as Fraction of Columns",
    inclusions = list( Survived = list("Yes")),
    exclusions= list( Class = list( "Crew")),
    vals = "Freq",
    rendererName = "Table Barchart"
  )

  output[["pivotbl"]] <- renderRpivotTable({
    pivotTable
  })

  observeEvent(input[["export"]], {
    session$sendCustomMessage("export", "plot.png")
  })  

}

shinyApp(ui, server)