DT

R语言
可视化
表格
R语言DT包生成交互式表格
作者

不止BI

发布于

2024年4月6日

DT包是一个在R语言中非常有用的数据处理工具。它提供了DataTables JavaScript库在R中的接口，使得R中的对象（如矩阵或数据框）可以在HTML页面上以表格形式显示，并且具备数据筛选、分页、排序等功能 ## 默认样式

代码 
library(DT)
datatable(head(iris, 10))

常用功能

修改语言

通过传入翻译的json可以修改控件语言为中文

代码 
library(DT)
datatable(head(iris, 10), options = list(
  language = list(url = "https://cdn.datatables.net/plug-ins/1.10.11/i18n/Chinese.json")
))

修改options可以让设置全局生效

代码 
options(DT.options = list(
  language = list(url = "https://cdn.datatables.net/plug-ins/1.10.11/i18n/Chinese.json"),
  pageLength = 5
))
datatable(head(iris, 10))

修改列宽

默认情况下列宽自适应

代码 
datatable(iris,
  options = list(
    autoWidth = TRUE,
    columnDefs = list(list(
      width = "500px", targets = c(1, 3) # 第 1、2 列
    ))
  )
)

控件显示

在DT包中，dom参数用于控制一些元素在表格周围的位置。具体而言，它决定了哪些控件（如分页、搜索框、表格信息等）显示在表格的哪个位置。

  • l：Length changing，用于改变每页显示多少条数据的控件。

  • f：Filtering input，即时搜索框控件。

  • t：The Table，表格本身。

  • i：Information，表格相关信息控件。

  • p：Pagination，分页控件。

  • r：Processing，加载等待显示信息。

下方代码设置仅显示表格和分页控件，并且分页控件位于表格的上方

代码 
library(DT)
datatable(head(iris, 10), options = list(
  dom = "pt"
))

自定义排序

代码 
datatable(head(mtcars, 30), options = list(
  order = list(list(2, "asc"), list(4, "desc"))
))

格式化列值

代码 
library(DT)
library(timetk)
m <- data.frame(rnorm(20, mean = 10000), runif(20, min = 0, 1), as.POSIXct.Date(timetk::tk_make_timeseries("2024-04-01", "2024-04-20")))
colnames(m) <- head(LETTERS, ncol(m))
DT:::DateMethods
[1] "toDateString"       "toISOString"        "toLocaleDateString"
[4] "toLocaleString"     "toLocaleTimeString" "toString"          
[7] "toTimeString"       "toUTCString"
代码 
datatable(m) %>%
  formatCurrency("A") %>%
  formatPercentage("B", 2) %>%
  formatDate("C", method = "toLocaleDateString")

格式化列背景及颜色

代码 
library(RColorBrewer)
datatable(iris[sample(1:150, 30), ]) %>%
  formatStyle("Sepal.Length", fontWeight = styleInterval(5, c("normal", "bold"))) %>%
  formatStyle(
    "Sepal.Width",
    backgroundColor = styleInterval(quantile(iris$Sepal.Width, probs = c(0.05, 0.95)), brewer.pal(3, "Greens"))
  ) %>%
  formatStyle(
    "Petal.Width",
    color = styleInterval(c(1, 2), c("black", "blue", "red"))
  ) %>%
  formatStyle(
    "Petal.Length",
    background = styleColorBar(iris$Petal.Length, "steelblue"),
    backgroundSize = "100% 90%",
    backgroundRepeat = "no-repeat",
    backgroundPosition = "center"
  ) %>%
  formatStyle(
    "Species",
    # transform = 'rotateX(45deg) rotateY(20deg) rotateZ(30deg)',
    backgroundColor = styleEqual(
      unique(iris$Species), brewer.pal(3, "Accent")
    )
  )

插入图标

代码 
fdata <- data.frame(Id = 1:5, Letters = LETTERS[1:5], fvalue = rep(fontawesome::fa("r-project"), 5))
datatable(fdata, escape = F)

文本对齐

代码 
datatable(iris[sample(1:150, 30), ], options = list(columnDefs = list(
  list(targets = "_all", className = "dt-head-center")
))) |>
  # 为第1:4列设定文本对齐方式为居中
  formatStyle(columns = c(1:4), textAlign = "center") |>
  # 目标为行，按照第5列（'type2'列）的数据值，设定不同行应用不同的文本对齐方式
  formatStyle(
    columns = 5,
    target = "row",
    textAlign = styleEqual(
      levels = c("setosa", "virginica", "versicolor"),
      values = c("left", "right", "center")
    )
  )

设置边框

代码 
datatable(head(mtcars)) |>
  # 设定单元格的边框样式为宽度1px、虚线、黑色
  formatStyle(columns = 1, "border" = "1px dashed black") |>
  # 设定单元格的下边框样式为宽度1px、实线、黑色
  formatStyle(columns = 2, "border-bottom" = "1px solid black") |>
  # 设定单元格的上边框样式为宽度1px、点线、黑色
  formatStyle(columns = 3, "border-top" = "1px dotted black") |>
  # 设定单元格的左边框样式为宽度2px、实线、红色
  formatStyle(columns = 4, "border-left" = "2px solid red") |>
  # 设定单元格的右边框为宽度1px、实线、黑色
  formatStyle(columns = c(5, 6), "border-right" = "1px solid black")

扩展功能

自动填充

鼠标悬浮单元格时，右下角会出现蓝色方块，通过拖动蓝色方块实现自动填充

代码 
datatable(head(iris, 30), extensions = "AutoFill", options = list(autoFill = TRUE))

导出

代码 
datatable(
  head(iris, 30),
  extensions = "Buttons", options = list(
    dom = "Bfrtip",
    buttons = list(
      list(
        extend = "copy",
        text = "复制"
      ),
      list(
        extend = "print",
        text = "打印"
      ),
      list(
        extend = "collection", # 集合按键
        buttons = c("csv", "excel", "pdf"),
        text = "下载"
      )
    )
  )
)

调整列位置

代码 
datatable(head(iris, 30), extensions = c("ColReorder", "AutoFill"), options = list(colReorder = TRUE, autoFill = TRUE))

筛选列

代码 
datatable(
  head(iris, 30),
  rownames = FALSE,
  extensions = "Buttons", options = list(dom = "Bfrtip", buttons = I("colvis"))
)

冻结列

代码 
datatable(
  mtcars,
  extensions = "FixedColumns",
  options = list(
    dom = "tp",
    scrollX = TRUE,
    # fixedColumns = True
    fixedColumns = list(leftColumns = 2, rightColumns = 1)
  )
)

行分组

代码 
datatable(
  mtcars[order(mtcars$cyl), ],
  extensions = "RowGroup",
  options = list(rowGroup = list(dataSrc = 2)),
  selection = "none"
)

列分组

通过自定义container来实现列分组的功能,如下示例中rowspan = 2代表占两行,colspan = 2代表占两列

代码 
# a custom table container
library(htmltools)

sketch <- htmltools::withTags(table(
  class = 'display',
  style = 'border-collapse: collapse;', # 添加边框合并，使网格线更清晰
  thead(
    tr(
      th(rowspan = 2, style = 'border: 1px solid #D3D3D3; text-align: center;', 'Species'),
      th(colspan = 2, style = 'border: 1px solid #D3D3D3; text-align: center;', 'Sepal'),
      th(colspan = 2, style = 'border: 1px solid #D3D3D3; text-align: center;', 'Petal')
    ),
    tr(
      lapply(rep(c('Length', 'Width'), 2), function(text) {
        th(style = 'border: 1px solid #D3D3D3; text-align: center;', text)
      })
    )
  )
))

datatable(iris[1:20, c(5, 1:4)], container = sketch, rownames = FALSE,class = 'cell-border stripe')

JS引入

插入超链接

通过JS引入HTML代码，<a class="自定义 CSS 类名" href="超链接地址" title="悬停提示语">超链接显示名</a>

代码 
hrefdata <- data.frame(Id = 1:5, Letters = LETTERS[1:5], Href = rep("https://notjustbi.netlify.app/", 5))

# 由于超链接地址在表中第3列，所以列渲染时写row[3]
datatable(hrefdata,
  options = list(columnDefs = list(
    list(
      targets = 2,
      render = JS(
        "function(data, type, row, meta) {
                  return  '<a href=' + row[3] + ' title=' +row[3] +  '>' + data + '</a>'
                  }"
      )
    ), list(targets = 3, visible = FALSE) # 隐藏 hrefvalue 列
  ))
)

插入图片

代码 
imgdata <- data.frame(Id = 1:5, Letters = LETTERS[1:5], imgvalue = rep("favicon", 5))
# 由于图片名字在表中第3列，所以列渲染时写row[3]
datatable(imgdata,
  options = list(columnDefs = list(
    list(
      targets = 1,
      render = JS("function(data, type, row, meta) {
                  return  '<img width=30% src=\"' + row[3] + '.png\"/> '
                  }")
    ), list(targets = 3, visible = FALSE) # 隐藏 imgvalue 列
  ))
)

添加迷你图

通过sparkline包添加

趋势图

代码 
library(sparkline)
library(dplyr)
data <- data.frame(value = rnorm(12))

spark_html <- function(...) {
  as.character(htmltools::as.tags(sparkline(..., height = 100, width = 100)))
}

data <- data %>% summarise(
  "面积图" = spark_html(value, type = "line"),
  "柱状图" = spark_html(value, type = "bar"),
  "折线图" = spark_html(
    value,
    type = "line",
    lineColor = "red", # 折线的颜色
    fillColor = FALSE # 不展示折线下的面积
  ),
  "柱状图2" = spark_html(value, type = "bar", barColor = "green"),
  "箱图" = spark_html(value, type = "box")
)

datatable(data, escape = FALSE, options = list(fnDrawCallback = htmlwidgets::JS("function(){
               HTMLWidgets.staticRender();
                  }"))) %>%
  spk_add_deps()

饼图

代码 
df <- data.frame(group = rep(c("a", "b"), 5), value = runif(10)) %>%
  group_by(group) %>%
  summarise(piechart = as.character(htmltools::as.tags(
    sparkline(
      value,
      type = "pie", # 饼图
      sliceColors = brewer.pal(5, "Set2"), # 指定饼图中各个扇形的颜色。
      offset = 90, # 指定饼图的旋转角度
      width = 50, # 指定迷你图的宽度
      height = 50 # 指定迷你图的高度
    )
  )))



datatable(df,
  escape = FALSE,
  options = list(
    dom = "tip",
    # 每次分页重新渲染，不加这个的话只有第一页有图
    drawCallback = JS("function(s) { HTMLWidgets.staticRender(); }")
  )
) |> spk_add_deps()

组合图

代码 
df <- data.frame(group = rep(c("a", "b"), 5), value1 = runif(10), value2 = runif(10)) %>%
  group_by(group) %>%
  summarise("两条折线" = as.character(htmltools::as.tags(spk_composite(
    sparkline(
      value1,
      type = "line",
      fillColor = FALSE,
      lineColor = "red", # 指定折线的颜色
      width = 200,
      height = 100
    ),
    sparkline(
      value2,
      type = "line",
      fillColor = FALSE,
      lineColor = "green",
      width = 200,
      height = 100
    )
  ))))


datatable(df, escape = FALSE, options = list(fnDrawCallback = htmlwidgets::JS("function(){
               HTMLWidgets.staticRender();
                  }"))) |> spk_add_deps()

其他

与Plotly交互

代码 
library(crosstalk)
data <- data.frame(value1 = rnorm(10), value2 = rnorm(10), type = rep(c("a", "b"), 5))
shared_data <- SharedData$new(data)

bscols(list(
  plotly::plot_ly(
    data = shared_data,
    type = "scatter",
    mode = "markers+text",
    x =  ~value1,
    y =  ~value2,
    color =  ~type
  ),
  DT::datatable(
    shared_data,
    width = "100%",
    rownames = FALSE,
    filter = "bottom",
    # 允许使用正则，[A|B]表示多选A或B
    options = list(search = list(regex = TRUE))
  )
))

formattable

formattable包生成的静态表格可以通过as.datatable()转为DT表格

代码 
library(formattable)
products <- data.frame(
  id = 1:5,
  price = c(10, 15, 12, 8, 9),
  rating = c(5, 4, 4, 3, 4),
  market_share = percent(c(0.1, 0.12, 0.05, 0.03, 0.14)),
  revenue = accounting(c(55000, 36400, 12000, -25000, 98100)),
  profit = accounting(c(25300, 11500, -8200, -46000, 65000))
)

sign_formatter <- formatter("span",
  style = x ~ style(color = ifelse(x > 0, "green",
    ifelse(x < 0, "red", "black")
  ))
)
formattable(products, list(
  price = color_tile("transparent", "lightpink"),
  rating = color_bar("lightgreen"),
  market_share = color_bar("lightblue"),
  revenue = sign_formatter,
  profit = sign_formatter
)) %>% as.datatable()
回到顶部