一入表格深似海，从此节操是路人。啊呸，不是，最近银魂看多了阿鲁……
上半年的时候本咸鱼开始琢磨 R 中的一些表格包，上 CRAN 搜了搜，包子真多。
-
动态表格包有：
-
静态表格包有：
-
可与表格包搭配使用的 html 小部件有：
-
可在 R 中引入 css、html、JavaScript的助攻包：
- htmltools，文档有40页，最近更新于2022年7月18日。
-
还有 shiny……
本咸鱼工作中用表格包子的机会比较少，最初想学点表格、顺带写点笔记的初衷有二：其一，R 江湖里表格包太多了，各自都有优缺点，想给自己写一份速查手册；其二，各表格包作者都写了使用文档，但是思路大不一样，希望能让绘制表格时像绘制图形一样理解表格中能修改的元素。
由于 DT 包子的文档页数最少，于是最先了解它，又由于想捋捋表格包子之间共通的元素，于是想着先试试用 DT 来复现 reactable 的案例。说到案例，老早之前湘云1丢过来一个链接，上面有许多很漂亮的表格案例，俺曾动过心思想着是不是应该一个接一个去琢磨那些案例，要是还在学生时期的话，说不定真得有很多时间可以这么干，无奈的是已经成为社畜很多年了。不过，等到琢磨完一个案例后，又有了一些新的思考……
要复现的reactable 包子的案例 Women’s World Cup 长这样。
案例中有一份数据和一些国家国旗的图片，在这里下载。在本地的工作目录中，数据存放在'data/.csv'，图片存放在'images/.png'。
library(DT)
library(htmltools)
library(htmlwidgets)
forecasts <- read.csv('data/wwc_forecasts.csv')
注：复现时但凡遇到代码中写作
class=''，引号里面都是一些事先写好的 css 样式设定。
一、插入图片 🔗
原案例中借助 htmltools 包，在 R 中直接使用了 html 元素，将原来的team和points列合在一起，并且插入图片。
library(reactable)
reactable(forecasts[, c("team", "points", "group")],
columns = list(team = colDef(
cell = function(value, index) {
div(class = "team", # 最外层的div()块
img( # 放入一个img()，插入图片
class = "team-flag",
alt = paste(value, "flag"),
src = sprintf("images/%s.png", value)
),
div( # 放入一个div()块，装进去两个span()用于展示原来的两列数据
span(class = "team-name", value),
span(class = "team-record", sprintf("%s pts.", forecasts[index, "points"]))
))
}
)))
1.1. 将 html 和 css 代码直接写到数据框里 🔗
还原成 html 后，一个单元格中的内容长这样。
<div class="team">
<img class="team-flag" src="images/USA.png" />
<div>
<span class="team-name">USA<span/>
<span class="team-record"> 6 pts.<span/>
<div/>
<div/>
直接写到数据框里，便是下面这样。
df1 <- data.frame(
flag = c(
'<div class="team"><img class="team-flag" src="images/USA.png" /><div><span class="team-name">USA<span/><span class="team-record"> 6 pts.<span/><div/><div/>',
'<div class="team"><img class="team-flag" src="images/France.png" /><div><span class="team-name">France<span/><span class="team-record"> 6 pts.<span/><div/><div/>',
'<div class="team"><img class="team-flag" src="images/Germany.png" /><div><span class="team-name">Germany<span/><span class="team-record"> 6 pts.<span/><div/><div/>',
'<div class="team"><img class="team-flag" src="images/Canada.png" /><div><span class="team-name">Canada<span/><span class="team-record"> 6 pts.<span/><div/><div/>'
),
group = c('F', 'A', 'B', 'E')
)
DT::datatable(df1, escape = FALSE)
1.2. 使用回调函数 🔗
原案例在引入图片路径时写作src = sprintf("images/%s.png")，引用了sprintf()函数。
```{r}
sprintf("images/%s.png", c("USA", "France", "Germany", "Canada"))
```
[1] "images/USA.png" "images/France.png" "images/Germany.png" "images/Canada.png"
JavaScript 里面也有sprintf函数，不过俺没弄明白怎么在 R 中用JS()引入 JS 时用这个函数，于是引入图片路径的部分改写成下面这样。
datatable(forecasts[, c('team', 'points', 'group')],
rownames = FALSE,
options = list(pageLength = 5,
columnDefs = list(list(
targets = 0,
render = JS(
"function(data, type, row, meta) {
return '<img class=\"team-flag\" src=\"images/' + data + '.png\" />'
}"
)
))))
二、复现过程 🔗
2.1. 准备数据 🔗
为了方便跟原案例对照着看，先把各列数据的名字改为跟案例上的一致。
forecasts <- forecasts[, c(
'team', 'group',
'spi', 'global_o', 'global_d',
'group_1', 'group_2', 'group_3',
'make_round_of_16', 'make_quarters', 'make_semis', 'make_final', 'win_league','points')]
colnames(forecasts) <-
c('TEAM', 'GROUP',
'SPI', 'OFF.', 'DEF.',
'1st place', '2nd place', '3rd placce',
'make round of 16', 'make qtr-finals', 'make semifinals', 'make final', 'win world cup','points')
2.2. 准备渐变颜色 🔗
参照填充渐变颜色的笔记。第一步，准备渐变颜色时，为 DT 包子中formatStyle()中的styleInterval()准备数据。
make_color_pal <- function(colors, bias = 1) {
get_color <- colorRamp(colors, bias = bias)
function(x) rgb(get_color(x), maxColorValue = 255)
}
# 输入函数中的数值范围应为[0,1]
# color1，由红变绿，bias>1，则绿色更多
color1 <- make_color_pal(c("#ff2700", "#f8fcf8", "#44ab43"), bias = 1.3)
# color2，由红变绿，bias<1，则红色更多
color2 <- make_color_pal(c("#ff2700", "#f8fcf8", "#44ab43"), bias = 1.3)
# color3，由白变绿
color3 <- make_color_pal(c("#ffffff", "#f2fbd2", "#c9ecb4", "#93d3ab", "#35b0ab"), bias = 2)
#
# 使用color1
brks.off <-
quantile(forecasts$OFF.,
probs = seq(.05, .95, .1),
na.rm = TRUE)
scaled.off <-
(sort(brks.off) - min(brks.off)) / (max(brks.off) - min(brks.off))
clrs.off <- color1(scaled.off)
brks.off.new <- quantile(forecasts$OFF.,
probs = seq(.05, .95, length.out = 9),
na.rm = TRUE)
# 使用color2
brks.def <-
quantile(forecasts$DEF.,
probs = seq(.05, .95, .1),
na.rm = TRUE)
scaled.def <-
(sort(brks.def, decreasing = T) - min(brks.def)) / (max(brks.def) - min(brks.def))
clrs.def <- color2(scaled.def)
brks.def.new <- quantile(forecasts$DEF.,
probs = seq(.05, .95, length.out = 9),
na.rm = TRUE)
# 使用color3
make_colors<-function(value){
brks<-quantile(value,
probs = seq(.05, .95, .1),
na.rm = TRUE)
scaled<-(sort(brks) - min(brks)) / (max(brks) - min(brks))
color3(scaled)
}
clrs.f1<-make_colors(forecasts$`make round of 16`)
brks.f1<-quantile(forecasts$`make round of 16`,
probs = seq(.05, .95, length.out = 9),
na.rm = TRUE)
clrs.f2<-make_colors(forecasts$`make qtr-finals`)
brks.f2<-quantile(forecasts$`make qtr-finals`,
probs = seq(.05, .95, length.out = 9),
na.rm = TRUE)
clrs.f3<-make_colors(forecasts$`make semifinals`)
brks.f3<-quantile(forecasts$`make semifinals`,
probs = seq(.05, .95, length.out = 9),
na.rm = TRUE)
clrs.f4<-make_colors(forecasts$`make final`)
brks.f4<-quantile(forecasts$`make final`,
probs = seq(.05, .95, length.out = 9),
na.rm = TRUE)
clrs.f5<-make_colors(forecasts$`win world cup`)
brks.f5<-quantile(forecasts$`win world cup`,
probs = seq(.05, .95, length.out = 9),
na.rm = TRUE)
第二步，做数据转换，字段名称是小写字母的是原来的数据，字段名称是大写字母的是转换后的数据。
format_pct <- function(value) {
ifelse(value == 0, " \u2013 " , # en dash for 0%
ifelse(value == 1, "\u2713", # checkmark for 100%
ifelse(
value < 0.01, "<1%",
ifelse(value > 0.99, ">99%",
formatC(paste0(
round(value * 100), "%"
), width = 4))
)))
}
forecasts$`1ST PLACE` <- format_pct(forecasts$`1st place`)
forecasts$`2ND PLACE` <- format_pct(forecasts$`2nd place`)
forecasts$`3RD PLACE` <- format_pct(forecasts$`3rd placce`)
forecasts$`MAKE ROUND OF 16` <- format_pct(forecasts$`make round of 16`)
forecasts$`MAKE QTR-FINALS` <- format_pct(forecasts$`make qtr-finals`)
forecasts$`MAKE SEMIFINALS` <- format_pct(forecasts$`make semifinals`)
forecasts$`MAKE FINAL` <- format_pct(forecasts$`make final`)
forecasts$`WIN WORLD CUP` <- format_pct(forecasts$`win world cup`)
2.3. 准备表头 🔗
参照之前琢磨的创建多层表头的笔记。
sketch = htmltools::withTags(table(
class = 'display',
thead(
tr(
class = 'header',
th(rowspan = 2, 'TEAM'),
th(rowspan = 2, 'GROUP'),
th(rowspan = 1, colspan = 3, 'Team Rating'),
th(rowspan = 1,
colspan = 3,
'Chance of Finishing Group Stage In ...'),
th(rowspan = 1,
colspan = 6,
'Knockout Stage Chances'),
th(rowspan = 1,
colspan = 3,
'Chance of Finishing Group Stage In ...'),
th(rowspan = 1,
colspan = 5,
'Knockout Stage Chances')
),
tr(class = 'header',
lapply(
c(
'SPI',
'OFF.',
'DEF.',
'1st place',
'2nd place',
'3rd placce',
'make round of 16',
'make qtr-finals',
'make semifinals',
'make final',
'win world cup',
'points',
'1ST PLACE',
'2ND PLACE',
'3RD PLACE',
'MAKE ROUND OF 16',
'MAKE QTR-FINALS',
'MAKE SEMIFINALS',
'MAKE FINAL',
'WIN WORLD CUP'
),
th
))
)))
2.5. 复现代码 🔗
DT 和 reactable 有很多地方特别相似。至于两者的区别嘛，笔者猴年马月再写吧。
-
DT 包源于 JavaScript 中 jQuery 库里的 Datatables 表格插件，而 reactable 包源于 JavaScript 中的 React 库中的 React Table 组件。可能由于都源于 JavaScript，两个包很多函数名称也很相似。
-
鼓捣复杂的表格样式时，都可以对每一列做单独设置。比如 DT 写作
datatable(forecasts, options = list(initComplete = JS(), columnDefs = list(list(targets = 0, ''), list(targets = 1, ''))))，在initComplete=JS()里面写整体上的初始设定，在columnDefs = list()里面对每一列做单独设定。而 reactable 写作reactable(defaultColDef = colDef(), columns = list(team = list(), group = list()))，在defaultColDef = colDef()里面写整体设定，在columns = list()写单独设定。
datatable(
forecasts,
rownames = FALSE,
escape = FALSE,
container = sketch ,
options = list(
dom = 't',
pageLength = 24,
autoWidth = TRUE,
initComplete = JS(
"function(settings, json) {
$(this.api().table().header()).css({'font-weight': 700});
}"),
columnDefs = list(
list(
targets = 0, # TEAM
className = 'dt-left',
width = '200px',
render = JS(
"function(data, type, row, meta) {
return '<div class=\"team\">'+'<img class=\"team-flag\" src=\"images/' + data + '.png\" />'+'<div><span class=\"team-name\">'+data+'<span/><span class=\"team-record\"> 6 pts.<span/><div/>'+'<div/>'
}"
)
),
list(
targets = 1, # GROUP
className = 'dt-center',
width = '75px',
render = JS(
"function(data, type, row, meta){
return '<div class=\"cell group\">' +data+ '</div>'
}"
)
),
list(targets = c(2, 3, 4), # SPI OFF. DEF.
className = 'dt-center',
width = '55px'),
list(
targets = c(
5, #'1st place',
6, #'2nd place',
7, #'3rd placce',
8, #'make round of 16',
9, #'make qtr-finals',
10, # 'make semifinals',
11, #'make final',
12, #'win world cup',
13 # 'points'
),
visible = FALSE # 将数据转换之前的列隐藏
),
list(
targets = 14,
class = 'border-left',
width = '70px',
className = 'dt-center'
),
list(targets = 15,
className = 'dt-center',
width = '70px'),
list(
targets = 16,
class = 'border-right',
width = '70px',
className = 'dt-center'
),
list(
targets = c(17, 18, 19, 20, 21),
className = 'dt-right',
width = '70px'
)
)
),
class = 'standing-table') |>
formatStyle('OFF.', backgroundColor = styleInterval(brks.off.new, clrs.off)) |>
formatStyle('DEF.', backgroundColor = styleInterval(brks.def.new, clrs.def)) |>
formatStyle(
columns = 'MAKE ROUND OF 16',
valueColumns = 'make round of 16',
backgroundColor = styleInterval(brks.f1, clrs.f1)) |>
formatStyle(
columns = 'MAKE QTR-FINALS',
valueColumns = 'make qtr-finals',
backgroundColor = styleInterval(brks.f2, clrs.f2)) |>
formatStyle(
columns = 'MAKE SEMIFINALS',
valueColumns = 'make semifinals',
backgroundColor = styleInterval(brks.f2, clrs.f2)) |>
formatStyle(
columns = 'MAKE FINAL',
valueColumns = 'make final',
backgroundColor = styleInterval(brks.f2, clrs.f2)) |>
formatStyle(
columns = 'WIN WORLD CUP',
valueColumns = 'win world cup',
backgroundColor = styleInterval(brks.f2, clrs.f2)) |>
formatRound(columns = c("SPI", "OFF.", "DEF."),
digits = 1)
三、遗留问题 🔗
3.1. 同时插入图片和合并多列数据（已解决） 🔗
在render=JS("function(data, type, row, meta) {data+row[6]}")里面，data 就是指本来进行列渲染的那列，row[6] 就是指其他列数据。
原例中是用 div 框把图片和数据框起来，照着来的话，会出现在同一列中图片和数据错位的情况，所以把 div 框去掉了。
datatable(
forecasts[, c('team', 'group',
'spi', 'global_o', 'global_d', 'points')],
colnames = c('TEAM', 'GROUP', 'SPI', 'OFF.', 'DEF.', 'opts'),
options = list(columnDefs = list(
list(
targets = 1,
render = JS(
"function(data, type, row, meta) {
return '<img class=\"team-flag\" src=\"images/' + data + '.png\" />'
+'<span class=\"team-name\">'+data+'<span/><span class=\"team-record\">' + row[6] + '.opts'+'<span/>'
}"
)
), list(targets = 6, visible = FALSE)
))
)
3.2. class 和 className 冲突（已解决） 🔗
对数据中其中一列同时设置class = 'border-left'（字段左边增加外框线）和className = 'dt-center'（字段居中展示）时，两者产生冲突，增加左边外框线起了作用，连带着数据整体居左。
datatable(forecasts[, c('TEAM', 'GROUP', 'SPI', 'OFF.', 'DEF.')],
rownames = FALSE,
options = list(
pageLength = 5,
columnDefs = list(
list(targets = 0, className = 'dt-left'),
list(targets = 1, className = 'dt-right'),
list(targets = c(2, 3), className = 'dt-center'),
list(
targets = 4, # DEF.
class = 'border-left',
className = 'dt-center'
)
)
))
把增加左外框线写到render = JS()里面后，数据能正常居中展示，但是左外框线迷之不连贯。
datatable(
forecasts[, c('TEAM', 'GROUP', 'SPI', 'OFF.', 'DEF.')],
rownames = FALSE,
options = list(
pageLength = 5,
columnDefs = list(
list(targets = 0, className = 'dt-left'),
list(targets = 1, className = 'dt-right'),
list(targets = c(2, 3), className = 'dt-center'),
list(
targets = 4,
className = 'dt-center',
render = JS(
"function(data, type, row, meta){
return '<div class=\"border-left\">' +data+ '</div>'
}")))))
尝试把居中和左外框线写到一个css样式里面，终于正常了。
```{css}
.border-left-new {
border-left: 2px solid #555;
text-align:center;
}
```
datatable(forecasts[, c('TEAM', 'GROUP', 'SPI', 'OFF.', 'DEF.')],
rownames = FALSE,
options = list(
pageLength = 5,
columnDefs = list(
list(targets = 0, className = 'dt-left'),
list(targets = 1, className = 'dt-right'),
list(targets = c(2, 3), className = 'dt-center'),
list(
targets = 4, # DEF.
class = 'border-left-new'))))
3.3. 特殊的 css 设定冲突 🔗
原案例中有两列引入了特殊的 css 设定spi-rating，用来将数据的背景形状弄成一个圆形。像下面这样直接class = "spi-rating"引入此样式的话，会连表头的样式也一块改变。
datatable(
forecasts[, c('TEAM', 'GROUP', 'SPI', 'OFF.', 'DEF.')],
rownames = FALSE,
options = list(pageLength = 5,
columnDefs = list(
list(targets = 3, class = "spi-rating"),
list(targets = 4, class = "spi-rating")
))) |>
formatStyle('OFF.', backgroundColor = styleInterval(brks.off.new, clrs.off)) |>
formatStyle('DEF.', backgroundColor = styleInterval(brks.def.new, clrs.def)) |>
formatRound(columns = c('SPI', 'OFF.', 'DEF.'),
digits = 1)
把这个特殊设定以render = JS()的方式引入的话，作为背景的圆形能正常显示，并且表头也不会被改变。
datatable(forecasts[, c('TEAM', 'GROUP', 'SPI', 'OFF.', 'DEF.')],
rownames = FALSE,
options = list(
pageLength = 5,
columnDefs = list(
list(
targets = 3,
className = 'dt-center',
render = JS(
"function(data, type, row, meta){
return '<div class=\"spi-rating\">' +data+ '</div>'
}")),
list(
targets = 4,
className = 'dt-center',
render = JS(
"function(data, type, row, meta){
return '<div class=\"spi-rating\">' +data+ '</div>'
}" )))))
但是这样写的话，引入的 css 样式同时使用formatStyle()时前者会被后者覆盖。唉，spi-rating里面的参数设定能看明白都代表意思，但是全拢到一起就不明白为撒为这样了。
datatable(forecasts[, c('TEAM', 'GROUP', 'SPI', 'OFF.', 'DEF.')],
rownames = FALSE,
options = list(
pageLength = 5,
columnDefs = list(
list(
targets = 3,
className = 'dt-center',
render = JS(
"function(data, type, row, meta){
return '<div class=\"spi-rating\">' +data+ '</div>'
}"
)
),
list(
targets = 4,
className = 'dt-center',
render = JS(
"function(data, type, row, meta){
return '<div class=\"spi-rating\">' +data+ '</div>'
}"
)
)
))) |>
formatStyle('OFF.', backgroundColor = styleInterval(brks.off.new, clrs.off)) |>
formatStyle('DEF.', backgroundColor = styleInterval(brks.def.new, clrs.def)) |>
formatRound(columns = c('SPI', 'OFF.', 'DEF.'),
digits = 1)
3.4. 字体大小的设置问题 🔗
原案例用rem来设定字体的大小，迷之没弄明白为撒鼓捣出来的字体比原案例小得多。
3.5.渐变颜色代码简写（已解决） 🔗
原例中对于’OFF.‘和’DEF.‘这两列，为了把class="spi-rating"样式和渐变颜色写在一起，因此把渐变颜色写得颇有些麻烦，如下是简便写法。
#为global_o列，即OFF.列准备渐变颜色
brks.off <-
quantile(forecasts$global_o,
probs = seq(.05, .95, .1),
na.rm = TRUE)
clrs.off <-
colorRampPalette(c("#ff2700", "#f8fcf8", "#44ab43"), bias = 1.3)(length(brks.off) + 1)
#为global_d列，即DEF.列准备渐变颜色
brks.def <-
quantile(forecasts$global_d,
probs = seq(.05, .95, .1),
na.rm = TRUE)
clrs.def <-
colorRampPalette(c("#ff2700", "#f8fcf8", "#44ab43"), bias = 1.3)(length(brks.def) + 1)
datatable(
forecasts[, c('team', 'group',
'spi', 'global_o', 'global_d')],
colnames = c('TEAM', 'GROUP', 'SPI', 'OFF.', 'DEF.')) |>
formatStyle(columns = 'global_o',
backgroundColor = styleInterval(brks.off, clrs.off)) |>
formatStyle(columns = 'global_d',
backgroundColor = styleInterval(brks.def, clrs.def)) |>
formatRound(columns = c('spi', 'global_o', 'global_d'),
digits = 1)
所谓的“一入表格深似海”是指绘制表格可以引入许多 css、html、js，这些我现在是一窍不通，也许将来积累得多些能用得更熟点，但现在确实是还未入门。
在琢磨这个案例的时候，我一直在想“用表格展示数据”相比“用图形展示数据”会有哪些优势。在引入顺序、颜色、形状、边框线等元素后，其实表格也很适合用来展示高维度的数据，尤其是引入css、html、js，还有 sparkline，以及各种交互组件后，R 中的“表格”早已不同于 EXCEL 里面纯纯的表格。至于我的初衷，那自然是没完成的，八字连一撇都没有。
下面是从原案例搬过来的 css 设定，俺只对照border-left增加了一个border-right。
```{css}
.standings {
font-family: Karla, "Helvetica Neue", Helvetica, Arial, sans-serif;
font-size: 0.875rem;
}
.title {
margin-top: 2rem;
margin-bottom: 1.125rem;
font-size: 1rem;
}
.title h2 {
font-size: 1.25rem;
font-weight: 600;
}
.standings-table {
margin-bottom: 1.25rem;
}
.header {
border-bottom-color: #555;
font-size: 0.8125rem;
font-weight: 400;
text-transform: uppercase;
}
/* Highlight headers when sorting */
.header:hover,
.header[aria-sort="ascending"],
.header[aria-sort="descending"] {
background-color: #eee;
}
.border-left {
border-left: 2px solid #555;
}
.border-right {
border-right: 2px solid #555;
}
/* Use box-shadow to create row borders that appear behind vertical borders */
.cell {
box-shadow: inset 0 -1px 0 rgba(0, 0, 0, 0.15);
}
.group-last .cell {
box-shadow: inset 0 -2px 0 #555;
}
.team {
display: flex;
align-items: center;
}
.team-flag {
height: 1.3rem;
border: 1px solid #f0f0f0;
}
.team-name {
margin-left: 0.5rem;
font-size: 1.125rem;
font-weight: 700;
}
.team-record {
margin-left: 0.35rem;
color: hsl(0, 0%, 45%);
font-size: 0.8125rem;
}
.group {
font-size: 1.1875rem;
}
.number {
font-family: "Fira Mono", Consolas, Monaco, monospace;
font-size: 1rem;
white-space: pre;
}
.spi-rating {
display: flex;
align-items: center;
justify-content: center;
margin: auto;
width: 1.875rem;
height: 1.875rem;
border: 1px solid rgba(0, 0, 0, 0.1);
border-radius: 50%;
color: #000;
font-size: 0.8125rem;
letter-spacing: -1px;
}
```
-
统计之都的编辑大人，他的个人博客地址是：https://xiangyun.rbind.io/post/。 ↩︎