R Shiny: download multiple local images in zip file

Question

Simply put, I'd like my app to allow the user to filter images with certain characteristics and consequently allow them to download the selected images into a zip file. The images are stored locally.

I've been able to add the images as thumbnails and allow the user to download the data associated with it (as a .csv) but not the actual images.

Here's what I have:

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("", 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 should look like:

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

Display table should look like:

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

user_4125751 · Answer

First things first

A reprex would tremendously increase your chances of getting an answer, because nobody wants first to re-create your data structure first to be able to help you.

Aproach

I would follow a slightly different approach. Rather than encoding the pictures, I would use an tag to include them.

Setup

N.B. All My SO answers are sitting in Project Root - this is not important for this solution, but necessary to re-run the example. Pics are taken from your example.

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)

Explanation

All pics are in the www folder, from where shiny can add them to the page via the tag.
In my my_data reactive, I filter the data according to the selections and add a string representation of the tag, where I set height and width for the thumbnail sized pictures.
In renderDatatable I use escape = FALSE to not escape the HTML code and to render the picture.
Then the downloadHandler is rather straight forward, loop through all selected files and add them to a zip.

N.B. Theoretically you could also stay with your URI encoding strategy if you must. Your downloadHandler would become a bit more complicated in this case then however. You would first need to decode the encoded image string, store it to a temporary file and add this temporary file to the zip. Unless there are good reasons to go for this approach, I would not add this layer of complication.