Making multiple images hyperlinked in Shiny

Question

Let's say I have a input data frame as below:

dat <- data.frame(
    country = c('USA', 'China', 'UK', "Germany", "France"),                                             
    flag = c('<img src="http://upload.wikimedia.org/wikipedia/en/thumb/a/a4/Flag_of_the_United_States.svg/200px-Flag_of_the_United_States.svg.png" width="100" height="80"></img>', '<img src="http://upload.wikimedia.org/wikipedia/commons/thumb/f/fa/Flag_of_the_People%27s_Republic_of_China.svg/200px-Flag_of_the_People%27s_Republic_of_China.svg.png"width="100" height="80"></img>', '<img src="https://upload.wikimedia.org/wikipedia/en/a/ae/Flag_of_the_United_Kingdom.svg"width="100" height="80"></img>', '<img src="https://upload.wikimedia.org/wikipedia/en/b/ba/Flag_of_Germany.svg"width="100" height="80"></img>', '<img src="https://upload.wikimedia.org/wikipedia/en/c/c3/Flag_of_France.svg"width="100" height="80"></img>'),                                                    
    infolink = c('https://en.wikipedia.org/wiki/United_States', 'https://en.wikipedia.org/wiki/China', 'https://en.wikipedia.org/wiki/United_Kingdom', 'https://en.wikipedia.org/wiki/Germany', 'https://en.wikipedia.org/wiki/France'))

My original data frame is large. Data frame has 3 columns country, flag, and infolink. Column country has name of country. Column flag has an image source of the flag which will be displayed. And, column infolink has url to country's wikipedia page. My goal is to display a flag of country with the country name in datatable format using renderDataTable. Where, flag of each country shall be hyper-linked to it's respective wikipedia url in infolink column.

There are multiple SO questions already asked on hyperlinking an image:

Making an Image Hyperlink in R Shiny header

how to create a hyperlink interactively in shiny app?

However, these questions hyperlink one image source not multiple images with respective to their hyperlink.

Following is my shiny app code:

library(shiny)
# UI for application
ui <- fluidPage(

   # Application title
   titlePanel("Image Hyperlinking Test"),

   mainPanel(
     a(dataTableOutput("imagetest"), href=dat$infolink, target="_blank")
   )
)

# Server for application
server <- function(input, output) {
  a(dat$flag, href=dat$infolink)
  dat2 <- data.frame(dat[,c("country", "flag")])

  output$imagetest <- renderDataTable({
    return(dat2)
  },escape = FALSE) 
}

shinyApp(ui = ui, server = server)

Running this app is producing two warnings:

Warning in if (!is.na(attribValue)) { :
the condition has length > 1 and only the first element will be used Warning in charToRaw(enc2utf8(text)) :
argument should be a character vector of length 1 all but the first element will be ignored

I understand that these warnings is caused by href in ui because I assigned vector of hyperlinks greater than 1 and its only assigning first hyperlink to all images. This is giving me an app dashboard as below:

However, every flag is hyperlinked to the first hyperlink in a vector as it was suggested in the warning. So, if I click on each flag, it's redirecting me to the wikipedia page of USA which is a first hyperlink in infolink vector in my dat data frame.

I tried several things to fix the warning and hyperlink every flag to their respective country's wikipedia page but nothing worked. If I missed any SO post which cover this, I would be glad if you redirect me to it. Anyhow, I would appreciate any guide to fix this issue.

Answer 1

You could do something like this:

 dat <- data.frame(
      country = c('USA', 'China', 'UK', "Germany", "France"),                                             
      flag = c('<img src="http://upload.wikimedia.org/wikipedia/en/thumb/a/a4/Flag_of_the_United_States.svg/200px-Flag_of_the_United_States.svg.png" width="100" height="80"></img>', '<img src="http://upload.wikimedia.org/wikipedia/commons/thumb/f/fa/Flag_of_the_People%27s_Republic_of_China.svg/200px-Flag_of_the_People%27s_Republic_of_China.svg.png"width="100" height="80"></img>', '<img src="https://upload.wikimedia.org/wikipedia/en/a/ae/Flag_of_the_United_Kingdom.svg"width="100" height="80"></img>', '<img src="https://upload.wikimedia.org/wikipedia/en/b/ba/Flag_of_Germany.svg"width="100" height="80"></img>', '<img src="https://upload.wikimedia.org/wikipedia/en/c/c3/Flag_of_France.svg"width="100" height="80"></img>'),                                                    
      infolink = c('https://en.wikipedia.org/wiki/United_States', 'https://en.wikipedia.org/wiki/China', 'https://en.wikipedia.org/wiki/United_Kingdom', 'https://en.wikipedia.org/wiki/Germany', 'https://en.wikipedia.org/wiki/France'),
      stringsAsFactors = FALSE)

    library(shiny)
    # UI for application
    ui <- fluidPage(

      # Application title
      titlePanel("Image Hyperlinking Test"),

      mainPanel(
        DT::dataTableOutput("imagetest")#, href=dat$infolink, target="_blank")
      )
    )

    # Server for application
    server <- function(input, output) {
      hlink <- apply(dat,1, function(x){
       as.character(a(HTML(x[["flag"]]), href=x[["infolink"]], target="_blank"))
      })      

      dat2$link <- hlink
      output$imagetest <- DT::renderDataTable({
        DT::datatable(dat2, escape = FALSE)
      }) 
    }

    shinyApp(ui = ui, server = server)