Images not getting displayed under Lightbox gallery function in R shiny - r

Question

I'm trying to get input from the User( a bunch of images) and then display them on R shiny using Lightbox gallery. Unfortunately I'm unable to get the images, Please help with this regard,Thank you in advance for your help .
below is my code:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
fileInput(inputId = "file_upload", label = "Upload Images", multiple = TRUE, accept = c('image/*', ".zip"),
width = NULL, buttonLabel = "Browse",
placeholder = "No file selected"),
actionButton("go","Run")
)
),
mainPanel(
fluidRow(
column(12,(uiOutput('lb'))
))
)
)
)
server <- function(input, output) {
vals<-reactiveValues(result=NULL,img_fldr_name=NULL,images=NULL)
observeEvent(input$file_upload, {
c_t <- Sys.time()
dt_str <- format(c_t, "%Y_%m_%d")
hr_str <- format(c_t, "%H_%M_%S")
vals$img_fldr_name <- paste0(dt_str, "_", hr_str)
if (tools::file_ext(input$file_upload$datapath)[[1]] %in% c("jpeg","png","jpg")){
create_folder_name=paste0("trials/www/",vals$img_fldr_name)
dir.create(path = create_folder_name)
for(i in 1:length(input$file_upload$datapath)){
file.copy(input$file_upload$datapath[[i]], paste0(create_folder_name,"/",input$file_upload$name[[i]]), overwrite = TRUE)
}
df <- list.files(paste0("trials/www/",vals$img_fldr_name), full.names = T)
print(df)
images<<-data.frame(src=list.files(paste0("trials/www/",vals$img_fldr_name), full.names = T))
#print(head(vals$images))
vals$result<-images
}
})
observeEvent(input$go,{
output$lb <- renderUI({
images <<- data.frame(src = vals$result$src)
vals$images <- images
lightbox_gallery <- function(df, gallery, display = 'block'){
print(df)
tags$div(style = sprintf('display: %s;', display),
tagList(tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "lightbox-2.10.0/lightbox.min.css"),
tags$link(rel = "stylesheet", type = "text/css", href = "gallerystyle.css")
),
tags$div(class = 'card-deck',
lapply(seq_len(nrow(df)), function(i){
print("Inside Loop")
print(df$src[i])
tags$div(`data-type`="template", class = 'card',
tags$a(#id = df$key[i],
href = df$src[i],
`data-lightbox` = gallery, # this identifies gallery group
`data-title` = paste0("Image"),
tags$span(style="color:black;text-align: center"),
tags$img(class = 'card-img-top',
src = df$src[i],
width = '80px',
height = 'auto')),
)
})
),
includeScript("www/lightbox-2.10.0/lightbox.min.js")
))
}
lightbox_gallery(vals$images, 'gallery', display = TRUE)
#paste0()
})
})
}
shinyApp(ui = ui, server = server)
Print statement inside loop gives proper path to image.
Also the respective folders and scripts are in place.

Answer 1

The code below works. I removed the nesting of how you prepare the output for better readability.
I think the main problem was that you read the image files from a directory outside www in your project folder. I would keep everything in there. This makes it easier. Take a look at the code: when the images are uploaded I explicitely save them to www/.... While preparing the output, I remove the www prefix using gsub, since Shiny is looking for resources in there by default.
Finally, make sure to use reactive values properly. You don't need to define a global images variable. Just use the reactive values. And there again, it is probably sufficient to have one reactive value which holds all the paths as a vector (e.g. paths <- reactiveVal(NULL)).
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
fileInput(inputId = "file_upload", label = "Upload Images", multiple = TRUE, accept = c('image/*', ".zip"),
width = NULL, buttonLabel = "Browse",
placeholder = "No file selected"),
actionButton("go","Run")
)
),
mainPanel(
fluidRow(
column(12,(htmlOutput('lb'))
))
)
)
)
server <- function(input, output) {
vals<-reactiveValues(result=NULL,img_fldr_name=NULL,images=NULL)
observeEvent(input$file_upload, {
c_t <- Sys.time()
dt_str <- format(c_t, "%Y_%m_%d")
hr_str <- format(c_t, "%H_%M_%S")
vals$img_fldr_name <- paste0(dt_str, "_", hr_str)
if (tools::file_ext(input$file_upload$datapath)[[1]] %in% c("jpeg","png","jpg")){
create_folder_name=paste0("www/trials/www/",vals$img_fldr_name)
dir.create(path = create_folder_name)
for(i in 1:length(input$file_upload$datapath)){
file.copy(input$file_upload$datapath[[i]], paste0(create_folder_name,"/",input$file_upload$name[[i]]), overwrite = TRUE)
}
images <- data.frame(src=list.files(paste0("www/trials/www/",vals$img_fldr_name), full.names = T))
vals$result <- images
}
})
get_lb <- eventReactive(input$go,{
images <- data.frame(src = vals$result$src)
vals$images <- images
lightbox_gallery(vals$images, 'gallery', display = TRUE)
})
lightbox_gallery <- function(df, gallery, display = 'block'){
tags$div(style = sprintf('display: %s;', display),
tagList(tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "lightbox.min.css"),
tags$link(rel = "stylesheet", type = "text/css", href = "gallerystyle.css")
),
tags$div(class = 'card-deck',
lapply(seq_len(nrow(df)), function(i){
print("Inside Loop")
print(df$src[i])
tags$div(`data-type`="template", class = 'card',
tags$a(#id = df$key[i],
href = gsub("^www/", "", df$src[i]),
`data-lightbox` = gallery, # this identifies gallery group
`data-title` = paste0("Image"),
tags$span(style="color:black;text-align: center"),
tags$img(class = 'card-img-top',
src = df$src[i],
width = '80px',
height = 'auto')),
)
})
),
includeScript("www/lightbox.min.js")
))
}
output$lb <- renderUI({
get_lb()
})
}
shinyApp(ui = ui, server = server)