图像未在 R shiny 中的灯箱图库功能下显示

Question

我正在尝试从用户那里获取输入（一堆图像），然后使用 Lightbox 画廊将它们显示在 R 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,(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)

循环内的打印语句提供正确的图像路径。相应的文件夹和脚本也已就位。

Answer 1

下面的代码有效。我删除了如何准备输出的嵌套以提高可读性。

我认为主要问题是您从项目文件夹 www 之外的目录读取图像文件。我会把所有东西都放在那里。这使它更容易。看一下代码：上传图像时，我明确地将它们保存到 www/...。在准备输出时，我使用 gsub 删除了 www 前缀，因为默认情况下 Shiny 正在那里寻找资源。

最后，确保正确使用反应值。您不需要定义全局 images 变量。只需使用反应值。再一次，有一个将所有路径作为向量保存的反应值可能就足够了（例如 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)

图像未在 R shiny 中的灯箱图库功能下显示

Images not getting displayed under Lightbox gallery function in R shiny

r

shiny