formattable:万物皆可Format

formattable:万物皆可Format

这是个非常有意思的包,可以用来创建可视化表格。同时这个包里还提供了一些很好用的函数。这个包的GitHub地址为:renkun-ken/formattable

percent()函数

R
1
2
3
4
5
6
7
> library(formattable)
> (p <- percent(c(0.1, 0.2, 0.3, 0.12)))
[1] 10.00% 20.00% 30.00% 12.00%
> p + 0.5
[1] 60.00% 70.00% 80.00% 62.00%
> max(p)
[1] 30.00%

accounting()函数

R
1
2
3
4
> (balance <- accounting(c(100, 120, -150, 0, 1200)))
[1] 100.00 120.00 (150.00) 0.00 1,200.00
> balance + 100
[1] 200.00 220.00 (50.00) 100.00 1,300.00

formattable()函数

对日期格式化

R
1
2
3
4
5
6
7
8
9
> (dates <- formattable(
+ as.Date(c("2018-11-24",
+ "2018-11-25")),
+ format = "%Y-%m-%d"
+ ))
[1] 2018-11-24 2018-11-25

> dates + 30
[1] 2018-12-24 2018-12-25

对逻辑向量的格式化

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
> (lv <- formattable(c(T, F, T, F), "是", "否"))
[1] 是 否 是 否
> !lv
[1] 否 是 否 是

> isTRUE(lv[1])
[1] TRUE
> isTRUE(lv[2])
[1] FALSE

> all(lv)
[1] 否
> any(lv)
[1] 是

对矩阵的格式化

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
> (pm <- matrix(rnorm(6, 0.8, 0.1), 2, 3,
+ dimnames = list(c("a", "b"),
+ c("X", "Y", "Z"))))
X Y Z
a 0.8263660 0.7923373 0.6860136
b 0.7243106 0.8653115 0.8118198

> (fpm <- percent(pm))
X Y Z
a 82.64% 79.23% 68.60%
b 72.43% 86.53% 81.18%

> fpm["a", c("Y", "Z")]
Y Z
79.23% 68.60%

对数组的格式化

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
> (pa <- array(rnorm(12, 0.8, 0.1), c(2, 3, 2)))
, , 1

[,1] [,2] [,3]
[1,] 0.7694223 0.6968857 0.7383032
[2,] 0.8430360 0.6487546 0.6856595

, , 2

[,1] [,2] [,3]
[1,] 0.7244451 0.7819929 0.7506563
[2,] 0.8601994 0.7083600 0.5446908

> percent(pa)
, , 1

[,1] [,2] [,3]
[1,] 76.94% 69.69% 73.83%
[2,] 84.30% 64.88% 68.57%

, , 2

[,1] [,2] [,3]
[1,] 72.44% 78.20% 75.07%
[2,] 86.02% 70.84% 54.47%

对数据框的格式化

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
> (p <- data.frame(
+ id = c(1, 2, 3, 4, 5),
+ name = c("A1", "A2", "B1", "B2", "C1"),
+ balance = accounting(c(52500, 36150, 25000, 18300, 7600), format = "d"),
+ growth = percent(c(0.3, 0.3, 0.1, 0.15, 0.15), format = "d"),
+ ready = formattable(c(TRUE, TRUE, FALSE, FALSE, TRUE), "yes", "no")))
id name balance growth ready
1 1 A1 52,500 30% yes
2 2 A2 36,150 30% yes
3 3 B1 25,000 10% no
4 4 B2 18,300 15% no
5 5 C1 7,600 15% yes

> p[1:3, c("name", "balance")]
name balance
1 A1 52,500
2 A2 36,150
3 B1 25,000

可视化表格

最简单的例子

R
1
2
3
4
5
6
7
8
(scores <- data.frame(id = 1:5,
prev_score = c(10, 8, 6, 8, 8),
cur_score = c(8, 9, 7, 8, 9),
change = c(-2, 1, 1, 0, 1)))
formattable(scores)
formattable(scores) %>%
as.htmlwidget() %>%
htmlwidgets::saveWidget("table2.html")


table2.html

实际上formattable函数是调用knitr::kable()把数据框翻译成html语句。此外,formattable函数支持自定义转换方式:

R
1
2
3
4
> plain_formatter <- formatter("span")
> plain_formatter(c(1, 2, 3))
[1] "<span>1</span>" "<span>2</span>"
[3] "<span>3</span>"

R
1
2
3
4
5
6
> width_formatter <- formatter("span",
+ style = x ~ style(width = suffix(x, "px")))
> width_formatter(c(10, 11, 12))
[1] "<span style=\"width: 10px\">10</span>"
[2] "<span style=\"width: 11px\">11</span>"
[3] "<span style=\"width: 12px\">12</span>"
R
1
2
3
4
5
6
7
8
9
10
11
sign_formatter <- formatter("span",
style = x ~ style(color = ifelse(x > 0, "green",
ifelse(x < 0, "red", "black"))))
sign_formatter(c(-1, 0, 1))
# [1] "<span style=\"color: red\">-1</span>"
# [2] "<span style=\"color: black\">0</span>"
# [3] "<span style=\"color: green\">1</span>"
formattable(scores, list(change = sign_formatter))
formattable(scores, list(change = sign_formatter)) %>%
as.htmlwidget() %>%
htmlwidgets::saveWidget("table3.html")

table3.html

R
1
2
3
4
5
6
7
8
9
10
11
12
13
above_avg_bold <- formatter("span",
style = x ~ style("font-weight" =
ifelse(x > mean(x), "bold", NA)))
formattable(scores, list(
prev_score = above_avg_bold,
cur_score = above_avg_bold,
change = sign_formatter))
formattable(scores, list(
prev_score = above_avg_bold,
cur_score = above_avg_bold,
change = sign_formatter)) %>%
as.htmlwidget() %>%
htmlwidgets::saveWidget("table4.html")


table4.html

交叉格式化

也就是说一个变量的显示格式由另外一个变量的条件决定。

R
1
2
3
4
5
formattable(scores,
list(
cur_score = formatter("span",
style = ~ style(color = ifelse(change >= 0, "green", "red")))
))

隐藏列

R
1
formattable(scores, list(prev_score = F))

使用内置格式

R
1
2
3
4
5
6
7
(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))))
formattable(products)

注意,在会计报表中用括号括起来的值表示负值。

R
1
formattable(products, list(profit = sign_formatter))

R
1
2
3
4
5
6
7
formattable(products,list(
price = color_tile("transparent", "lightpink"),
rating = color_bar("lightgreen"),
market_share = color_bar("lightblue"),
revenue = sign_formatter,
profit = sign_formatter
))

R
1
2
3
4
5
6
7
8
9
10
11
12
set.seed(123)
df <- data.frame(
id = 1:10,
a = rnorm(10),
b = rnorm(10),
c = rnorm(10)
)
formattable(df, list(
area(col = a:c) ~ color_tile(
"transparent", "pink"
)
))

R
1
formattable(df[, -1], list(~ percent))

动态格式化

R
1
2
3
4
5
6
7
8
9
10
(df <- cbind(data.frame(id = 1:10),
do.call(
cbind,
lapply(1:8, function(x) rnorm(10))
)))

formattable(df,
lapply(1:nrow(df), function(row){
area(row, col = -1) ~ color_tile("lightpink", "lightblue")
}))

转换成DT::datatables

R
1
as.datatable(formattable(products))

R
1
2
3
4
as.datatable(formattable(products, list(
price = color_tile("transparent", "lightpink"),
revenue = sign_formatter,
profit = sign_formatter)))

一个例子

R
1
2
3
4
5
6
7
8
9
10
11
12
13
df <- data.frame(
id = 1:10,
name = c("Bob", "Ashley", "James", "David", "Jenny",
"Hans", "Leo", "John", "Emily", "Lee"),
age = c(28, 27, 30, 28, 29, 29, 27, 27, 31, 30),
grade = c("C", "A", "A", "C", "B", "B", "B", "A", "C", "C"),
test1_score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6),
test2_score = c(9.1, 9.1, 9.2, 9.1, 8.9, 8.5, 9.2, 9.3, 9.1, 8.8),
final_score = c(9, 9.3, 9.4, 9, 9, 8.9, 9.25, 9.6, 8.8, 8.7),
registered = c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE),
stringsAsFactors = FALSE)
# 输出为markdown表格
knitr::kable(df)
id name age grade test1_score test2_score final_score registered
1 Bob 28 C 8.9 9.1 9.00 TRUE
2 Ashley 27 A 9.5 9.1 9.30 FALSE
3 James 30 A 9.6 9.2 9.40 TRUE
4 David 28 C 8.9 9.1 9.00 FALSE
5 Jenny 29 B 9.1 8.9 9.00 TRUE
6 Hans 29 B 9.3 8.5 8.90 TRUE
7 Leo 27 B 9.3 9.2 9.25 TRUE
8 John 27 A 9.9 9.3 9.60 FALSE
9 Emily 31 C 8.5 9.1 8.80 FALSE
10 Lee 30 C 8.6 8.8 8.70 FALSE
R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(p <- formattable(
df,
list(
age = color_tile("white", "orange"),
grade = formatter(
"span", style = x ~ ifelse(x == "A", style(
color = "green", font.weight = "bold"
), NA)
),
area(col = c(test1_score, test2_score)) ~ normalize_bar("pink", 0.2),
final_score = formatter("span", style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")), x ~ sprintf("%.2f (排名: %02d)", x, rank(-x))),
registered = formatter("span", style = x ~ style( color = ifelse(x, "green", "red")),
x ~ icontext(ifelse(x, "ok", "remove"),
ifelse(x, "Yes", "No"))
)
)))

还可以把这个表格保存为html文件:

R
1
2
p <- formattable::as.htmlwidget(p)
htmlwidgets::saveWidget(p, "table.html")

网页效果:可视化表格

这里的icontext可以在这里找到:glyphiconsbootstrap

comma()函数

R
1
2
3
4
> (p1 <- comma(c(100, 80, 20), 4))
[1] 100.0000 80.0000 20.0000
> p1 + 20
[1] 120.0000 100.0000 40.0000

suffix()函数

R
1
2
3
4
> (p2 <- suffix(c(1, 2, 3, 4), "月"))
[1] 1234
> p2 + 1
[1] 2345

comma()

R
1
2
3
4
> (p1 <- comma(c(100, 80, 20), 4))
[1] 100.0000 80.0000 20.0000
> p1 + 20
[1] 120.0000 100.0000 40.0000

suffix()

R
1
2
3
4
> (p2 <- suffix(c(1, 2, 3, 4), "月"))
[1] 1234
> p2 + 1
[1] 2345

prefix()

R
1
2
> (p <- prefix(c(1, 2, 3), "排名:"))
[1] 排名:1 排名:2 排名:3

scientific()

R
1
2
3
4
5
6
> (p1 <- scientific(c(100, 1000, 10000), "e"))
[1] 1.0000e+02 1.0000e+03 1.0000e+04
> (p2 <- scientific(c(100, 1000, 10000), "E"))
[1] 1.0000E+02 1.0000E+03 1.0000E+04
> p1 + 100
[1] 2.0000e+02 1.1000e+03 1.0100e+04

currency()

R
1
2
3
4
5
6
> currency(c(10, 12, 23), "CNY")
[1] CNY10.00 CNY12.00 CNY23.00
> (p <- currency("CNY 12", "CNY"))
[1] CNY12
> p + 10
[1] CNY22

digits()

R
1
2
> digits(c(10, 1.2, 230), 2)
[1] 10.00 1.20 230.00

normalize(): 将一个向量归一化

R
1
2
> normalize(c(1, 2, 3, 4))
[1] 0.0000000 0.3333333 0.6666667 1.0000000
# R

评论

程振兴

程振兴 @czxa.top
截止今天,我已经在本博客上写了658.8k个字了!

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×