本菜鸟在最近工作中遇到一个数据处理的问题，大致是要将一个普通数据框，转换成一个带有列表的数据框，然后根据转换后的数据绘制迷你图。但是转换的步骤中，我没有想到什么好办法能够一步到位，所以是鼓捣出一个中间表以后手动复制粘贴了一下。希望小伙伴们帮忙想想有没有什么一步到位的办法，感谢。
原始数据（data）长这样
```{r}
set.seed(2022)
data<-data.frame(
year = c(
rep(2017, 400),
rep(2018, 300),
rep(2019, 250),
rep(2020, 200),
rep(2021, 100),
rep(2022, 50)
),
code = rep('S06', 1300),
fee_amount = sample(1:100000, 1300),
level = sample(c('level2', 'level3'), 1300, replace = TRUE)
)
data$bins <-
ifelse(data$fee_amount <= 5000,
'0-5千',
ifelse(
data$fee_amount <= 10000,
'5千-1万',
ifelse(
data$fee_amount < 15000,
'1万-1万5千',
ifelse(
data$fee_amount < 20000,
'1万5千-2万',
ifelse(data$fee_amount < 25000, '2万-2万5千', '2万5千以上')
)
)
))
```
> head(data)
year code fee_amount level bins
1: 2017 S06 41668 level3 2万5千以上
2: 2017 S06 68287 level2 2万5千以上
3: 2017 S06 10473 level2 1万-1万5千
4: 2017 S06 99576 level2 2万5千以上
5: 2017 S06 8029 level2 5千-1万
6: 2017 S06 99255 level2 2万5千以上
转换后应该长这样（dt）
由于不知道怎么一步到位，所以先这么折腾出（dt1）：
```{r}
library(data.table)
data<-as.data.table(data)
dt1 <- data[, by = .(year, level, bins), .(freq = .N)]
dt1 <- dcast(dt1, year + bins ~ level, value.var = 'freq')
```
> head(dt1)
year bins level2 level3
1: 2017 0-5千 6 15
2: 2017 1万-1万5千 9 10
3: 2017 1万5千-2万 9 11
4: 2017 2万-2万5千 11 11
5: 2017 2万5千以上 142 149
6: 2017 5千-1万 16 11
然后把 dt1 里面的数据复制粘贴，生成一个 tibble，得到 dt
```{r}
library(tibble)
dt <- tibble(
year = c(2017:2022),
code = rep('S06', 6),
level2 = list(
v1 = c(6, 16, 9, 9, 11, 142),
v2 = c(7, 5, 7, 11, 12, 115),
v3 = c(8, 3, 11, 5, 1, 93),
v4 = c(3, 5, 2, 6, 5, 85),
v5 = c(2, 6, 1, 3, 4, 31),
v6 = c(2, 1, 1, 0, 0, 21)),
level3 = list(
v1 = c(15, 11, 10, 11, 11, 149),
v2 = c(9, 5, 5, 10, 9, 105),
v3 = c(6, 9, 5, 4, 10, 95),
v4 = c(6, 4, 7, 4, 7, 66),
v5 = c(3, 4, 1, 5, 1, 39),
v6 = c(2, 0, 1, 4, 1, 17))
)
```
最后用 dt 来绘制迷你图
```{r}
library(purrr)
library(DT)
library(sparkline)
dt$level2 <- dt$level2 |>
map( ~ sparkline(.x, type = "bar",width=100,height=40)) %>%
map(htmltools::as.tags) %>%
map_chr(as.character)
dt$level3 <- dt$level3 |>
map( ~ sparkline(.x, type = "bar",width=100,height=40)) %>%
map(htmltools::as.tags) %>%
map_chr(as.character)
DT::datatable(
dt,
escape = FALSE,
rownames = FALSE,
options = list(scrollY = FALSE,
autoWidth = TRUE)
) %>% spk_add_deps()
```
上面写的是 data-->dt1-->dt，其中 dt1-->dt 那个步骤还需要手动复制粘贴，有什么办法从 data 直接用代码 转换生成 dt ？
