比较循环

Question

我有一个嵌套列表

combine <- list(c('A', 'B', 'C'), c('D', 'H', 'G', 'J'), c('A', 'E'))

和df

df <- data.frame(appln_id = c(1, 1, 2, 2, 4, 4, 4, 3, 3, 3, 3, 5, 9, 9), 
                 prior_year = c(1997,1997,1997,1997,1997,1997,1997,1998,1998,1998,1998,2000,2000,2000),
                 IPC = c('B','E','E','B','H','J','D','H','J','D','E','A','E','B'))

我想根据IPC汇总appln_id（例如：for IPC=1: c('B','E')，for IPC=2: c('E','B')，for IPC=4: c('H','J','D')等）。然后，对于prior_year的每个值，我想将IPC设置与列表combine的元素进行比较。

对于不是IPC任何元素子集的combine集，我想按如下方式将其数据保存在另一个名为df的数据帧中的new中：

new <- data.frame(appln_id = c(1, 1, 3, 3, 3, 3), 
                  prior_year = c(1997,1997,1998,1998,1998,1998),
                  IPC = c('B','E','H','J','D','E'))

并将此IPC集添加到combine中，如下所示：

combine <- list(c('A', 'B', 'C'), c('D', 'H', 'G', 'J'), c('A', 'E'), c('B', 'E'), c('D','E','J','H'))

这是我的代码：

new <- data.frame(appln_id=integer(),prio_year=integer(), IPC=character()) 
new_combine=list()
prio_year <- unique(df$prio_year)
appln_id <- unique(df$appln_id)
for (i in prio_year){
  for (j in appln_id){
    x <- sort((df[(df$prio_year==i) & (df$appln_id==j),3])[[1]])
    for (k in combine){
      if (all(x %in% k) == FALSE){
        new <- rbind(new, df[df$appln_id==j,])
        new_combine[[length(new_combine)+1]] <- x
      }
    }
  }
  combine <- c(combine,unique(new_combine))
}

但是，我的代码运行时间太长。有人可以用另一种方法来加快速度吗？谢谢。

Answer 1

这里只是一个循环。不过，由于合并不同的因子级别可能会有些烦人，因此我将$IPC从factor更改为character。 （如果您使用的是R-4.0或$IPC已经是character，则无需执行此步骤。）

df$usable <- TRUE
df$grps <- interaction(df$appln_id, df$prior_year)
newlist <- list()
for (grp in levels(df$grps)) {
  rows <- df$grps == grp & df$usable
  if (!length(rows)) next
  thisIPC <- df$IPC[rows]
  matches <- sapply(combine, function(comb) all(thisIPC %in% comb))
  if (any(matches)) {
    # repeat
  } else {
    # new!
    combine <- c(combine, list(thisIPC))
    newlist <- c(newlist, list(df[rows,]))
    df$usable[rows] <- FALSE
  }
}
df <- df[df$usable,]
new <- do.call(rbind, newlist)
df$usable <- df$grps <- 
  new$usable <- new$grps <- NULL

df
#    appln_id prior_year IPC
# 3         2       1997   E
# 4         2       1997   B
# 5         4       1997   H
# 6         4       1997   J
# 7         4       1997   D
# 12        5       2000   A
# 13        9       2000   E
# 14        9       2000   B
new
#    appln_id prior_year IPC
# 1         1       1997   B
# 2         1       1997   E
# 8         3       1998   H
# 9         3       1998   J
# 10        3       1998   D
# 11        3       1998   E
str(combine)
# List of 5
#  $ : chr [1:3] "A" "B" "C"
#  $ : chr [1:4] "D" "H" "G" "J"
#  $ : chr [1:2] "A" "E"
#  $ : chr [1:2] "B" "E"
#  $ : chr [1:4] "H" "J" "D" "E"

注意：

• 我创建了$grps变量以简化单循环分组；一旦完成此循环，请随时将其删除。使用factor然后使用levels可确保我迭代其他存在的组合，仅此而已。

• 我可能会达到不必要的极限，但是从长远来看，反复增长的帧对于性能是不利的：每次“添加行”时，整个帧都会完美地复制到内存中，因此每次添加时，您复制该帧的内存占用。当然，内存被清除了，但这是一个“已知的事情”，它逐渐明显地减慢了速度。 （请参见R Inferno中的第2章，Growing Objects。）这也（以较小的程度适用）以迭代方式删除行。

  因此，直到最后我才真正更改框架的内容。为了适应这一点，我还添加了$usable列以指示是否应最后删除它。 （在极少数情况下，您在同一帧上运行此代码twice，在抓取$enable时也使用了$IPC，这可能太过防御了。）

  循环后，我从df once中删除了相关的行，并在rbind上执行了一个单行连接（newlist），这是一个包含帧的列表（如果没有，则为空）什么都没发生）。