r - 将可旋转输出导出为图像

Question

我最近开始使用 rPivotTable 制作一些令人印象深刻的图表和表格。我在 Shiny 应用程序中使用 rPivotTable。我想知道是否可以从网络浏览器将 rPivotTable（表格、条形图、折线图等）的输出导出为图像。在 RStudio（没有 Shiny）中，它可以完成，因为查看器有一个 Export->Save as Image 选项。有什么办法可以保存图表和表格。

Answer 1

PivotTable 是一个 htmlwidget，因此您可以使用htmlwidgets::saveWidget将表保存在 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)