R在计算后合并回列表

Question

我遇到了一个简单的问题，但找不到简单的解决方案。 （这个问题大概是duplicate但是找不到！）

我需要的是merge 在计算后将列表返回到其原始列表。

我需要merge，因为我正在做的计算太复杂，无法将apply 直接添加到列表中。所以，我必须分开做，并以某种方式将它放回原始数据集。 （因为这个问题，我不能在这里直接使用mutate）。

因为我无法复现我的数据，所以我将使用mtcars 来演示我的问题。

我有一个原始列表，我正在对其进行计算（无论哪个都没有关系），例如：

library(dplyr) 
library(purr) 

我的原始数据集是一个列表

dt = mtcars %>% 
  group_by(gear) %>% 
  split(.$gear)

然后，在这个列表上，我做一个计算，例如：

dt %>% 
  map(~summarise(., cluster = mean(disp)))

我最终得到了list。

我的数据的（真实）结构最终看起来像这样

$`3`
   gear cluster
1     3   326.3

$`4`
    gear cluster
 1     4   123

等等。我需要的只是将merge back这个列表添加到原始列表中。 我怎样才能做到这一点 ？

我需要（想要的输出）最终得到（这里很难重现）我原来的list 和merged 计算值。

有点像

$`3`

     mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb cluster 
1   21.4     6 258.0   110  3.08 3.215 19.44     1     0     3     1  XXX
2   18.7     8 360.0   175  3.15 3.440 17.02     0     0     3     2  XXX
3   18.1     6 225.0   105  2.76 3.460 20.22     1     0     3     1  XXX
4   14.3     8 360.0   245  3.21 3.570 15.84     0     0     3     4  XXX

所有列表以此类推（df）

我再次强调 我的原始数据集是一个列表而不是一个 data.frame。我需要的是合并lists，而不是data.frame。

我想到了类似的东西

dt = mtcars %>% # my data is a list
  group_by(gear) %>% 
  split(.$gear)

fmerge = function(x) x %>% lapply(dt, ., by = 'gear')

dt %>% 
  map(~summarise(., cluster = mean(disp))) %>% 
  lapply(fmerge) 

或

dt %>% 
  map(~summarise(., cluster = mean(disp))) %>% 
  join_all(dt, ., by = 'gear')

但是效果不好。

有什么线索吗？

Answer 1

我们可以使用bind_rows 绑定list 元素，然后执行right_join 或left_join

mtcars %>% 
   group_by(gear) %>% 
   split(.$gear) %>% 
   map(~summarise(., cluster = mean(disp))) %>%
   bind_rows() %>%
   right_join(., mtcars, by = "gear")

---

但是，这可以在没有split/map/bind_rows/right_join 的情况下完成，只需在我们group_by 'gear' 之后使用mutate 创建'集群'

mtcars %>% 
     group_by(gear) %>%
     mutate(cluster = mean(disp))

但是，我们假设这个简化的过程可能不适用于 OP 的原始数据集。

更新

基于OP的cmets，我们可以使用map2对list的对应元素做left_join

dt %>%
    map(~summarise(., cluster = mean(disp))) %>% 
    map2(dt, ., left_join, by = "gear")

或者如果我们需要一个data.frame，那么使用map2df

dt %>%
    map(~summarise(., cluster = mean(disp))) %>% 
    map2_df(dt, ., left_join, by = "gear")

Answer 2

可能的解决方案，但由于loop 而速度较慢

将计算存储在“列表”中

computation = dt %>% map(~summarise(., cluster = mean(disp)))

然后遍历list

for(i in 1:length(dt)){
  dt[[i]] = merge(dt[[i]], computation[[i]], by = 'gear')
}

得到

$`3`
   gear  mpg cyl  disp  hp drat    wt  qsec vs am carb cluster
1     3 21.4   6 258.0 110 3.08 3.215 19.44  1  0    1   326.3
2     3 18.7   8 360.0 175 3.15 3.440 17.02  0  0    2   326.3
3     3 18.1   6 225.0 105 2.76 3.460 20.22  1  0    1   326.3

等等。

Answer 3

我将利用 tidyr 包中的 nest()（然后是 unnest()）中的一些有趣的事情，如下所示：

library(tidyr)
library(dplyr)
library(purrr)

mtcars %>% 
  nest(-gear) %>% 
  mutate(cluster = map_dbl(data, ~ mean(.$disp))) %>% 
  unnest(data)
#> # A tibble: 32 × 12
#>     gear  cluster   mpg   cyl  disp    hp  drat    wt  qsec    vs    am
#>    <dbl>    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1      4 123.0167  21.0     6 160.0   110  3.90 2.620 16.46     0     1
#> 2      4 123.0167  21.0     6 160.0   110  3.90 2.875 17.02     0     1
#> 3      4 123.0167  22.8     4 108.0    93  3.85 2.320 18.61     1     1
#> 4      4 123.0167  24.4     4 146.7    62  3.69 3.190 20.00     1     0
#> 5      4 123.0167  22.8     4 140.8    95  3.92 3.150 22.90     1     0
#> 6      4 123.0167  19.2     6 167.6   123  3.92 3.440 18.30     1     0
#> 7      4 123.0167  17.8     6 167.6   123  3.92 3.440 18.90     1     0
#> 8      4 123.0167  32.4     4  78.7    66  4.08 2.200 19.47     1     1
#> 9      4 123.0167  30.4     4  75.7    52  4.93 1.615 18.52     1     1
#> 10     4 123.0167  33.9     4  71.1    65  4.22 1.835 19.90     1     1
#> # ... with 22 more rows, and 1 more variables: carb <dbl>

如果您运行此管道的前两行，然后是三行，您会看到有一列数据集对应于数据中的组。这让您可以做一些非常复杂的事情，而无需将数据拆分到单独的列表中。

例如，下面对每个齿轮的数据进行回归分析（同样，尝试运行前 2 条，然后 3 条等管道线以了解其工作原理），然后绘制结果：

library(broom)
library(ggplot2)

mtcars %>% 
  nest(-gear) %>% 
  mutate(fits = map(data, ~ lm(mpg ~ hp, .)),
         predicted = map(fits, augment)) %>% 
  unnest(predicted) %>% 
  ggplot(aes(mpg, .fitted)) +
    geom_point() +
    facet_grid(. ~ gear)