在 R shiny app 的数据表中的字段名称上方添加附加标签

Question

我正在尝试在 R 中的分组数据表中的字段名称上方添加多个附加标签，然后在 Shiny 应用程序中将其呈现为数据表。

例如，使用 iris 数据，我想对每个物种进行分组，然后总结它们的萼片长度（max 是最长的，min 是最短的，等等），以及它们的萼片宽度、花瓣长度和花瓣宽度。在此示例中，添加的附加标签将是 "Sepal Length"、"Sepal Width"、"Petal Length" 和 "Petal Width"，位于其各自的 Max/Avg/Min 子列上方。 The image here is a Microsoft Excel recreation 个我要找的东西。

This is a link to a possible solution，但我没有运气尝试为多个标签复制它。这是我的代码，试图使用虹膜数据重新创建上述 link 中的解决方案。

df3<-data.frame(iris)

grouped_df3<- df3 %>%
  group_by(Species) %>%
  summarize("#"=n(),
            Max_Sepal_W=max(Sepal.Width, na.rm = TRUE),
            Avg_Sepal_W=mean(Sepal.Width, na.rm = TRUE),
            Min_Sepal_W=min(Sepal.Width, na.rm = TRUE),
            Max_Sepal_L=max(Sepal.Length, na.rm = TRUE),
            Avg_Sepal_L=mean(Sepal.Length, na.rm = TRUE),
            Min_Sepal_L=min(Sepal.Length, na.rm = TRUE) )


class(grouped_df3) <- c( "Question", class(grouped_df3) )

print.Question <- function( x, ... ) {
  if( ! is.null( attr(x, "Question") ) ) {
    cat("Question:", attr(x, "Question"), "\n")
  }
  print.data.frame(x)
}
attr(grouped_df3, "Question") <- "Age"
attributes(grouped_df3)
head(grouped_df3)

# found here: 
# does not work with datatables, or with multiple labels

如果需要更多信息，请告诉我。预先感谢您的帮助！

Answer 1

这个 and this answer 非常有助于提供一种使用 DT 的方法，可以将其合并到您的 shiny 应用程序中。

library(htmltools)
library(DT)

sketch <- withTags(
  table(
    class = "display",
    thead(
      tr(
        th(colspan = 1, "", style = "border-right: solid 2px;"),
        th(colspan = 1, "", style = "border-right: solid 2px;"),
        th(colspan = 3, "Sepal Width", style = "border-right: solid 2px;"),
        th(colspan = 3, "Sepal Length")
      ),
      tr(
        th("Species", style = "border-right: solid 2px;"),
        th("#", style = "border-right: solid 2px;"),
        th("Longest"),
        th("Avg"),
        th("Shortest", style = "border-right: solid 2px;"),
        th("Widest"),
        th("Avg"),
        th("Narrowest"),
      )
    )
  )
)

datatable(grouped_df3, rownames = FALSE, container = sketch, 
          options = list(
            columnDefs = list(
              list(targets = "_all", className = "dt-center")
            )
          )) %>%
  formatStyle(c(1,2,5), `border-right` = "solid 2px")

输出

在 R shiny app 的数据表中的字段名称上方添加附加标签

Adding a additional labels above field names in datatable in R shiny app

datatable

label

row

r

shiny