嵌套 lapply 来修改表而不是循环答案

【问题标题】：Nested lapply to modify tables instead of loops嵌套 lapply 来修改表而不是循环
【发布时间】：2017-04-13 10:58:09
【问题描述】：

我仍在尝试理解 R 中的函数，例如 apply、lapply 等。据我所知，R 中的循环很慢，最好避免它们。然而，制作可以完成所有工作的“单行脚本”非常困难。尽管如此，我还是喜欢忘记循环并切换到内置的快速功能。我的输入数据 - 两张表：

N   Q   string
1   12  NNN|ABC|12.5
2   46  DEF|111|!-2
3   34  $$%GHI|--+
4   -2  345H*(JKL
5   50  NK-|224ABC
6   0   NNNNNNNNN

和L2

str
ABC
DEF
GHI
JKL
MNO
PRS

我想得到什么：

N   Q   string          sub
1   12  NNN|ABC|12.5    ABC
2   46  DEF|111|!-2     DEF
3   34  $$%GHI|--+    GHI
4   -2  345H*(JKL       JKL
5   50  NK-|224ABC      ABC
6   0   NNNNNNNNN       NA

如您所见，从字符串中提取特定的子字符串（非常随机，内部没有任何模板）并分别添加到每行的末尾。

我在 R 中编写了一个带有循环的简短脚本，允许执行此操作，但在我的非伪造数据表中，L1 有超过 80000 行，表 L2 有多达 250000 行，所以这个简单的操作可能需要我一点时间。

L1 <- cbind(sub=NA,L1)
L1 <- subset(L1, select=c(N:string,sub))
for(i in 1:nrow(L2)){
  for(j in 1:nrow(L1)){
    if(grepl(L2[i,1], L1[j,3])){
      L1$sub[j] <- toString(L2$str[i])
    }
  }
}

我在考虑嵌套 lapply，但我怎样才能获得特定的索引？超伪代码：

lapply(L1, function(x) lapply(L2, function(y) if(L2 in L1) add L2 to L1 else add NA))

啤酒和非常感谢任何线索。

【问题讨论】：

标签： r loops lapply

【解决方案1】：

我们可以使用str_extract

library(stringr)
L1$sub <- str_extract(L1$string, paste(L2$str, collapse="|"))
L1$sub
#[1] "ABC" "DEF" "GHI" "JKL" "ABC" NA

【讨论】：

如果您想考虑 L1 中的字符串可能与 L2 中的多个模式匹配的可能性（例如 L1$string[1] <- "NNN|ABC|DEF|12.5"），您可以使用 str_extract_all:L1$sub <- stringr::str_extract_all(L1$string, paste(L2$str, collapse="|")) %>% lapply(paste, collapse = ",") %>% unlist %>% replace(., . == "", NA)。
啊，太棒了：D
我只想添加一件事。在对我的解决方案和上面给出的解决方案进行小幅修改后，我在我的数据上运行了两个脚本并测量了时差：我的解决方案：48.31354 分钟的时差给定的解决方案：30.6875 秒的时差。再来一次，非常感谢！