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

Question

在R Studio Community上发帖

我是 Shiny 的新手，一直在尝试创建一个简单的数据表，在过滤各个列时，将返回过滤结果的图像（这些在列“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 文件，其中包含图像名称，以便在悬停时显示与图片关联的名称，则将更容易查看问题/问题：

titlescript.js -- 内容：

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

Answer 1

您可以使用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)