DT
R语言
可视化
表格
R语言DT包生成交互式表格
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可以让设置全局生效
代码
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参数用于控制一些元素在表格周围的位置。具体而言，它决定了哪些控件（如分页、搜索框、表格信息等）显示在表格的哪个位置。
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()