使用 lapply 转置列的一部分并将其作为新列添加到数据框中答案

【问题标题】：Using lapply to transpose part of a column and add it as new columns to a data frame使用 lapply 转置列的一部分并将其作为新列添加到数据框中
【发布时间】：2018-06-25 22:06:28
【问题描述】：

我一直在寻找关于这个的一些明确性，但找不到适用于我的案例的东西，我构建了一个与这个非常相似的 DF（但数据要多得多，总共超过一百万行）

Key1 <- c("A", "B", "C", "A", "C", "B", "B", "C", "A", "C") 
Key2 <- c("A1", "B1", "C1", "A2", "C2", "B2", "B3", "C3", "A3", "C4") 
NumVal <- c(2, 3, 1, 4, 6, 8, 2, 3, 1, 0)
DF1 <- as.data.frame(cbind(Key1, Key2, NumVal), stringsAsFactors = FALSE) %>% arrange(Key2)
ConsId <- c(1:10)
DF1 <- cbind(DF1, ConsId)

现在，我想做的是在数据框中添加 3 个新列（在现实生活中我需要 12 个，但为了在这个玩具示例中更加图形化，我们将使用 3 个）到数据框中，其中每个row 对应于 $NumVal 的值，具有相同的 $Key1 并且大于或等于 $ConsId 到每行中的值，并用 NA 填充剩余的空格，如果我不是很清楚，这是预期的结果：

Key1    Key2    NumVal  ConsId  V1  V2  V3
A        A1        2       1    2   4   1
A        A2        4       2    4   1   NA
A        A3        1       3    1   NA  NA
B        B1        3       4    3   8   2
B        B2        8       5    8   2   NA
B        B3        2       6    2   NA  NA
C        C1        1       7    1   6   3
C        C2        6       8    6   3   0
C        C3        3       9    3   0   NA
C        C4        0      10    0   NA  NA

现在我正在使用 do.call(rbind)，即使它工作得很好，对于超过 100 万行（大约 6 小时）的真实数据来说，它花费的时间太长了，我也尝试了bind_rows dplyr 函数，但它需要更长的时间，所以我坚持使用 do.call 选项，这是我正在使用的代码示例：

# Function
TranspNumVal <- function(i){
  Id <- DF1[i, "Key1"]
  IdCons <- DF1[i, "ConsId"]
  myvect <- as.matrix(filter(DF1, Id == Key1, ConsId >= IdCons) %>% select(NumVal))
  Result <-  as.data.frame(t(myvect[1:3]))
  return(Result)
}

# Applying the function to the entire data frame
DF2 <- do.call(rbind, lapply(1:NROW(DF1), function(i) TranspNumVal(i)))
DF3 <- cbind(DF1, DF2)

也许更改类导致代码效率低下，或者我只是没有找到更好的方法来矢量化我的问题（你不想知道嵌套循环需要多长时间），我'我对 R 相当陌生，刚刚开始玩 dplyr，所以我愿意接受有关如何优化我的代码的任何建议

【问题讨论】：

不要使用as.data.frame(cbind，因为它会先创建一个矩阵，然后再创建一个data.frame，这样会出现类型问题。就做data.frame(Key1, Key2, ..
当每个Key1 的行数超过三行时会发生什么情况，例如Key1 = C？ Key1 = C 的第一行中的新列无法存储所有 NumVal 值。在那种情况下你只保留前三个吗？
谢谢，以后参考时会考虑的
是的@MauritsEvers 我们只保留前 3 个，我需要放弃其余的

标签： r

【解决方案1】：

我们可以使用dplyr::lead

DF1 %>%
    group_by(Key1) %>%
    mutate(
        V1 = NumVal,
        V2 = lead(NumVal, n = 1),
        V3 = lead(NumVal, n = 2))
## A tibble: 10 x 7
## Groups:   Key1 [3]
#   Key1  Key2  NumVal ConsId V1    V2    V3
#   <chr> <chr> <chr>   <int> <chr> <chr> <chr>
# 1 A     A1    2           1 2     4     1
# 2 A     A2    4           2 4     1     NA
# 3 A     A3    1           3 1     NA    NA
# 4 B     B1    3           4 3     8     2
# 5 B     B2    8           5 8     2     NA
# 6 B     B3    2           6 2     NA    NA
# 7 C     C1    1           7 1     6     3
# 8 C     C2    6           8 6     3     0
# 9 C     C3    3           9 3     0     NA
#10 C     C4    0          10 0     NA    NA

解释：我们按Key1 对条目进行分组，然后使用lead 移动NumVal 列V2 和V3 的值。 V1 只是 NumVal 的副本。

【讨论】：

感谢您的回答，以及对铅工作原理的解释，它比预期更好地解决了我的问题

【解决方案2】：

dplyr 管道。

第一个实用函数将根据b (ConsId) 的值过滤a (NumVal)：

myfunc1 <- function(a,b) {
  n <- length(b)
  lapply(seq_along(b), function(i) a[ b >= b[i] ])
}

第二个实用函数将不规则的list 转换为data.frame。它适用于要附加的任意数量的列，但我们根据您的要求将其限制为 3：

myfunc2 <- function(x, ncols = 3) {
  n <- min(ncols, max(lengths(x)))
  as.data.frame(do.call(rbind, lapply(x, `length<-`, n)))
}

现在是管道：

dat %>%
  group_by(Key1) %>%
  mutate(lst = myfunc1(NumVal, ConsId)) %>%
  ungroup() %>%
  bind_cols(myfunc2(.$lst)) %>%
  select(-lst) %>%
  arrange(Key1, ConsId)
# # A tibble: 10 × 7
#     Key1  Key2 NumVal ConsId    V1    V2    V3
#    <chr> <chr>  <int>  <int> <int> <int> <int>
# 1      A    A1      2      1     2     4     1
# 2      A    A2      4      2     4     1    NA
# 3      A    A3      1      3     1    NA    NA
# 4      B    B1      3      4     3     8     2
# 5      B    B2      8      5     8     2    NA
# 6      B    B3      2      6     2    NA    NA
# 7      C    C1      1      7     1     6     3
# 8      C    C2      6      8     6     3     0
# 9      C    C3      3      9     3     0    NA
# 10     C    C4      0     10     0    NA    NA

【讨论】：

【解决方案3】：

按'Key1'分组后，使用shift（来自data.table）在list中获取'NumVal'的下一个值，将其转换为tibble和unnest嵌套的list元素到数据集的各个列。默认情况下，shiftfill NA 在末尾。

library(data.table) 
library(tidyverse)
DF1 %>% 
  group_by(Key1) %>% 
  mutate(new = shift(NumVal, 0:(n()-1), type = 'lead') %>% 
                     map(~ 
                          as.list(.x) %>%
                          set_names(paste0("V", seq_along(.))) %>% 
                          as_tibble)) %>% 
  unnest %>%
  select(-V4)
# A tibble: 10 x 7
# Groups:   Key1 [3]
#   Key1  Key2  NumVal ConsId    V1    V2    V3
#   <chr> <chr>  <dbl>  <int> <dbl> <dbl> <dbl>
# 1 A     A1         2      1     2     4     1
# 2 A     A2         4      2     4     1    NA
# 3 A     A3         1      3     1    NA    NA
# 4 B     B1         3      4     3     8     2
# 5 B     B2         8      5     8     2    NA
# 6 B     B3         2      6     2    NA    NA
# 7 C     C1         1      7     1     6     3
# 8 C     C2         6      8     6     3     0
# 9 C     C3         3      9     3     0    NA
#10 C     C4         0     10     0    NA    NA

数据

DF1 <- data.frame(Key1, Key2, NumVal, stringsAsFactors = FALSE) %>% 
                       arrange(Key2)
DF1$ConsId <- 1:10

【讨论】：