How to popup an image when clicking/hovering on a row using renderDataTable?

shiny
1

I'd like to add a popover effect when hovering on the img column of the example table, that displays the correspondent image in its normal size (that is, bigger than the current size).

Is there a way to do that in Shiny?

library(shiny)
library(shinydashboard)
library(DT)

# Data ------------------------------------------------------------------
dt <- data.frame(rank = c(1, 2, 3, 4, 5), 
                 image_url = c('https://images.unsplash.com/photo-1521671413015-ce2b0103c8c7?ixlib=rb-0.3.5&s=45547f67f01ffdcad0e33c8417b840a9&auto=format&fit=crop&w=667&q=80', 
                               "https://images.unsplash.com/photo-1520699697851-3dc68aa3a474?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=ef15aee8bcb3f5928e5b31347adb6173&auto=format&fit=crop&w=400&q=80", 
                               "https://images.unsplash.com/photo-1501925873391-c3cd73416c5b?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=379e4a0fffc6d11cd5794806681d0211&auto=format&fit=crop&w=750&q=80", 
                               "https://images.unsplash.com/photo-1493019352063-500af484329e?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=f1e0ce442afdcaf2cdc4fde83012346e&auto=format&fit=crop&w=750&q=80", 
                               "https://images.unsplash.com/photo-1422056551295-3b38e8a20462?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=3eb1f67f2b9c1c26435fc584a0a1f75d&auto=format&fit=crop&w=667&q=80")
)

img_dt <- dt %>%
  mutate(img = paste0("<img class = small-img src='", image_url, "'/>")) 

# Dashboard ----------------------------------------------------------------
ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  
  dashboardSidebar(),
  
  dashboardBody(
    tags$head(
      tags$style(
        HTML(
          "img.small-img {
          max-width: 75px;
          }")
      )
        ),
    
    dataTableOutput("example_table")
      )
  )

server <- function(input, output) {
  output$example_table <- renderDataTable({
    img_dt}, 
    escape = FALSE,
    rownames= FALSE)
}

shinyApp(ui = ui, server = server)
2

Do you mean something like this ?

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)

# Data ------------------------------------------------------------------
dt <- data.frame(rank = c(1, 2, 3, 4, 5), 
                 image_url = c('https://images.unsplash.com/photo-1521671413015-ce2b0103c8c7?ixlib=rb-0.3.5&s=45547f67f01ffdcad0e33c8417b840a9&auto=format&fit=crop&w=667&q=80', 
                               "https://images.unsplash.com/photo-1520699697851-3dc68aa3a474?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=ef15aee8bcb3f5928e5b31347adb6173&auto=format&fit=crop&w=400&q=80", 
                               "https://images.unsplash.com/photo-1501925873391-c3cd73416c5b?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=379e4a0fffc6d11cd5794806681d0211&auto=format&fit=crop&w=750&q=80", 
                               "https://images.unsplash.com/photo-1493019352063-500af484329e?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=f1e0ce442afdcaf2cdc4fde83012346e&auto=format&fit=crop&w=750&q=80", 
                               "https://images.unsplash.com/photo-1422056551295-3b38e8a20462?ixlib=rb-0.3.5&ixid=eyJhcHBfaWQiOjEyMDd9&s=3eb1f67f2b9c1c26435fc584a0a1f75d&auto=format&fit=crop&w=667&q=80")
)

img_dt <- dt %>%
  mutate(img = paste0("<a target='_blank' href='", image_url, "'><img src=\'", image_url, "' height='40'></img></a>")) %>%
  mutate(link = paste0("<a href='", image_url,"' target='_blank'>","View photo","</a>")) 

# Dashboard ----------------------------------------------------------------
ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  
  dashboardSidebar(),
  
  dashboardBody(
    tags$head(
      tags$style(
        HTML(
          "img.small-img {
          max-width: 75px;
          }")
      )
    ),
    
    dataTableOutput("example_table")
  )
)

server <- function(input, output) {
  output$example_table <- renderDataTable({
    img_dt[c(1,4,3)]}, 
    escape = FALSE,
    rownames= FALSE)
}

shinyApp(ui = ui, server = server)
3

I was thinking on the image poping up in the same window...

I got some help with the javascript to make it work using flexdashboard - I just can't figure out how to reproduce this effect with Shiny.

Here is the file for the flexdashboard example: https://drive.google.com/file/d/11EihpfD_DRYJumQBcvG4-zOmWcoU0sYW/view?usp=sharing