在 Shiny 中制作多个图像超链接

Question

假设我有一个输入data frame，如下所示：

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'))

我原来的data frame 很大。数据框有 3 列 country、flag 和 infolink。 country 列有国家名称。 flag 列具有将显示的标志的图像源。并且，infolink 列具有国家/地区维基百科页面的 url。我的目标是使用renderDataTable 以datatable 格式显示带有国家名称的国家标志。其中，每个国家/地区的国旗应超链接到 infolink 列中各自的维基百科 url。

关于超链接图像已经有多个 SO 问题：

Making an Image Hyperlink in R Shiny header

how to create a hyperlink interactively in shiny app?

但是，这些问题超链接的是一个图像源，而不是多个图像各自的超链接。

以下是我闪亮的应用代码：

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)

运行此应用会产生两个警告：

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

我知道这些警告是由 ui 中的href 引起的，因为我分配了大于 1 的超链接的vector，并且它只为所有图像分配了第一个超链接。这给了我一个应用仪表板，如下所示：

但是，正如警告中所建议的那样，每个标志都超链接到向量中的第一个 hyperlink。所以，如果我点击每个标志，它会将我重定向到美国的维基百科页面，这是我的数据 data frame 中信息链接向量中的第一个 hyperlink。

我尝试了几种方法来修复警告并将每个标志超链接到各自国家/地区的维基百科页面，但没有任何效果。如果我错过了任何涵盖此内容的 SO 帖子，如果您将我重定向到它，我会很高兴。无论如何，我将不胜感激任何解决此问题的指南。

Answer 1

你可以这样做：

 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)