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具有国家/地区维基百科页面的网址。我的目标是使用datatable以renderDataTable格式显示国家/地区名称的国家/地区。其中，每个国家的国旗应与其在infolink栏中的相应维基百科网址超链接。

在超链接图像时已经提出了多个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，如警告中所建议的那样。所以，如果我点击每个标志，它会将我重定向到美国的维基百科页面，这是我的数据hyperlink中的第一个data frame信息加载向量。

我尝试了几个方法来修复警告，并将每个标志超链接到各自国家/地区的维基百科页面，但没有任何效果。如果我错过任何覆盖这个的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)

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

1 个答案: