如何在嵌套的tibble中移动列的列？

Question

我有一个包含很多类别的数据框。对于类别，我计算一个移位值。使用此值，我希望将此部分数据框的每一列向下移动此值。为了执行此操作，我认为使用“嵌套的tibble”然后使用map的purrr函数来执行移位可能是有用的。

为了人为地重现问题，我将使用虹膜数据集创建这样一个数据框：

df <- iris %>% group_by(Species) %>% 
  nest() %>% mutate(shift = as.integer(c(1, 2, 3)))

df

# A tibble: 3 x 3
  Species    data              shift
  <fct>      <list>            <int>
1 setosa     <tibble [50 x 4]>     1
2 versicolor <tibble [50 x 4]>     2
3 virginica  <tibble [50 x 4]>     3

我的目的是使用一个map函数，它将“data”中的每一列都取出来并按移位值移动它们。在代码中（它没有运行，只是为了澄清：

df %>% mutate(data.shift = map(data, lag(.x, n = shift)))

我希望有这样的输出：

# A tibble: 3 x 4
  Species    data              shift    data.shift
  <fct>      <list>            <int>    <list>
1 setosa     <tibble [50 x 4]>     1    <tibble[50 x 4]>
2 versicolor <tibble [50 x 4]>     2    <tibble[50 x 4]>
3 virginica  <tibble [50 x 4]>     3    <tibble[50 x 4]>

其中“data.shift”的每一列都有一个价值转移滞后。例如，对于第一行，unnested tibble看起来像：

# A tibble: 50 x 4
   Sepal.Length Sepal.Width Petal.Length Petal.Width
          <dbl>       <dbl>        <dbl>       <dbl>
 1        NA          NA           NA         NA    
 2         5.10        3.50         1.40       0.200
 3         4.90        3.00         1.40       0.200
 4         4.70        3.20         1.30       0.200
 5         4.60        3.10         1.50       0.200
 6         5.00        3.60         1.40       0.200
 7         5.40        3.90         1.70       0.400
 8         4.60        3.40         1.40       0.300
 9         5.00        3.40         1.50       0.200
10         4.40        2.90         1.40       0.200
# ... with 40 more rows

有没有办法使用purrr::map函数执行此操作？

Answer 1

如果我们指定参数名称，我们也可以在没有匿名调用的情况下执行此操作

df %>% 
    mutate(data.shift = map2(data, shift, ~ .x %>% 
                                               mutate_all(lag, n = .y))) 

---

或者使用data.table shift，可以将data.table或data.frame移位

library(data.table)
df %>% 
   mutate(data.shift = map2(data, shift, ~  
          as.data.table(.x)[, (names(.x)) := shift(.SD, n = .y)])) 

Answer 2

这是你想要的吗？

df %>% mutate(data.shift = map2(data, shift, ~mutate_all(.x, function(z) lag(z, .y)))