如何将闪亮的应用图像下载到 Rmarkdown pdf 中？

Question

我想在闪亮的网络上上传图像和文本（不是代码中的插图），然后下载为 PDF 文档。

我被困在将图像下载到 PDF 文档中。

在“output$report

library(shiny)

ui<-navbarPage("Report",
                 tabPanel("Upload Images", uiOutput('page1')),
                 tabPanel("Input Text", uiOutput('page2')),
                 tabPanel("Download Report", uiOutput('page3'))
)

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


    output$page1 <- renderUI({
        fluidPage(
            fluidRow(
                column(5,
                       fileInput(inputId = 'files', 
                                 label = 'Select 1st Image',
                                 multiple = TRUE,
                                 accept=c('image/png', 'image/jpeg'),
                                 width = '400px')
                       ))) }) 

output$page2 <- renderUI({
        fluidPage(
            fluidRow(
                column(8,
                       textInput("Text1", "(1)", " ",width = '600px')
                       #verbatimTextOutput("Value1")
                       ),
                column(4, uiOutput('Image1'))
            ))
    })

    files <- reactive({
        files <- input$files
        files$datapath <- gsub("\\\\", "/", files$datapath)
        files
    })


    output$Image1 <- renderUI({
        if(is.null(input$files)) return(NULL)
        image_output_list <- 
            lapply(1:nrow(files()),
                   function(i)
                   {
                       imagename = paste0("image", i)
                       imageOutput(imagename)
                   })

        do.call(tagList, image_output_list)
    })

    IMAGE1 <- observe({
        if(is.null(input$files)) return(NULL)
        for (i in 1:nrow(files()))
        {
            print(i)
            local({
                my_i <- i
                imagename = paste0("image", my_i)
                print(imagename)
                output[[imagename]] <- 
                    renderImage({
                        list(src = files()$datapath[my_i], 
                             width = 250,
                             height = 250,
                             alt = "Image failed to render")
                    }, deleteFile = FALSE)
            })
        }
    })   ######!!!! Parms cannot be observe or output$Image1 




    output$page3 <- renderUI({ downloadButton("report", "Generate report")})

    output$report <- downloadHandler(
        filename = "report.pdf",
        content = function(file) {
            tempReport <- file.path(tempdir(), "VIWpdf.Rmd")
            file.copy("VIWpdf.Rmd", tempReport, overwrite = TRUE)
            params <- list(
                Text1 = input$Text1,
                Image1 =  IMAGE1 ######!!!!!Here this the Problem######
                )


            out<- rmarkdown::render(tempReport, output_file = file,
                                    params = params,
                                    envir = new.env(parent = globalenv()))
            file.rename(out, file) 
        }
    )}
shinyApp(ui=ui,server=server)

这是.rmd

---
title: "Report"
date: "`r format(Sys.time(), '%d %B, %Y')`"
always_allow_html: yes
output: 
  pdf_document:
    fig_caption: yes
    keep_tex: yes
    toc: true
    toc_depth: 2
params:
  Text1: 'NULL'
  Image1: 'NULL'

---
(1) `r params$Text1`  

`r params$Image1`  

我希望图像的输出可以显示在 Rmarkdown PDF 中，但实际输出为空。

Answer 1

您的renderImage 语句通过解析图像的路径来工作。同样，在渲染Rmd 时，您需要将图像的路径传递给params。您还希望将图像复制到tempdir。最后，在Rmd 中，您需要在链接到图像文件时评估params$Image 内联。

以下是所需的更改：

1. Rmd 应该是这样的。请注意，我们在链接到图像文件r paste0(params$Image1) 时粘贴了params$Image1 的值

---
title: "Report"
date: "`r format(Sys.time(), '%d %B, %Y')`"
always_allow_html: yes
output: 
  pdf_document:
  fig_caption: yes
  keep_tex: yes
  toc: true
  toc_depth: 2
params:
  Text1: 'NULL'
  Image1: 'NULL'

---

```{r}
message("this is the text passed as a parameter")
message(params$Text1)
## Omitting one tick mark to render 'correctly' in SO answer
``

Here is the image

![Some image](`r paste0(params$Image1)`)

1. 接下来，在downloadHandler 内部，我们使用input$files 而不是IMAGE1（观察者不返回值），因为我们需要的只是所选图像的路径。此外，我们需要将图像复制到相同的tempdir，Rmd 被渲染。下载处理程序应如下所示（注意，我更改了 Rmd 的名称）：

  output$report <- downloadHandler(
    filename = "report.pdf",
    content = function(file) {
      tempReport <- file.path(tempdir(), "image.rmd")
      file.copy("image.rmd", tempReport, overwrite = TRUE)
      # copy the image to the tempdir
      # otherwise `render` will not know where it is
      imgOne <- file.path(tempdir(), input$files[[1]])
      file.copy(input$files[[1]], imgOne, overwrite = TRUE)

      params <- list(Text1 = input$Text1,
      # pass the path to the image in the tempdir
                     Image1 =  imgOne)

      out <- rmarkdown::render(
        tempReport,
        output_file = file,
        params = params,
        envir = new.env(parent = globalenv())
      )
      file.rename(out, file)
    }
  )

1. 在downloadHandler 中，您需要遍历要复制到tempdir 的图像列表并将一个元素添加到params 列表中。在Rmd 中，您需要遍历params$Image* 以创建指向所有图像的链接。

---

适合我的完整应用，只有 1 张图片：

library(shiny)

ui <- navbarPage(
  "Report",
  tabPanel("Upload Images", uiOutput('page1')),
  tabPanel("Input Text", uiOutput('page2')),
  tabPanel("Download Report", uiOutput('page3'))
)

server <- function(input, output, session) {
  output$page1 <- renderUI({
    fluidPage(fluidRow(column(
      5,
      fileInput(
        inputId = 'files',
        label = 'Select 1st Image',
        multiple = TRUE,
        accept = c('image/png', 'image/jpeg'),
        width = '400px'
      )
    )))
  })

  output$page2 <- renderUI({
    fluidPage(fluidRow(column(
      8,
      textInput("Text1", "(1)", " ", width = '600px')
      #verbatimTextOutput("Value1")
    ),
    column(4, uiOutput('Image1'))))
  })

  files <- reactive({
    files <- input$files
    files$datapath <- gsub("\\\\", "/", files$datapath)
    files
  })


  output$Image1 <- renderUI({
    if (is.null(input$files))
      return(NULL)
    image_output_list <-
      lapply(1:nrow(files()),
             function(i)
             {
               imagename = paste0("image", i)
               imageOutput(imagename)
             })

    do.call(tagList, image_output_list)
  })

  observe({
    if (is.null(input$files))
      return(NULL)
    for (i in 1:nrow(files()))
    {
      print(i)
      print(input$files[[i]])
      local({
        my_i <- i
        imagename = paste0("image", my_i)
        print(imagename)
        output[[imagename]] <-
          renderImage({
            list(
              src = files()$datapath[my_i],
              width = 250,
              height = 250,
              alt = "Image failed to render"
            )
          }, deleteFile = FALSE)
      })
    }
  })   ######!!!! Parms cannot be observe or output$Image1

  output$page3 <-
    renderUI({
      downloadButton("report", "Generate report")
    })

  output$report <- downloadHandler(
    filename = "report.pdf",
    content = function(file) {
      tempReport <- file.path(tempdir(), "image.rmd")
      file.copy("image.rmd", tempReport, overwrite = TRUE)
      imgOne <- file.path(tempdir(), input$files[[1]])
      file.copy(input$files[[1]], imgOne, overwrite = TRUE)

      params <- list(Text1 = input$Text1,
                     Image1 =  imgOne) ######!!!!!Here this the Problem######

      out <- rmarkdown::render(
        tempReport,
        output_file = file,
        params = params,
        envir = new.env(parent = globalenv())
      )
      file.rename(out, file)
    }
  )

}

shinyApp(ui = ui, server = server)