R Shiny：以 zip 文件下载多个本地图像

Question

简单地说，我希望我的应用程序允许用户过滤具有某些特征的图像，从而允许他们将选定的图像下载到一个 zip 文件中。图像存储在本地。

我已经能够将图像添加为缩略图，并允许用户下载与其关联的数据（作为 .csv），但不能下载实际图像。

这是我所拥有的：

df <- read.csv("./imagedata.csv")

thumbnails <- list.files(path = "./localstore/", pattern = NULL, all.files = FALSE,
                         full.names = F, recursive = FALSE,
                         ignore.case = FALSE, include.dirs = FALSE, no.. = FALSE)


thumbnail_path = "./localstore/"


#----------------------------------Process Thumbnnail----------------------------------#

steps <- 0
out <- vector(mode = "list", length = nrow(df))

for (i in df$Thumbnail) {
  
  out[i] <- knitr::image_uri(i)
  
  steps <- steps + 1
  
}
print(steps)


ProcessedIcon <- as.data.frame(unlist(out))


Icon <-  paste("<img src=", ProcessedIcon$`unlist(out)` ,"></img>", sep = "")

df_Icon <- cbind(df, Icon)



#--------------------------------------- UI ---------------------------------------#

ui <- dashboardPage(
  skin = "green",
  dashboardHeader(title = span(img(src = "logo.png", height = 35), img(src = "logo2.png", height = 35))),
  
  dashboardSidebar(
    sidebarMenu(
      
      menuItem("Item Category", tabName = "category", icon = icon("file"),
               
               selectInput(inputId = "ItemCategory",
                           label = "", 
                           choices = unique(df$ItemCategory),
                           selected = unique(df$ItemCategory), 
                           multiple = TRUE,
                           selectize = TRUE, 
                           width = NULL, 
                           size = NULL)
),
      menuItem("Item Sub-category", tabName = "subcategory", icon = icon("copy"),
               selectInput(inputId = "ItemSubCategory",
                           label = "", 
                           choices = unique(df$SubCategory),
                           selected = unique(df$SubCategory), 
                           multiple = TRUE,
                           selectize = TRUE, 
                           width = NULL, 
                           size = NULL)
               
      ),
      
      br(),
      
      br(),
      column(11, align = "center",
             downloadButton("downloadData", "Download Data"), class = "butt"),
      tags$head(tags$style(".butt{font:black;}")),
      
      br(),
      
      br(),
      column(11, align = "center",
             downloadButton("downloadImages", "Download Images"), class = "butt"),
      tags$head(tags$style(".butt{font:black;}"))
      
    )
  ),
  
  
  dashboardBody(
    
    DT::dataTableOutput('dftable'),
    
  )
)

#--------------------------------------- Server ---------------------------------------#

server <- function(input, output) {




#------------------------------------Download table-------------------------------#  
  
  Info_Database <-  reactive  ({
    
    df %>%
      filter(ItemCategory %in% c(input$ItemCategory)) %>% 
      filter(SubCategory %in% c(input$ItemSubCategory)) %>%
      select(-Thumbnail)
    
  })


#------------------------------------Display table-------------------------------#  
  
  table <-  reactive  ({
    
    df_Icon %>%
      select(Icon, ItemCategory, SubCategory, QualityOfImage, Recognisability)%>% 
      filter(ItemCategory %in% c(input$ItemCategory)) %>%
      filter(SubCategory %in% c(input$ItemSubCategory)) %>%
    
  })
  
  
  
  output$dftable <- DT::renderDataTable({
    
    
    DT::datatable(table(), escape = FALSE, options = list(scrollX = TRUE))
    
    
  })
  
  # download handler- Database
  output$downloadData <- downloadHandler(
    filename = function() {
      paste('ImageDatabase_', Sys.Date(), '.csv', sep='')
    },
    content = function(con) {
      write.csv(Info_Database(), con)
    }
  )
  

# here's where I'm totally lost
  # download handler- Images
  #output$downloadImages <- downloadHandler(
    
  #) 
  
  
}

imagedata.csv 应该如下所示：

ItemCategory	SubCategory	QualityOfImage	Recognisability
Animal	Cat	5	4
Animal	Dog	4	3
Food	Banana	3	4
Objects	House	5	5

显示表格应如下所示：

Icon	ItemCategory	SubCategory	QualityOfImage	Recognisability
	Animal	Cat	5	4
	Animal	Dog	4	3
	Food	Banana	3	4
	Objects	House	5	5

Answer 1

首要任务

[reprex] 会极大地增加您获得答案的机会，因为没有人希望首先重新创建您的数据结构以便能够帮助您。

我会采用稍微不同的方法。我不会对图片进行编码，而是使用<img> 标签来包含它们。

设置

注意我所有的 SO 答案都位于 Project Root - 这对于此解决方案并不重要，但需要重新运行示例。图片取自您的示例。

Project Root
|- .Rproj
|- Download
   |- app.R
   |- www
      |- pic-1.jpg
      |- pic-2.png
      |- pic-3.png
      |- pic-4.jpg

app.R

library(shiny)
library(tibble)
library(DT)
library(dplyr)
library(here)
library(purrr)

all_pics <- list.files(here("Download", "www"), pattern = "\\.jpg$|\\.png$")

my_data <- tibble(Icon = all_pics, 
                  ItemCategory = c("Animal", "Objects", "Objects", "Animal"), 
                  SubCategory = c("Cat", "Banana", "House", "Dog"))

ui <- fluidPage(
   titlePanel("Download Pics and Table"),
   sidebarPanel(
      selectInput("category", "Category:", 
                  c("All", my_data %>% pull(ItemCategory)),
                  "All"),
      downloadButton("dwnld_data", "Download Data"),
      downloadButton("dwnld_pics", "Download Pictures")
   ),
   mainPanel(
      DTOutput("tbl")
   )
)

server <- function(input, output, session){
   get_data <- reactive({
      my_data %>%
         filter(input$category == "All" |
                   ItemCategory == input$category) %>% 
         mutate(IconPath = map_chr(Icon, ~ as.character(img(src = .x, 
                                                            height = "50px", 
                                                            width = "50px"))))
   })
   
   output$tbl <- renderDataTable({
      datatable(
         get_data() %>% 
            select(Icon = IconPath, Category = ItemCategory, 
                   "Sub Category" = SubCategory),
         escape = FALSE
      )
   })
   
   output$dwnld_data <- downloadHandler(
      filename = function() {
         paste0("data-", Sys.Date(), ".csv")
      },
      content = function(file) {
         write.csv(get_data() %>% 
                      select(Icon, Category = ItemCategory, 
                             "Sub Category" = SubCategory), file,
                   row.names = FALSE)
      }
   )
   
   output$dwnld_pics <- downloadHandler(
      filename = function() {
         paste0("pics-", Sys.Date(), ".zip")
      },
      content = function(file) {
         fns <- get_data() %>% 
            pull(Icon)
         zip(file,
             file.path(here("Download", "www"), fns), 
             flags = "-r9Xj")
      }
   )
   
}

shinyApp(ui, server)

说明

1. 所有图片都在www文件夹中，shiny可以通过<img>标签将它们添加到页面中。
2. 在我的my_data 反应式中，我根据选择过滤数据并添加<img> 标记的字符串表示，我在其中设置缩略图大小的图片的高度和宽度。
3. 在renderDatatable 中，我使用escape = FALSE不转义 HTML 代码并渲染图片。
4. 然后downloadHandler 相当简单，循环遍历所有选定的文件并将它们添加到一个 zip 文件中。

注意理论上，如果必须，您也可以使用 URI 编码策略。但是，在这种情况下，您的 downloadHandler 会变得有点复杂。您首先需要对编码的图像字符串进行解码，将其存储到临时文件中，然后将此临时文件添加到 zip。除非有充分的理由采用这种方法，否则我不会添加这一层复杂性。