使用 Shiny 更改大小并存储用户上传的图像文件

Question

我正在编写一个大型 Shiny Dashboard 脚本来从用户上传的文件中收集数据。其中一些文件是图像。该脚本通过ui 会话中的fileInput 获取文件。通常，用户上传高分辨率图像，但我不需要存储此类文件，因此脚本将大小减小到 height = 200 以便将其定向到outputImage。它将文件发送到 Google Drive（没问题），但我想发送低分辨率文件。我试图从output$showphotos1 阅读它们，但是 部分脚本：

    ui <- dashboardPage(
               fileInput("loadphotos", label="Carregar fotos", multiple=T),
                          actionButton("do", "Carregar"),
                          imageOutput("showphotos1", height="200px"),
                          imageOutput("showphotos2", height="200px"),
                          imageOutput("showphotos3", height="200px")
    )
    
    server <- function(input, output, session) {
      observeEvent(input$do, {
        lst <- NULL
        for(i in 1:length(input$loadphotos[,1])) {
          lst[[i]] <- input$loadphotos[[i, 'datapath']]
        }
        output$showphotos1 <- renderImage({list(src=lst[[1]], height="200")})
        output$showphotos2 <- renderImage({list(src=lst[[2]], height="200")})
        output$showphotos3 <- renderImage({list(src=lst[[3]], height="200")})

#        drive_upload(output$showphotos1$datapath, 
#               as_id("https://drive.google.com/drive/u/1/folders/1qj0eeee...")
#       This gives an error: "Error in $.shinyoutput: Reading from shinyoutput object     
#       is not allowed." So I used the lines bellow, that uploads large files from     
#       the input:

         drive_upload(input$loadphotos,
                as_id("https://drive.google.com/drive/u/1/folders/1qj0eeee...")
        })
    }

我想存储 output$showphotos 中的较小文件 (200px)，而不是 input@loadphotos 中的较大文件。我不精通R，如果有人能给我简单的解决方案，我将不胜感激。也欢迎提出避免每个图像文件重复代码的建议。

Answer 1

我们可以使用magick::image_scale() 调整图像大小，然后将它们保存在工作目录中（或者可能创建临时文件），因为drive_update 将路径作为media 参数。

避免代码重复的版本：

library(shiny)
library(magick)
library(tidyverse)
library(googledrive)

n_showphotos <- 3

ui <- fluidPage(
    fileInput("loadphotos", label = "Carregar fotos", multiple = TRUE),
    actionButton("do", "Carregar"),
    tagList(
    map(str_c('showphotos', 1:n_showphotos), ~imageOutput(.x, height = '200px')))
)

server <- function(input, output, session) {
    
    observeEvent(input$do, {
        

        lst <- NULL
        for (i in 1:length(input$loadphotos[,1])) {
            lst[[i]] <- input$loadphotos[[i, 'datapath']]
        }
        
        lst %>%
            map2(str_c('showphotos', 1:length(.)),~ { output[[.y]] <- renderImage({list(src = .x, height="200")},deleteFile = FALSE) })
        
        #a list with all the images but resized to 200
        #"x200" to resize by height
        images_resized <- lst %>% 
            map(~image_scale(image = image_read(.x), "200"))
        
        #images will be located in the project directory or home folder (getwd() to get working directory if in doubt)
        images_resized %>%
            walk2(str_c('image', 1:length(.)), ~ image_write(.x, path = str_c(.y, '.png'), format = "png"))
        
        
        #        drive_upload(image1.png, 
        #               as_id("https://drive.google.com/drive/u/1/folders/1qj0eeee...")
   
    })
    
}

shinyApp(ui, server)

代码重复：

library(tidyverse)
library(googledrive)
library(shiny)
library(magick)

ui <- fluidPage(
    fileInput("loadphotos", label="Carregar fotos", multiple=T),
    actionButton("do", "Carregar"),
    imageOutput("showphotos1", height="200px"),
    imageOutput("showphotos2", height="200px"),
    imageOutput("showphotos3", height="200px")
)

server <- function(input, output, session) {
    observeEvent(input$do, {
        lst <- NULL
        req(input$loadphotos)
        for(i in 1:length(input$loadphotos[,1])) {
            lst[[i]] <- input$loadphotos[[i, 'datapath']]
        }
        output$showphotos1 <- renderImage({list(src=lst[[1]], height="200")})
        output$showphotos2 <- renderImage({list(src=lst[[2]], height="200")})
        output$showphotos3 <- renderImage({list(src=lst[[3]], height="200")})
        
        
        images_resized <- NULL
        for (i in 1:length(lst)) {
            
           image_scale(image = image_read(lst[[i]]), '200') %>% 
           image_write(path = str_c('image', i, '.png'), format = "png")
            
        }
        
        #image1.png ... image3.png are available in the working directory.
        
        #        drive_upload(image1, 
        #               as_id("https://drive.google.com/drive/u/1/folders/1qj0eeee...")

        
        })
}

shinyApp(ui, server)

编辑： 根据用户上传的图片数量调整ui。

library(shiny)
library(magick)
library(tidyverse)
library(googledrive)

ui <- fluidPage(
    fileInput("loadphotos", label = "Carregar fotos", multiple = TRUE),
    actionButton("do", "Carregar"),
    uiOutput('images_outputs')
)

server <- function(input, output, session) {
    
    observeEvent(input$do, {
        
        lst <- NULL
        for (i in 1:length(input$loadphotos[,1])) {
            lst[[i]] <- input$loadphotos[[i, 'datapath']]
        }
        
        output$images_outputs <- renderUI({
            tagList(
                map(str_c('showphotos', 1:length(lst)), ~imageOutput(.x, height = '200px')))
        })
        
        lst %>%
            map2(str_c('showphotos', 1:length(.)),~ { output[[.y]] <- renderImage({list(src = .x, height="200")},deleteFile = FALSE) })
        
        #a list with all the images but resized to 200
        #"x200" to resize by height
        images_resized <- lst %>% 
            map(~image_scale(image = image_read(.x), "200"))
        
        #images will be located in the project directory or home folder (getwd() to get working directory if in doubt)
        images_resized %>%
            walk2(str_c('image', 1:length(.)), ~ image_write(.x, path = str_c(.y, '.png'), format = "png"))
        
        
        #        drive_upload(image1.png, 
        #               as_id("https://drive.google.com/drive/u/1/folders/1qj0eeee...")
        
    })
    
}

shinyApp(ui, server)

注意：可能需要使用options(shiny.maxRequestSize={size}) 调整shiny 接受的最大文件大小，如here 所示