在闪亮的数据表中按标签对超链接进行排序？

Question

我有一个包含多列的数据表，其中一列带有超链接；当用户对此列进行排序时，所需的输出将是获得按超链接的 tags 而不是超链接的 urls 排序的结果。

最小示例：

library(shiny)
library(DT)

ui <- bootstrapPage(
  DTOutput("tabla")
)

server <- function(input, output) {
  output$tabla <- renderDT({
    datos <- as.data.frame(matrix(ncol=3, nrow=10))
    names(datos) <- c("Allele_ID", "Significance", "Link")
    datos$Allele_ID <- c("1310278", "18560", "1770470", "1770471", "1770458", "1310279", "1310279", "17978", "1770451", "227743")
    datos$Significance <- c("Pathogenic", "Likely Pathogenic", "Pathogenic", "Uncertain Significance", "Likely Benign", "Likely Benign", "Benign", "Uncertain Significance", "Pathogenic", "Likely Benign")
    datos$Link <- paste0('<a href="http://www.ncbi.nlm.nih.gov/clinvar/?term=', datos$Allele_ID, '[alleleid]','" target="_blank">', datos$Significance, "</a>")
    DT::datatable(datos, rownames = FALSE,
                  style = 'bootstrap',
                  filter = list(position = 'top', clear = FALSE),
                  escape = FALSE,
                  options = list(
                    dom = "<\"datatables-scroll\"t>",
                    ordering = TRUE
                    )
                  )
  })
}

shinyApp(ui = ui, server = server)

关于如何实现这一目标有什么想法吗？谢谢！

Answer 1

您可以使用

render

选项来实现这一点：

library(DT)

render <- "
function(data, type, row, meta) {
  if(type === 'display') {
    data = '<a href=\"http://www.ncbi.nlm.nih.gov/clinvar/?term=' +
      row[0] + ' [alleleid]\" target=\"_blank\">' + data + '</a>';
  }
  return data;
}
"

datos <- as.data.frame(matrix(ncol=3, nrow=10))
names(datos) <- c("Allele_ID", "Significance", "Link")
datos$Allele_ID <- c(
  "1310278", "18560", "1770470", "1770471", "1770458", "1310279", "1310279", 
  "17978", "1770451", "227743"
)
datos$Significance <- c(
  "Pathogenic", "Likely Pathogenic", "Pathogenic", "Uncertain Significance", 
  "Likely Benign", "Likely Benign", "Benign", "Uncertain Significance", 
  "Pathogenic", "Likely Benign"
)
datos$Link <- datos$Significance

datatable(datos, rownames = FALSE,
              style = 'bootstrap',
              filter = list(position = 'top', clear = FALSE),
              options = list(
                dom = "<\"datatables-scroll\"t>",
                ordering = TRUE,
                columnDefs = list(
                  list(targets = 2, render = JS(render))
                )
              )
)