2
votes

I want to upload images and text in shiny web (not inset image in code) , and then download as PDF document.

I am get stuck in download images into PDF document.

In "output$report <- downloadHandler(...)", params cannot be "observe" or "output$image". How to write the right params for the images?

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)

Here is the .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`  


I expect the output of image can show in the Rmarkdown PDF, but the actual output is empty.

1

1 Answers

1
votes

Your renderImage statements work by parsing the paths to the images. Similarly, you need to pass the paths to the images to params when rendering the Rmd. You also want the images copied to the tempdir. And finally, in the Rmd, you need evaluate the params$Image inline as you are linking to the image files.

Here are the required changes:

  1. The Rmd should read something like this. Note that we are pasting the value of params$Image1 when linking to the image file r paste0(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. Next, inside downloadHandler we work with input$files rather than IMAGE1 (observers don't return values) because all we need are the paths to the selected images. Also, we need to copy the images to the same tempdir where the Rmd gets rendered. The download handler should look like this (heads up, I changed the name of the 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. In downloadHandler you would need to loop over the list of images to copy to tempdir and add an element to the params list. In the Rmd you would need to loop over params$Image* to create the links to all the images.

Complete app that worked for me with 1 image only:

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)