我正在尝试使用purrr
/ tibble
方法生成汇总统计表。我可以使用以下方法计算分组均值(sd)和计数:
library(dplyr)
library(tidyr)
library(purrr)
library(tibble)
mtcars %>%
gather(variable, value, -vs, -am) %>%
group_by(vs, am, variable) %>%
nest() %>%
filter(variable %in% c("mpg", "hp")) %>%
mutate(
mean = map_dbl(data, ~mean(.$value, na.rm = TRUE)),
sd = map_dbl(data, ~sd(.$value, na.rm = TRUE)),
n = map_dbl(data, ~sum(!is.na(.$value)))
) %>%
select(vs:variable, mean:n) %>%
mutate_at(vars(mean, sd), round, 3) %>%
mutate(mean_sd = paste0(mean, " (", sd, ")"),
var_group = paste(vs, am, variable, sep = "_")) %>%
select(n:var_group) %>%
nest(n, mean_sd, .key = "summary") %>%
spread(key = var_group, value = summary) %>%
unnest()
我当前的问题是,如何在spread(key = var_group, value = summary)
-ed输出中保留unnest()
中的列名?
编辑:感谢所有回复。 https://stackoverflow.com/a/55912326/5745045具有易于阅读和不存储临时变量的优点。缺点是在n
列中将数字更改为字符。
最终目标是在分组的kable
表的上下文中用格式化文本替换列名。
这是另一种不需要创建临时变量的方法。我没有在最后嵌套数据,而是使用gather()
和unite()
来重构数据,使其最终成为一个键和值对。
library(tidyverse)
#> Registered S3 methods overwritten by 'ggplot2':
#> method from
#> [.quosures rlang
#> c.quosures rlang
#> print.quosures rlang
#> Registered S3 method overwritten by 'rvest':
#> method from
#> read_xml.response xml2
mtcars %>%
gather(variable, value, -vs, -am) %>%
group_by(vs, am, variable) %>%
nest() %>%
filter(variable %in% c("mpg", "hp")) %>%
mutate(
mean = map_dbl(data, ~mean(.$value, na.rm = TRUE)),
sd = map_dbl(data, ~sd(.$value, na.rm = TRUE)),
n = map_dbl(data, ~sum(!is.na(.$value)))
) %>%
select(vs:variable, mean:n) %>%
mutate_at(vars(mean, sd), round, 3) %>%
mutate(mean_sd = paste0(mean, " (", sd, ")"),
var_group = paste(vs, am, variable, sep = "_")) %>%
select(n:var_group) %>%
gather(key, value, -var_group) %>%
unite(var_group_key, var_group, key) %>%
spread(var_group_key, value)
#> # A tibble: 1 x 16
#> `0_0_hp_mean_sd` `0_0_hp_n` `0_0_mpg_mean_s… `0_0_mpg_n` `0_1_hp_mean_sd`
#> <chr> <chr> <chr> <chr> <chr>
#> 1 194.167 (33.36) 12 15.05 (2.774) 12 180.833 (98.816)
#> # … with 11 more variables: `0_1_hp_n` <chr>, `0_1_mpg_mean_sd` <chr>,
#> # `0_1_mpg_n` <chr>, `1_0_hp_mean_sd` <chr>, `1_0_hp_n` <chr>,
#> # `1_0_mpg_mean_sd` <chr>, `1_0_mpg_n` <chr>, `1_1_hp_mean_sd` <chr>,
#> # `1_1_hp_n` <chr>, `1_1_mpg_mean_sd` <chr>, `1_1_mpg_n` <chr>
由reprex package创建于2019-04-29(v0.2.1)
通过将“嵌套”tibble
存储为临时变量1并使用其colnames
2,我们可以实现您的需求。往下看;
mtcars %>%
gather(variable, value, -vs, -am) %>%
group_by(vs, am, variable) %>%
nest() %>%
filter(variable %in% c("mpg", "hp")) %>%
mutate(
mean = map_dbl(data, ~mean(.$value, na.rm = TRUE)),
sd = map_dbl(data, ~sd(.$value, na.rm = TRUE)),
n = map_dbl(data, ~sum(!is.na(.$value)))
) %>%
select(vs:variable, mean:n) %>%
mutate_at(vars(mean, sd), round, 3) %>%
mutate(mean_sd = paste0(mean, " (", sd, ")"),
var_group = paste(vs, am, variable, sep = "_")) %>%
select(n:var_group) %>%
nest(n, mean_sd, .key = "summary") %>%
spread(key = var_group, value = summary) %>%
#1: storing the temporary nested variable
{. ->> temptibble} %>%
unnest() %>%
#2: renaming the columns of unnested output and removing temporary variable
rename_all(funs(paste0(., "_", rep(colnames(temptibble), each=2)))); rm(temptibble)
# # A tibble: 1 x 16
# n_0_0_hp mean_sd_0_0_hp n1_0_0_mpg mean_sd1_0_0_mpg n2_0_1_hp mean_sd2_0_1_hp n3_0_1_mpg mean_sd3_0_1_mpg
# <dbl> <chr> <dbl> <chr> <dbl> <chr> <dbl> <chr>
# 1 12 194.167 (33.36) 12 15.05 (2.774) 6 180.833 (98.816) 6 19.75 (4.009)
# n4_1_0_hp mean_sd4_1_0_hp n5_1_0_mpg mean_sd5_1_0_mpg n6_1_1_hp mean_sd6_1_1_hp n7_1_1_mpg mean_sd7_1_1_mpg
# <dbl> <chr> <dbl> <chr> <dbl> <chr> <dbl> <chr>
# 1 7 102.143 (20.932) 7 20.743 (2.471) 7 80.571 (24.144) 7 28.371 (4.758)