Rendering multiple images from a row of a dynamic datatable

Hello,

I am new to Shiny and have been trying to create a simple data table that on filtering on various columns, will return images of the filtered results (these are referenced in columns 'frontimage; and 'sideimage') and assume that there are files named equivalently in the www folder (but images aren't necessary to reproduce the below code).

While this works as it is, what I really wanted was to have the pictures from each row appear besides each other ('frontimage' with its associated 'sideimage'). Currently the only way I could figure out how to make both columns of pictures render, was to assign each to separate outputs, but that means you get all the pictures of the 'frontimage' results and then after all the 'sideimage' results, which is not ideal.

There may be a better way to do this overall, so if anyone has suggestions, I'm happy to hear them!

Reproducible code

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)

And it will be easier to see what the question/problem is if you create a javascript file called 'titlescript.js' with the image names to display the name associated with the pic when you hover over:

titlescript.js -- contents:

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

First answered here.

You can use the column function to split the layout.
Please see the shiny layout-guide for further information.
You might want to delete the code to generate the dummy images, however I wanted this answer to be reproducible.

Here is what I think you are after:

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)

result

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.