Экспорт данных с изображениями в PDF

Question

Я пытаюсь создать приложение Shiny, которое генерирует две таблицы рядом (или одну прокручиваемую таблицу, в которой всегда отображается первый столбец).Первая таблица будет содержать изображение дома с некоторыми ключевыми характеристиками (размер, возраст и т. Д.). Вторая таблица будет представлять собой таблицу с прокруткой, показывающую один или несколько похожих домов с изображениями и характеристиками.

Моя конечная цельдля пользователя, чтобы иметь возможность выбрать / отменить выбор аналогичных домов, которые они хотят видеть, а затем экспортировать их в формате PDF или аналогичные.В идеале это будет работать с любым количеством выбранных домов, используя несколько страниц (с основным домом на каждом), если их слишком много, чтобы поместиться на одной странице, например

Первая часть приложения работает с использованием таблиц данных.Мой вопрос: как вы экспортируете таблицы данных без потери изображений?Желательно, чтобы я мог экспортировать две таблицы рядом, как описано выше.Это возможно?Есть ли лучший способ сделать это?Вот воспроизводимый игрушечный пример того, что у меня есть:

UI

library(shiny)

shinyUI(fluidPage(

  # Application title
  titlePanel("Tables to export"),

  sidebarLayout(
    sidebarPanel(
      downloadButton('export')
    ),

    # Show tables
    mainPanel(
      fluidRow(
        column(3, DT::dataTableOutput('t1')),  
        column(9,style="overflow-x:scroll;",DT::dataTableOutput('t2'))
      )
    )
  )
))

Сервер

library(shiny)
library(ggplot2)
library(gridExtra)
library(DT)

shinyServer(function(input, output) {

  p1 <- '<img src="http://www.dailyexcelsior.com/wp-content/uploads/2019/01/house.jpg" width=150 height=100>'
  p2 <- '<img src="http://www.pd.co.th/uploads/content/2017/10/o_1brg6i1m25is1hnng571876544a.jpg" width=150 height=100>'
  p3 <- '<img src="https://www.harronhomes.com/wp-content/uploads/2015/02/Birkwith-330x192-24-June-EDIT1.jpg" width=150 height=100>'
  p4 <- '<img src="https://m.persimmonhomes.com/images/the-rockcliff_133414.jpg" width=150 height=100>'
  p5 <- '<img src="https://www.ryanhomes.com/rh-community-gallery-NewAspectRatio/d8b0c394-b123-4d9d-957b-1d24e21d319f/db/d8b0c394-b123-4d9d-957b-1d24e21d319f.jpg" width=150 height=100>'
  p6 <- '<img src="https://www.iconichouses.org/foto/houses/duldeck.jpg" width=150 height=100>'

  t1 <- datatable(t(data.frame("Pic"=p1,Size=1500,Age=5,Bathrooms=2,row.names="p1")), 
                  escape = F, options = list(dom = 't',pageLength = 20))

  t2 <- datatable(t(data.frame("Pic"=c(p2,p3,p4,p5,p6),Size=c(1500,1200,1400,1600,1300),Age=c(5,15,10,7,12),Bathrooms=c(1.5,2,2,1.5,2),
                         row.names=c("p2","p3","p4","p5","p6"))), 
            escape = F, options = list(dom = 't',pageLength = 20,width="100%") )

  output$t1 <-  renderDataTable(t1)

  output$t2 <- renderDataTable(t2)

  output$export = downloadHandler(
    filename = "plots.pdf",#function() {"plots.pdf"},
    content = function(file) {
      pdf(file, onefile = TRUE)
      # Something here???
      dev.off()
    }
  )
})

Answer 1

Вы можете сохранить данные в html-файле с помощью saveWidget (в пакете htmlwidget, но он импортирован в DT) и сделать снимок в формате PDF с помощью webshot::webshot:

library(DT)
library(webshot)

p2 <- '<img src="http://www.pd.co.th/uploads/content/2017/10/o_1brg6i1m25is1hnng571876544a.jpg" width=150 height=100>'
p3 <- '<img src="https://www.harronhomes.com/wp-content/uploads/2015/02/Birkwith-330x192-24-June-EDIT1.jpg" width=150 height=100>'
p4 <- '<img src="https://m.persimmonhomes.com/images/the-rockcliff_133414.jpg" width=150 height=100>'
p5 <- '<img src="https://www.ryanhomes.com/rh-community-gallery-NewAspectRatio/d8b0c394-b123-4d9d-957b-1d24e21d319f/db/d8b0c394-b123-4d9d-957b-1d24e21d319f.jpg" width=150 height=100>'
p6 <- '<img src="https://www.iconichouses.org/foto/houses/duldeck.jpg" width=150 height=100>'

dtable <- datatable(
  t(data.frame(
    Pic = c(p2,p3,p4,p5,p6), 
    Size = c(1500,1200,1400,1600,1300), 
    Age = c(5,15,10,7,12), 
    Bathrooms = c(1.5,2,2,1.5,2),
    row.names = c("p2","p3","p4","p5","p6"))), 
  escape = FALSE, 
  options = list(
    dom = 't', 
    pageLength = 20, 
    width = "100%")
)

html <- "dtable.html"
saveWidget(dtable, html)
webshot(html, "dtableSnapshot.pdf")

Для двух таблиц вы можете использовать пакет xml2 для вставки второй таблицы в html-файл первой таблицы:

p1 <- '<img src="http://www.dailyexcelsior.com/wp-content/uploads/2019/01/house.jpg" width=150 height=100>'
p2 <- '<img src="http://www.pd.co.th/uploads/content/2017/10/o_1brg6i1m25is1hnng571876544a.jpg" width=150 height=100>'
p3 <- '<img src="https://www.harronhomes.com/wp-content/uploads/2015/02/Birkwith-330x192-24-June-EDIT1.jpg" width=150 height=100>'
p4 <- '<img src="https://m.persimmonhomes.com/images/the-rockcliff_133414.jpg" width=150 height=100>'
p5 <- '<img src="https://www.ryanhomes.com/rh-community-gallery-NewAspectRatio/d8b0c394-b123-4d9d-957b-1d24e21d319f/db/d8b0c394-b123-4d9d-957b-1d24e21d319f.jpg" width=150 height=100>'
p6 <- '<img src="https://www.iconichouses.org/foto/houses/duldeck.jpg" width=150 height=100>'

dtable1 <- datatable(
  t(data.frame(
    "Pic" = p1, 
    Size = 1500, 
    Age = 5, 
    Bathrooms = 2, 
    row.names = "p1")), 
  escape = FALSE, 
  height = 300,
  options = list(
    dom = 't', 
    pageLength = 20)
)

dtable2 <- datatable(
  t(data.frame(
    Pic = c(p2,p3,p4,p5,p6), 
    Size = c(1500,1200,1400,1600,1300), 
    Age = c(5,15,10,7,12), 
    Bathrooms = c(1.5,2,2,1.5,2),
    row.names = c("p2","p3","p4","p5","p6"))), 
  escape = FALSE, 
  options = list(
    dom = 't', 
    pageLength = 20)
)

# save tables as html
saveWidget(dtable1, "dtable1.html")
saveWidget(dtable2, "dtable2.html", selfcontained = FALSE)

# read the html files in R lists
library(xml2)
list1 <- as_list(read_html("dtable1.html"))
list2 <- as_list(read_html("dtable2.html"))
div2 <- list2$html$body$div[1:3]
scripts2 <- list2$html$body[4:5]

# # change default style "width:960px;height:500px;"
# # that doesn't work, actually the dimensions are set by JavaScript
# # => use the width/height options of datatable()
# attr(list1$html$body$div$div, "style") <- attr(div2$div, "style") <- "width: 100%;"

# "stack" the two datatables
list12 <- list1
list12$html$body$div <- c(list12$html$body$div, div2)
list12$html$body <- c(list12$html$body, scripts2)

# set the attributes because they are lost
attr(list12$html$body$div, "id") <- "htmlwidget_container"
attr(list12$html$body, "style") <- attr(list1$html$body, "style")

# create new html file
html12 <- as_xml_document(list12)
write_html(html12, "dtables.html", options = "as_html")

# snapshot
webshot("dtables.html", "dtablesSnapshot.pdf")