单击列 headers 上的图标时弹出消息

Question

在 shiny 中渲染 DT table 时，有没有办法添加弹出图标，如下所示。所以当用户点击它时，它应该会显示一些消息:)

datatable(iris)  #### while rendering DT table

Answer 1

您可以像这样设置列名：

library(shiny)
library(DT)

ui <- fluidPage(
  DTOutput("table")
)

server <- function(input, output, session) {
  output$table <- renderDataTable(escape = FALSE, {
    colnames(iris) <- c("Sepal Length", "Sepal Width", "Petal Length",
       "Petal Width <div title ='Hover tooltip'>info</div>", "Species")
    iris
  })
}

shinyApp(ui, server)

但是，像 shiny::icon("info-circle") 这样的东西不在列名中。

Answer 2

既然你在评论中提到你想要消息也可以点击，您可能对 Bootstrap 感兴趣弹出框。这 shinyBS package 为它们提供了一些包装器。但是，我无法得到它与数据一起工作table header，所以我制作了一些自定义助手：

# Enable popovers -- needs to be included again with dynamic content
usePopover <- function() {
  tags$script(HTML(
    "$(function () {
      $('[data-toggle=\"popover\"]').popover()
    })"
  ))
}

popover <- function(tag, content = NULL, title = NULL, options = list()) {
  if (!is.null(names(options))) {
    names(options) <- paste0("data-", names(options))
  }
  
  tag |>
    tagAppendAttributes(
      `data-toggle` = "popover",
      `data-content` = content,
      title = title,
      !!!options
    )
}

您可以在数据 table 列 header 中使用它们，方法是定义自定义 columDefs 目标列的元素。当我们在那里时，我们也可以使用在确保包含后，注入信息图标的机制相同 UI.

中的必需依赖项

单击 header 中的图标时避免排序行为需要一些额外的工作。本质上，您必须确保点击事件不会冒泡到数据table 中的事件侦听器。对于图标，可以在元素的直接单击处理程序中使用 JavaScript 来完成。对于 popover 本身，我们可以使用不同的容器（在本例中为 body），这样它就不再包含在 DOM.

中的 table 中

这是如何组合在一起的：

library(shiny)
library(DT)

ui <- fluidPage(
  # Need to add FontAwesome manually because no `icon()` calls in UI.
  fontawesome::fa_html_dependency(),
  DTOutput("table")
)

server <- function(input, output, session) {
  output$table <- renderDT({
    datatable(
      data = iris,
      options = list(
        columnDefs = list(
          list(
            targets = 4,
            title = paste(
              "Petal.Width",
              icon("info-circle") |>
                popover(
                  tags$a(href = "https://whosebug.com", "Stack Overflow"),
                  # Prevent sorting when clicking on popover
                  options = list(html = TRUE, container = "body")
                ) |>
                tagAppendAttributes(
                  # Prevent sorting when clicking on icon
                  onclick = "event.stopPropagation();"
                ) |>
                tagList(usePopover())
            )
          )
        )
      )
    )
  })
}

shinyApp(ui, server)

最后看起来像这样：

单击列 headers 上的图标时弹出消息

Pop up message when clicked on icon on column headers

r

shiny