取消嵌套 tibble 列：使用 dplyr v1.0.0 进行“宽”数据摘要答案

【问题标题】：Unnesting tibble columns: "Wide" data summaries with dplyr v1.0.0取消嵌套 tibble 列：使用 dplyr v1.0.0 进行“宽”数据摘要
【发布时间】：2020-06-12 17:03:01
【问题描述】：

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

                                   ----   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 中做到这一点。我可以通用地做到这一点，使用一个函数可以处理具有任意数量的级别的任意分组变量和总结任意数量的具有任意名称的变量的任意统计信息。通过使我的数据tidy，我获得了这种级别的灵活性。这不是这个问题的目的。

首先，一些玩具数据：

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 等），但似乎没有一个能满足我的需求：理想情况下，a tibble 有 6 行（由唯一的 Group 和 Parameter 组合定义）和 Mean、SD、Q25、Q50 和 Q75 的列。

为了澄清前两个建议的答案：获得我的玩具示例生成的确切数字不如找到一个 通用技术 从 df-col(s) 转移到 @ 987654349@ 在dplyr v1.0.0 中返回到我的示例说明的一般形式的广泛数据摘要。

【问题讨论】：

标签： r dplyr tidyverse

【解决方案1】：

修改后的答案

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

这将再次导致summarytibble 中的df-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

^{由 reprex package (v0.3.0) 于 2020 年 6 月 13 日创建}

第二种方法 在不更改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

^{由 reprex package (v0.3.0) 于 2020 年 6 月 13 日创建}

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

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

该方法并不完美，可以通过在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>

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

【讨论】：

感谢您的想法。但除非我遗漏了什么，否则这只会在计算摘要后将 tibble 恢复到正确的状态。也就是说，它是长而不是宽。
从您的评论到上面的答案，我认为您“对处理新 df-cols 的技术比从这个特定示例中获取这些数字更感兴趣”，所以我将答案集中在将df-cols 转换为普通列，但我认为这仍然不是您问题的核心。您是否想要一个通用函数来处理任何类型的汇总函数并将其输出转换为列？但后来我不太明白df-cols 是如何适应的，通过使用列表来避免它们 - 如上所述 - 似乎是一种更好的方法。
我现在修改了我的答案并想出了一个相当灵活的方法，代价是重写quibble2，所以我不确定这是否适合你。
我刚刚注意到，没有必要重写quibble2。
“现在它会自动将这些输出转换为返回向量或命名向量的 df-cols”。那是我自己要去的地方。乍一看，你的概括方法正是我想要的，但形式比我能做到的要简洁得多。没有任何解决方案是完美的，但是您肯定扩大了（双关语）可以处理的情况，并且还隐藏了摘要函数中的复杂性，这是理想的。谢谢你。如果我可以再次投票，我会的。

【解决方案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

【讨论】：

艾伦说得很好，但我对处理新df-cols 的技术更感兴趣，而不是从这个特定示例中获取这些数字。我认为 df-cols 比列表 cols 有优势 - 例如，尝试从我们的每个 quibble2 函数打印小标题。 unnest_wider 对我来说是新的。这值得一看。我想知道是否有 chop 或 `unpack' 等价物？
作为一点反馈，我看不出有人会猜到您对从问题的标题或内容中取消嵌套 tibble 列特别感兴趣。
谢谢你，伊恩。我正在编辑您回答的问题，并且还根据您的评论修改了标题。我希望您认为这些更改阐明了我在寻找什么。
祝你好运找到答案，如果我有一点时间，我可能会再考虑一下。