r语言 - 使用 dplyr v1.0.0 取消嵌套 tibble 列："Wide"数据摘要

Question

我想以这种格式生成"宽"数据汇总表：

----   Centiles  ----
Param    Group   Mean       SD      25%     50%      75%
Height       1   x.xx    x.xxx     x.xx    x.xx     x.xx
2   x.xx    x.xxx     x.xx    x.xx     x.xx
3   x.xx    x.xxx     x.xx    x.xx     x.xx
Weight       1   x.xx    x.xxx     x.xx    x.xx     x.xx
2   x.xx    x.xxx     x.xx    x.xx     x.xx
3   x.xx    x.xxx     x.xx    x.xx     x.xx

我可以在 dplyr 0.8.x 中做到这一点。 我通常可以做到这一点，使用一个函数可以处理具有任意数量的级别的任意分组变量和任意统计数据，以任意名称汇总任意数量的变量。 我通过使数据整洁来获得这种程度的灵活性。 这不是这个问题的内容。

首先，一些玩具数据：

set.seed(123456)
toy <- tibble(
Group=rep(1:3, each=5),
Height=1.65 + rnorm(15, 0, 0.1),
Weight= 75 + rnorm(15, 0, 10)
) %>% 
pivot_longer(
values_to="Value", 
names_to="Parameter",
cols=c(Height, Weight)
)

现在，一个简单的汇总函数和一个帮助程序：

quibble2 <- function(x, q = c(0.25, 0.5, 0.75)) {
tibble(Value := quantile(x, q), "Quantile" := q)
}
mySummary <- function(data, ...) {
data %>% 
group_by(Parameter, Group) %>% 
summarise(..., .groups="drop")
}

所以我可以说这样的话

summary <- mySummary(toy, Q=quibble2(Value), Mean=mean(Value, na.rm=TRUE), SD=sd(Value, na.rm=TRUE))
summary %>% head()

给

# A tibble: 6 x 5
Parameter Group Q$Value $Quantile  Mean     SD
<chr>     <int>   <dbl>     <dbl> <dbl>  <dbl>
1 Height        1    1.45      0.25  1.54 0.141 
2 Height        1    1.49      0.5   1.54 0.141 
3 Height        1    1.59      0.75  1.54 0.141 
4 Height        2    1.64      0.25  1.66 0.0649
5 Height        2    1.68      0.5   1.66 0.0649
6 Height        2    1.68      0.75  1.66 0.0649

这就是我需要的摘要，但它是长格式的。Q是一个df-col. 这是一个喋喋不休：

is_tibble(summary$Q)
[1] TRUE

所以pivot_wider似乎不起作用。 我可以使用nest_by()来获得每组一行的格式：

toySummary <- summary %>% nest_by(Group, Mean, SD)
toySummary
# Rowwise:  Group, Mean, SD
Group  Mean      SD               data
<int> <dbl>   <dbl> <list<tbl_df[,2]>>
1     1  1.54  0.141             [3 × 2]
2     1 78.8  10.2               [3 × 2]
3     2  1.66  0.0649            [3 × 2]
4     2 82.9   9.09              [3 × 2]
5     3  1.63  0.100             [3 × 2]
6     3 71.0  10.8               [3 × 2]

但是现在百分位数的格式更加复杂：

> toySummary$data[1]
<list_of<
tbl_df<
Parameter: character
Q        : 
tbl_df<
Value   : double
Quantile: double
>
>
>[1]>
[[1]]
# A tibble: 3 x 2
Parameter Q$Value $Quantile
<chr>       <dbl>     <dbl>
1 Height       1.45      0.25
2 Height       1.49      0.5 
3 Height       1.59      0.75

它看起来像一个list，所以我想某种形式的lapply可能会起作用，但是有没有我还没有发现的更整洁的解决方案？ 我在研究这个问题时发现了几个我不认识的新动词(chop、pack、rowwise()、nest_by等(，但似乎没有一个能给我我想要的东西：理想情况下，一个有 6 行(由唯一的Group和Parameter组合定义(和Mean列的tibble，SD，Q25、Q50和Q75。

澄清一下前两个提出的答案：获取我的玩具示例生成的确切数字不如找到一种通用技术来从summarisedplyrv1.0.0 中返回的df-col移动到我的示例说明的一般形式的广泛数据摘要重要。

Answer 1

修订后的答案

这是我修改后的答案。这一次，我用enframe和pivot_wider重写了你的quibble2函数，以便它返回一个包含三行的tibble。

这将再次导致您的summarytibbledf-col，现在我们可以直接使用unpack，而无需使用pivot_wider来获得预期的结果。

这也应该推广到百分位数等。

library(tidyverse)
set.seed(123456)
toy <- tibble(
Group=rep(1:3, each=5),
Height=1.65 + rnorm(15, 0, 0.1),
Weight= 75 + rnorm(15, 0, 10)
) %>% 
pivot_longer(
values_to="Value", 
names_to="Parameter",
cols=c(Height, Weight)
)
quibble2 <- function(x, q = c(0.25, 0.5, 0.75)) {
pivot_wider(enframe(quantile(x, q)),
names_from = name,
values_from = value) 
}
mySummary <- function(data, ...) {
data %>% 
group_by(Parameter, Group) %>% 
summarise(..., .groups="drop")
}
summary <- mySummary(toy, Q=quibble2(Value), Mean=mean(Value, na.rm=TRUE), SD=sd(Value, na.rm=TRUE))
summary %>% 
unpack(Q)
#> # A tibble: 6 x 7
#>   Parameter Group `25%` `50%` `75%`  Mean    SD
#>   <chr>     <int> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 Height        1  1.62  1.66  1.73  1.70 0.108
#> 2 Height        2  1.73  1.77  1.78  1.76 0.105
#> 3 Height        3  1.55  1.64  1.76  1.65 0.109
#> 4 Weight        1 75.6  80.6  84.3  80.0  9.05 
#> 5 Weight        2 75.4  76.9  79.6  77.4  7.27 
#> 6 Weight        3 70.7  75.2  82.0  76.3  6.94

^{创建于 2020-06-13 由 reprex 包 (v0.3.0(}

第二种方法而不更改quibble2，我们需要先调用unpack然后pivot_wider。这也应该扩展。

library(tidyverse)
set.seed(123456)
toy <- tibble(
Group=rep(1:3, each=5),
Height=1.65 + rnorm(15, 0, 0.1),
Weight= 75 + rnorm(15, 0, 10)
) %>% 
pivot_longer(
values_to="Value", 
names_to="Parameter",
cols=c(Height, Weight)
)
quibble2 <- function(x, q = c(0.25, 0.5, 0.75)) {
tibble(Value := quantile(x, q), "Quantile" := q)
}
mySummary <- function(data, ...) {
data %>% 
group_by(Parameter, Group) %>% 
summarise(..., .groups="drop")
}
summary <- mySummary(toy, Q=quibble2(Value), Mean=mean(Value, na.rm=TRUE), SD=sd(Value, na.rm=TRUE))
summary %>% 
unpack(Q) %>% 
pivot_wider(names_from = Quantile, values_from = Value)
#> # A tibble: 6 x 7
#>   Parameter Group  Mean    SD `0.25` `0.5` `0.75`
#>   <chr>     <int> <dbl> <dbl>  <dbl> <dbl>  <dbl>
#> 1 Height        1  1.70 0.108   1.62  1.66   1.73
#> 2 Height        2  1.76 0.105   1.73  1.77   1.78
#> 3 Height        3  1.65 0.109   1.55  1.64   1.76
#> 4 Weight        1 80.0  9.05   75.6  80.6   84.3 
#> 5 Weight        2 77.4  7.27   75.4  76.9   79.6 
#> 6 Weight        3 76.3  6.94   70.7  75.2   82.0

^{创建于 2020-06-13 由 reprex 包 (v0.3.0(}通用

方法
我试图通过重写mySummary函数来找出一种更通用的方法。现在，它会自动将这些输出转换为返回向量或命名向量的df-cols。如有必要，它还会自动将list换行到表达式周围。

然后，我定义了一个函数widen该函数将通过保留行(包括在支持的list-columns上调用broom::tidy(来尽可能扩大df。

该方法并不完美，可以通过在widen函数中包含unnest_wider来扩展。

请注意，我更改了示例中的分组，以便能够将t.test用作另一个示例输出。

library(tidyverse)
set.seed(123456)
toy <- tibble(
Group=rep(1:3, each=5),
Height=1.65 + rnorm(15, 0, 0.1),
Weight= 75 + rnorm(15, 0, 10)
) %>% 
pivot_longer(
values_to="Value", 
names_to="Parameter",
cols=c(Height, Weight)
)
# modified summary function
mySummary <- function(data, ...) {
fns <- rlang::enquos(...)
fns <- map(fns, function(x) {
res <- rlang::eval_tidy(x, data = data)
if ( ((is.vector(res)  || is.factor(res)) && length(res) == 1) ||
("list" %in% class(res) && is.list(res)) ||
rlang::call_name(rlang::quo_get_expr(x)) == "list") {
x
}
else if ((is.vector(res)  || is.factor(res)) && length(res) > 1) {
x_expr <- as.character(list(rlang::quo_get_expr(x)))
x_expr <- paste0(
"pivot_wider(enframe(",
x_expr,
"), names_from = name, values_from = value)"
)
x <- rlang::quo_set_expr(x, str2lang(x_expr))
x
} else {
x_expr <- as.character(list(rlang::quo_get_expr(x)))
x_expr <- paste0("list(", x_expr,")")
x <- rlang::quo_set_expr(x, str2lang(x_expr))
x
}
})
data %>% 
group_by(Parameter) %>%
summarise(!!! fns, .groups="drop")
}

# A function to automatically widen the df as much as possible while preserving rows
widen <- function(df) {
df_cols <- names(df)[map_lgl(df, is.data.frame)]
df <- unpack(df, all_of(df_cols), names_sep = "_")
try_tidy <- function(x) {
tryCatch({
broom::tidy(x)
}, error = function(e) {
x
})
}
df <- df %>% rowwise() %>% mutate(across(where(is.list), try_tidy))
ungroup(df)
}
# if you want to specify function arguments for convenience use purrr::partial
quantile3 <- partial(quantile, x = , q = c(.25, .5, .75))
summary <- mySummary(toy,
Q = quantile3(Value),
R = range(Value),
T_test = t.test(Value),
Mean = mean(Value, na.rm=TRUE),
SD = sd(Value, na.rm=TRUE)
)
summary 
#> # A tibble: 2 x 6
#>   Parameter Q$`0%` $`25%` $`50%` $`75%` $`100%` R$`1`  $`2` T_test   Mean    SD
#>   <chr>      <dbl>  <dbl>  <dbl>  <dbl>   <dbl> <dbl> <dbl> <list>  <dbl> <dbl>
#> 1 Height      1.54   1.62   1.73   1.77    1.90  1.54  1.90 <htest>  1.70 0.109
#> 2 Weight     67.5   72.9   76.9   83.2    91.7  67.5  91.7  <htest> 77.9  7.40
widen(summary)
#> # A tibble: 2 x 11
#>   Parameter `Q_0%` `Q_25%` `Q_50%` `Q_75%` `Q_100%`   R_1   R_2 T_test$estimate
#>   <chr>      <dbl>   <dbl>   <dbl>   <dbl>    <dbl> <dbl> <dbl>           <dbl>
#> 1 Height      1.54    1.62    1.73    1.77     1.90  1.54  1.90            1.70
#> 2 Weight     67.5    72.9    76.9    83.2     91.7  67.5  91.7            77.9 
#> # … with 9 more variables: $statistic <dbl>, $p.value <dbl>, $parameter <dbl>,
#> #   $conf.low <dbl>, $conf.high <dbl>, $method <chr>, $alternative <chr>,
#> #   Mean <dbl>, SD <dbl>

^{创建于 2020-06-14 由 reprex 软件包 (v0.3.0(}

Answer 2

如果更改quibble2以返回列表，然后使用unnest_wider怎么办？

quibble2 <- function(x, q = c(0.25, 0.5, 0.75)) {
list(quantile(x, q))
}
mySummary(toy, Q=quibble2(Value), Mean=mean(Value, na.rm=TRUE), SD=sd(Value, na.rm=TRUE)) %>%
unnest_wider(Q)
# A tibble: 6 x 7
Parameter Group `25%` `50%` `75%`  Mean    SD
<chr>     <int> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Height        1  1.62  1.66  1.73  1.70 0.108
2 Height        2  1.73  1.77  1.78  1.76 0.105
3 Height        3  1.55  1.64  1.76  1.65 0.109
4 Weight        1 75.6  80.6  84.3  80.0  9.05 
5 Weight        2 75.4  76.9  79.6  77.4  7.27 
6 Weight        3 70.7  75.2  82.0  76.3  6.94