Как мы можем загрузить таблицу рендеринга в формате pdf в R shiny без потери тегов HTML, которые я использовал в таблице

Question

Код таблицы в блестящем r:

  output$TextTable <- renderTable({
    varsub
  }, width = "92%", include.colnames = TRUE, spacing = "xs",
  sanitize.text.function = identity)

## Я хочу загрузить этот рендеринг с помощью кнопки загрузки или ссылки.

Answer 1

Вот способ использования JavaScript библиотек jspdf и dom-to-image . Вы должны установить идентификатор таблицы в атрибуте data-tableid кнопки.

library(shiny)

js <- "
function tableExport(tableId){
  var $table = $(document.getElementById(tableId));
  var captionHeight = 8 + ($table.find('caption').height() || 0);
  var container = $table.parent();
  var $el = container.hasClass('tableContainer') ? container : $table;
  var width = $el.width();
  var height = $el.height() + captionHeight;
  domtoimage.toPng($el[0], {width: width, height: height})
    .then(function (blob) {
      var pdf = new jsPDF('l', 'pt', [width, height]);
      pdf.addImage(blob, 'PNG', 0, 0, width, height);
      pdf.save('table.pdf');
    });
}
"

CSS <- "
.tableContainer>* {
  margin-top: 0;
}
"

ui <- fluidPage(
  tags$head(
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/jspdf/1.5.3/jspdf.min.js"),
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/dom-to-image/2.6.0/dom-to-image.min.js"),
    tags$script(HTML(js)),
    tags$style(HTML(CSS))
  ),
  br(),
  tableOutput("theTable"),
  actionButton(
    "export", "Export table to PDF", 
    "data-tableid" = "theTable", 
    onclick = "tableExport($(this).data('tableid'));"
  )
)

server <- function(input, output, session){
  
  output[["theTable"]] <- renderTable({
    data.frame(
      col1 = c("<span style='color:red;'>AAA</span>", "BBB"),
      col2 = c("CCC", "DDD")
    )
  }, width = "92%", include.colnames = TRUE, spacing = "xs",
  sanitize.text.function = identity, 
  caption = "My table", caption.placement = "bottom")
  
}

shinyApp(ui, server)

Если вы хотите добавить заголовок к таблице, действуйте следующим образом:

  div(class = "tableContainer", 
      tags$h3("Table title"),
      tableOutput("theTable")
  )

Answer 2

Добавьте это в раздел сервера:

output$downloadData <- downloadHandler(
        filename = function() {
            paste("test.csv")
        },
        content = function(file) {
            write.csv(varsub(), file, row.names = FALSE)
        }
    )

Затем добавьте это рядом с вашим пользовательским интерфейсом, например:

tableOutput("TextTable"),
           downloadButton("downloadData", "Download")

Вы также можете обратиться к этой документации https://shiny.rstudio.com/reference/shiny/0.14/downloadHandler.html