从闪亮的动态数据表的一行中渲染多个图像

Rendering multiple images from a row of a dynamic datatable in Shiny

交叉发布于 R Studio Community

我是 Shiny 的新手,一直在尝试创建一个简单的数据 table,在对各个列进行过滤时,将 return 过滤结果的图像(这些在“frontimage”列中引用; 和 'sideimage') 并假设 www 文件夹中有相同名称的文件(但图像不是重现以下代码所必需的)。

虽然按原样工作,但我真正想要的是让每一行的图片彼此并排显示('frontimage' 及其关联的 'sideimage')。目前我唯一能弄清楚如何渲染两列图片的方法是将每一列分配给单独的输出,但这意味着你得到了 'frontimage' 结果的所有图片,然后是 'sideimage' 结果,并不理想。

总的来说可能有更好的方法,所以如果有人有建议,我很乐意听取他们的建议!

可重现的代码

library(DT)
library(shiny)

dat <- data.frame(
  type = c("car", "truck", "scooter", "bike"),
  frontimage = c("carf.jpg", "truckf.jpg", "scooterf.jpg", "bikef"),
  sideimage = c("cars.jpg", "trucks.jpg", "scooters.jpg", "bikes")
)

# ----UI----
ui <- fluidPage(
  titlePanel("Display two images for each row"),
  
  mainPanel(
    DTOutput("table"),
    uiOutput("img1"),
    uiOutput("img2")
  )
)

# ----Server----
server = function(input, output, session){

  # Data table with filtering
  output$table = DT::renderDT({
    datatable(dat, filter = list(position = "top", clear = FALSE), 
              selection = list(target = 'row'),
              options = list(
                autowidth = TRUE,
                pageLength = 2,
                lengthMenu = c(2, 4)
              ))
  })
  
  # Reactive call that only renders images for selected rows 
  df <- reactive({
    dat[input[["table_rows_selected"]], ]
  })
  
  # Front image output
  output$img1 = renderUI({
    imgfr <- lapply(df()$frontimage, function(file){
      tags$div(
        tags$img(src=file, width="100%", height="100%"),
        tags$script(src="titlescript.js")
      )
      
    })
    do.call(tagList, imgfr)
  })
  
  # Side image output
  output$img2 = renderUI({
    imgside <- lapply(df()$sideimage, function(file){
      tags$div(
        tags$img(src=file, width="100%", height="100%"),
        tags$script(src="titlescript.js")
      )
      
    })
    do.call(tagList, imgside)
  })
  
}
# ----APP----    
# Run the application 
shinyApp(ui, server)

如果您创建一个名为 'titlescript.js' 的 javascript 文件并使用图像名称来显示与图片相关联的名称,那么您将更容易看到 question/problem 是什么,当您悬停在:

titlescript.js -- 内容:

jQuery(function(){
    $('img').attr('title', function(){
        return $(this).attr('src')
    });
})

您可以使用column功能拆分布局。 请参阅 shiny layout-guide 了解更多信息。 您可能想删除生成虚拟图像的代码,但我希望这个答案可以重现。

这就是我认为你想要的:

library(DT)
library(shiny)

# generate dummy images
imgNames = c("carf.jpg", "truckf.jpg", "scooterf.jpg", "bikef.jpg", "cars.jpg", "trucks.jpg", "scooters.jpg", "bikes.jpg")

if(!dir.exists("www")){
  dir.create("www")
}

for(imgName in imgNames){
  png(file = paste0("www/", imgName), bg = "lightgreen")
  par(mar = c(0,0,0,0))
  plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
  text(x = 0.5, y = 0.5, imgName, 
       cex = 1.6, col = "black")
  dev.off()
}

dat <- data.frame(
  type = c("car", "truck", "scooter", "bike"),
  frontimage = c("carf.jpg", "truckf.jpg", "scooterf.jpg", "bikef.jpg"),
  sideimage = c("cars.jpg", "trucks.jpg", "scooters.jpg", "bikes.jpg")
)

# ----UI----
ui <- fluidPage(
  titlePanel("Display two images for each row"),
  
  mainPanel(
    DTOutput("table"),
    fluidRow(
      column(6, uiOutput("img1")),
      column(6, uiOutput("img2"))
    )
  )
)

# ----Server----
server = function(input, output, session){
  
  # Data table with filtering
  output$table = DT::renderDT({
    datatable(dat, filter = list(position = "top", clear = FALSE), 
              selection = list(target = 'row'),
              options = list(
                autowidth = TRUE,
                pageLength = 2,
                lengthMenu = c(2, 4)
              ))
  })
  
  # Reactive call that only renders images for selected rows 
  df <- reactive({
    dat[input[["table_rows_selected"]], ]
  })
  
  # Front image output
  output$img1 = renderUI({
    imgfr <- lapply(df()$frontimage, function(file){
      tags$div(
        tags$img(src=file, width="100%", height="100%"),
        tags$script(src="titlescript.js")
      )
    })
    do.call(tagList, imgfr)
  })
  
  # Side image output
  output$img2 = renderUI({
    imgside <- lapply(df()$sideimage, function(file){
      tags$div(
        tags$img(src=file, width="100%", height="100%"),
        tags$script(src="titlescript.js")
      )
    })
    do.call(tagList, imgside)
  })
  
}
# ----APP----    
# Run the application 
shinyApp(ui, server)