如何避免R中特定多条件语句中的循环

Posted

技术标签:

【中文标题】如何避免R中特定多条件语句中的循环【英文标题】：how to avoid the loops in a specific multiple conditional statement in R 【发布时间】：2017-01-07 21:18:10 【问题描述】：

我正在使用 R 从 R 中的电子病历 (EMR) 进行推断。实际上我确实编写了一个可以工作的循环命令，但问题是在处理数百万个 EMR 时循环可能非常慢。那么任何人都可以将我的命令转换为更快的方式（可能是基于向量的计算或其他可能的方式）吗？ 我的目的是弄清楚一组商品（在这种情况下，它们是从 p324 到 p9274）是否包含一组字符（在这种情况下，它们是 I25.2、I21.和 I22.）。 这是我的数据示例：

test <- data.frame(p324 = c("I24.001", "I10.x04", "I48.x02", "I48.x01", "I25.201", "I25.201", "I25.101", "I25.101", "NA", "I50", "I25.101", "I25.101", "I25.101", "I45.102", "I50.902"),
p327 = c("I20.000", "K76.000", "E11.900", "I44.200", "NA", "I49.904", "I45.102", "I50.910", "NA", "I10  05", "J98.402", "NA", "NA", "R57.0", "I10.x04"),
p3291 = c("I50.903", "K80.100", "N39.000", "I25.103", "NA", "I50.908", "NA", "I10  04", "NA", "I25.101", "I10  03", "NA", "NA", "I25.101", "I10.x05"),
p3294 = c("I10.x05", "K76.807", "J98.414", "K81.100", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "J43", "I10.x06"),
p3297 = c("NA", "I83.900", "E87.801", "NA", "NA", "I21.620", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "I10.x07"),
p3281 = c("K80.100", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "I10.x08"),
p3284 = c("K76.807", "I21.620", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", "I10.x09"),
p3287 = c("I83.900", "I10.x3", "I10.x2", "I10.x1", "I10.x0", "I10.x1", "I10.x2", "I10.x3", "I10.x4", "I10.x5", "I10.x6", "I10.x7", "I10.x8", "I10.x9", "I10.x10"),
p3271 = c("I50.908", "NA", "I10.x1", "I10.x0", "I10.x1", "I10.x2", "I10.x3", "I10.x4", "I10.x5", "I10.x6", "I10.x7", "I10.x8", "I10.x9", "I10.x10", "I10.x11"),
p3274 = c("NA", "I10.x1", "I10.x0", "I10.x1", "I10.x2", "I10.x3", "I10.x4", "I10.x5", "I10.x6", "I10.x7", "I10.x8", "I10.x9", "I10.x10", "I10.x11", "I10.x12"))

这是我的代码：

for (i in 1:15)

  if (any(
    c(
      substr(test$p324[i], 1, 5),
      substr(test$p327[i], 1, 5),
      substr(test$p3291[i], 1, 5),
      substr(test$p3294[i], 1, 5),
      substr(test$p3297[i], 1, 5),
      substr(test$p3281[i], 1, 5),
      substr(test$p3284[i], 1, 5),
      substr(test$p3287[i], 1, 5),
      substr(test$p3271[i], 1, 5),
      substr(test$p3274[i], 1, 5)
    ) %in% c("I25.2")
  ) |
  any(
    c(
      substr(test$p324[i], 1, 4),
      substr(test$p327[i], 1, 4),
      substr(test$p3291[i], 1, 4),
      substr(test$p3294[i], 1, 4),
      substr(test$p3297[i], 1, 4),
      substr(test$p3281[i], 1, 4),
      substr(test$p3284[i], 1, 4),
      substr(test$p3287[i], 1, 4),
      substr(test$p3271[i], 1, 4),
      substr(test$p3274[i], 1, 4)
    ) %in% c("I21.", "I22.")
  ))
  test$MI[i] = 1
  else
    test$MI[i] = 0

那么，任何人都可以转换我的命令，或者给我一些建议，以便它可以在超过 100 万例的情况下高效快速地运行吗？非常感谢。

【问题讨论】：

我比较了@Sixiang.Hu 使用sapply &amp; grepl()、@David Arenburg 使用grepl() 和@David Arenburg 使用substr 的代码，看来sapply 代码具有最棒的表演。以下是我的测试结果： 请查看我对我的问题的更新。我为每个代码计时并检查了结果。 @David Arenburg 的 substr 似乎产生了不一致的结果。我不确定原因。 可能是因为grepl 找到的不仅仅是完全匹配。我猜你那里有一些错误的匹配。我会检查你的结果，看看你是否得到了正确的结果。此外，您的第一个变体与答案中提供的内容不匹配，例如，那里没有 as.data.frame(t(test))。最后，您不必运行两次unlist(test)，您可以将其存储并重复使用。 @David Arenburg 感谢您的基准测试结果。我根据我的经验数据集测试了这三种方法，有 523,441 个观察值，我不知道如何将这些数据提供给您检查 substr 运算符生成这些 NA 值的原因。我对我的数据集的 sapply/grepl 函数做了一些小的修改，我认为这不是优于 substr 代码的原因。即使我在我的数据集上存储了unlist(test)，sapply &amp; grepl()（5.062496 秒）仍然优于substr（7.068666 秒）和grepl()（12.69934 秒）。我正在检查原因。 @David Arenburg 我想我已经弄清楚了这些 NA 值的原因。问题是当数据包含 NA 值时，substr 操作将生成 NA 值，而grepl 操作可以生成正确的结果。我还根据我的数据更新了基准测试结果，我认为你是对的，尽管在我的结果中，它显示 David(3.728264) > SixHu(4.323772) > SixHuVec(11.867062)。 【参考方案1】：

如果您正在寻求性能改进：

    不要逐行运行循环（sapply 也是循环） 不要在循环中运行矢量化操作（你为什么要逐列运行substr，而你只能运行一次？） 避免使用正则表达式——它很慢。相反，如果您在这里处理完全匹配，只需使用 == 或 %in%。

这是解决您问题的简单矢量化可能解决方案

res <- (substr(unlist(test), 1, 5) == "I25.2") | 
       (substr(unlist(test), 1, 4) %in% c("I21.", "I22."))
dim(res) <- dim(test)
test$MI <- rowSums(res)

这基本上对每个 k/n 组合（总共 2 个）只运行一次 substr(test, k, n)，并与感兴趣的值进行比较。然后，（因为%in% 没有data.frame 方法）我们再次将结果向量转换为正确的格式，并对每行的匹配项求和（以向量化的方式）。结果是每行有多少匹配项。如果你愿意，它可以很容易地转换成二进制（也可以是 vectroized 方式）

基准测试

所以 OP 提到了基准，所以这里有一些针对 10K/10 行/列的基准

    grepl/sapply 解决方案比 vecotrized 解决方案慢大约 X10 我建议矢量化 grepl 解决方案将性能提高了大约 X10 倍 我自己的解决方案与矢量化 grepl 解决方案的性能非常相似，而我相信随着正则表达式将变得更加复杂（用于额外匹配），它的泛化效果会更好，而 %in% 几乎没有额外数学的边际成本李>

设置（使用 OPs test 数据）

set.seed(123)
big.df <- as.data.frame(matrix(sample(unlist(test, use.names = FALSE), 1e5, replace = TRUE), ncol = 10))

# sapply / grepl
SixHu <- function(df)  
  t_test <- as.data.frame(t(df))
  chk <- function(x)
    grepl("I25\\.2|I21\\.|I22\\.",x)
  
  unname(colSums(sapply(t_test, chk)))


# Vectorized grepl
SixHuVec <- function(df)  
  res <- grepl("I25\\.2|I21\\.|I22\\.", unlist(df))
  dim(res) <- dim(df) 
  rowSums(res)


# Vectorized substr
David <- function(df)  
  tmp <- unlist(df)
  res <- (substr(tmp, 1, 5) == "I25.2") | (substr(tmp, 1, 4) %in% c("I21.", "I22."))
  dim(res) <- dim(df)
  rowSums(res)

验证

identical(SixHu(test), SixHuVec(test))
## [1] TRUE
identical(SixHu(test), David(test))
## [1] TRUE

基准测试结果

microbenchmark::microbenchmark(SixHu(big.df),
                               SixHuVec(big.df),
                               David(big.df))
# Unit: milliseconds
#             expr       min         lq       mean     median        uq       max neval cld
#    SixHu(big.df) 989.55655 1021.17121 1047.63956 1041.94771 1062.7705 1151.4196   100   b
# SixHuVec(big.df)  67.52131   72.39233   84.61193   75.31462   85.5352  147.0646   100  a 
#    David(big.df)  63.48242   68.20945   88.73896   75.19159  115.3958  147.0867   100  a

【讨论】：

感谢您的建议！由于我只是 R 的初学者，循环是我编写代码最直观的方式。我逐行逐列运行 substr，因为实际上我有 200 多个变量，我只想选择其中的一些。我比较了 Sixiang.Hu 使用 sapply 和 grepl() 的代码，David Arenburg 使用 grepl() 和 David Arenburg 使用 substr 的代码，看来 sapply 代码的性能最好。但是，您在本节中提供的代码会生成许多 NA 值。请参阅我对我的问题的更新。谢谢。 @MiaoCai 我添加了一些基准，请参阅我的编辑。我相信你的基准是错误的。 谢谢。我已经弄清楚了生成 NA 的原因，并在原始问题中进行了更新。我还根据我的数据做了一个基准测试。有趣的是，我的基准测试结果与您的不同。 sapply 没有你的基准测试结果那么糟糕。【参考方案2】：

我建议使用正则表达式，然后 sapply 进行矢量化。

t_test <- as.data.frame(t(test))
chk <- function(x)
  grepl("I25\\.2|I21\\.|I22\\.",x)


sapply(t_test,chk)

返回结果将基于真或假，并且可以很容易地转换为 0 或 1。

编辑1： 我没有注意到它的坏处是基于行的检查。更新了上面的代码。

编辑2： 改变回归模式： 1. 使用\\ 转义.。否则，单个. 表示匹配任何字符 2. 将[] 改为|，给定[] 表示如果其中的任何字符都会给出TRUE。

【讨论】：

这不会按列应用，而 OP 是按行工作的吗？ @Sixiang.Hu 感谢您的帮助！通过 sapply，性能提高了很多。我想知道“grepl”函数是如何工作的。当我输入 grepl("[H34.0][G45]","H34.023") 时，它返回 TRUE。但是，当我输入 grepl("[H34.0][G45][G46][I60][I61][I62][I63][I64][I65][I66][I67][I68][I69]","H34.023") 时，它会返回 FALSE。这会带来很大的麻烦，因为有时我需要包含许多字符集。 @MiaoCai，回复已编辑，更多正则表达式，您可以搜索“r正则表达式”（例如stat545.com/block022_regular-expression.html）。 这里的逐行循环是不必要的。您可以使用 res &lt;- grepl("I25\\.2|I21\\.|I22\\.", unlist(test)) ; dim(res) &lt;- dim(test) ; test$MI &lt;- rowSums(res) 之类的方式轻松地将其矢量化 @Sixiang.Hu 感谢您的帮助。我在linkedin上看到了你的简历，看来我们来自同一个城市。我毕业于武汉大学旁边的华中科技大学。【参考方案3】：

更新 1

我比较了@Sixiang.Hu 使用“sapply & grepl()”、@David Arenburg 使用“grepl()”和@David Arenburg 使用“substr”的代码，看来 sapply 代码的效果最好表现。但是，本节中提供的@David Arenburg 代码的“substr”会生成许多 NA 值。任何人都可以解释这些 NA 值产生的原因吗？

> # sapply & grepl()
> start.time <- Sys.time()
> test <- subset(I61, select = c("p324", "p327", "p3291", "p3294", "p3297", "p3281", "p3284", "p3287", "p3271", "p3274"))
> MIchk <- function(x)
+   grepl("I25\\.2|I21\\.|I22\\.",x)
+ 
> test1 <- sapply(test,MIchk)
> test$MI <- rowSums(test1)
> end.time <- Sys.time()
> end.time - start.time
Time difference of 2.363007 secs
> table(test$MI,exclude = NULL)

     0      1      2   <NA> 
254495   3523     15      0 
> 
> # grepl() 
> start.time <- Sys.time()
> test <- subset(I61, select = c("p324", "p327", "p3291", "p3294", "p3297", "p3281", "p3284", "p3287", "p3271", "p3274"))
> res <- grepl("I25\\.2|I21\\.|I22\\.", unlist(test))
> dim(res) <- dim(test)
> test$MI1 <- rowSums(res)
> end.time <- Sys.time()
> end.time - start.time
Time difference of 2.51223 secs
> table(test$MI1,exclude = NULL)

     0      1      2   <NA> 
254495   3523     15      0 
> 
> # substr
> start.time <- Sys.time()
> test <- subset(I61, select = c("p324", "p327", "p3291", "p3294", "p3297", "p3281", "p3284", "p3287", "p3271", "p3274"))
> res <- (substr(unlist(test), 1, 5) == "I25.2") | (substr(unlist(test), 1, 4) %in% c("I21.", "I22."))
> dim(res) <- dim(test)
> test$MI2 <- rowSums(res)
> end.time <- Sys.time()
> end.time - start.time
Time difference of 3.473388 secs
> table(test$MI2,exclude = NULL)

     0      1      2   <NA> 
154897   2461     11 100664

更新 2

substr 操作产生许多 NA 值的原因是我的数据集包含 NA 值。所以我执行了以下代码，然后上面提到的三个操作产生了一致的结果：

library(dplyr)
test %>% mutate_if(is.factor, as.character) -> test 
test[is.na(test)]<-0

然后我执行了三个代码：

> #=================================
> # sapply & grepl()
> start.time <- Sys.time()
> MIchk <- function(x)
+   grepl("I25\\.2|I21\\.|I22\\.",x)
+ 
> test1 <- sapply(test,MIchk)
> test$MI <- rowSums(test1)
> end.time <- Sys.time()
> end.time - start.time
Time difference of 5.864876 secs
> table(test$MI,exclude = NULL)

     0      1      2   <NA> 
520339   3081     21      0 
> #=================================
> # grepl() 
> start.time <- Sys.time()
> test1 <- subset(test, select = c("p324", "p327", "p3291", "p3294", "p3297", "p3281", "p3284", "p3287", "p3271", "p3274"))
> res <- grepl("I25\\.2|I21\\.|I22\\.", unlist(test1))
> dim(res) <- dim(test1)
> test$MI1 <- rowSums(res)
> end.time <- Sys.time()
> end.time - start.time
Time difference of 17.20333 secs
> table(test$MI1,exclude = NULL)

     0      1      2   <NA> 
520339   3081     21      0 
> #=================================
> # substr
> start.time <- Sys.time()
> test2 <- subset(test, select = c("p324", "p327", "p3291", "p3294", "p3297", "p3281", "p3284", "p3287", "p3271", "p3274"))
> tmp <- unlist(test2)
> res <- (substr(tmp, 1, 5) == "I25.2") | (substr(tmp, 1, 4) %in% c("I21.", "I22."))
> dim(res) <- dim(test2)
> test$MI2 <- rowSums(res)
> end.time <- Sys.time()
> end.time - start.time
Time difference of 4.386484 secs
> table(test$MI2,exclude = NULL)

     0      1      2   <NA> 
520339   3081     21      0

最后，我还做了一个基准测试，结果表明 substr 操作比 sapply/grepl 略好，并且明显优于单独的矢量化 grepl。这是我的代码和结果：

#--------------------------------
SixHu <- function(df)  
  MIchk <- function(x)
    grepl("I25\\.2|I21\\.|I22\\.",x)
  
  test1 <- sapply(df,MIchk)
  rowSums(test1)

#--------------------------------
# Vectorized grepl
SixHuVec <- function(df)  
  res <- grepl("I25\\.2|I21\\.|I22\\.", unlist(df))
  dim(res) <- dim(df) 
  rowSums(res)

#--------------------------------
David <- function(df)  
  tmp <- unlist(df)
  res <- (substr(tmp, 1, 5) == "I25.2") | (substr(tmp, 1, 4) %in% c("I21.", "I22."))
  dim(res) <- dim(df)
  rowSums(res)

> microbenchmark::microbenchmark(SixHu(test),
                                 +                                SixHuVec(test),
                                  +                                David(test))
Unit: seconds
expr       min        lq      mean    median        uq       max neval cld
SixHu(test)  4.323772  4.598328  4.836165  4.760263  4.988194  5.801979   100  b 
SixHuVec(test) 11.867062 12.826925 13.342357 13.243638 13.635339 18.705615   100   c
David(test)  3.728264  4.180152  4.389600  4.344938  4.519908  6.396018   100 a

因此，@David Arenburg 的矢量化 substr() 是最佳答案，而 @Sixiang.Hu 的 sapply/grepl 是最佳答案，并且明显优于 @David Arenburg 的 grepl()。无论如何，这三种方法都比 OP 的循环好得多:(。谢谢大家！@David Arenburg @Sixiang.Hu

【讨论】：

以上是关于如何避免R中特定多条件语句中的循环的主要内容，如果未能解决你的问题，请参考以下文章

R语言中的循环语句

While循环语句#yyds干货盘点#

Java语句与流程控制结构

python中的if循环怎么样？

Java 控制语句：循环条件判断

vb中的循环语句