将R中的嵌套for()循环转换为适当的向量运算

时间:2015-07-10 18:05:54

标签: r loops vector

R用于向量/矩阵运算。它允许但不满意for()循环。嵌套的for()循环需要永远

我已经读过几乎所有的for()循环都可以变成适当的向量操作,但对于我的生活,我无法弄清楚如何在这个简单的情况下做到这一点:

我有两个不同长度的数据表dt_a和dt_b(dt_a:1408行&amp; dt_b:2689行),列dt_a$xdt_b$y,和dt_b$z。我想在dt_a$x的每个值中搜索列dt_b$y中任意值的匹配项,如果匹配,请设置dt_b$z <- dt_a$x。如果没有匹配项,请将其设置为&#34; NOMATCH&#34;。

这是一个带有for循环的编程101操作:

for (i in 1:2689) {
    for (j in 1:1408) {
        if (grepl(dt_a$x[j], dt_b$y[i], ignore.case=TRUE, perl=TRUE)) {
            dt_b$z[i] <- dt_a$x[j];
            break;
        }
        dt_a$z[i] <- "NOMATCH";
    }
}   

但是,此操作需要超过6分钟才能运行,遍历所有循环。我很快就需要将其调整为更大的数据集,因此增加数量级的时间是不可行的。

使用正确的R向量运算执行此嵌套for()循环操作的正确方法是什么?

谢谢!

更新

@nickk的答案将其中一个循环向量化,使得嵌套不必要并将执行减少一个数量级。我认为它是最有用的答案,因为我能够让它在我的代码中运行。 @deanmacgregor提供的答案对于帮助我更多地了解正在发生的事情非常有用。我无法让他们在我的代码中运行,但这可能是我不理解某些事情的错。特别是交叉连接方法可能是最好的解决方案。我需要更多练习才能使其与我的数据一起使用,但我不想在解决这个问题之前等待太久。

另外感谢@romantsegelskyi教我正确的问题格式,并感谢@pierrelafortune和@brodieG教我可重现问题的重要性和内容。 ^ _ ^

我已经在我的源代码中记录了所有内容(将来某天)将作为开源发布。

4 个答案:

答案 0 :(得分:2)

刚从评论中看到完全匹配不起作用。这是使用crossjoin

的新方法
library(data.table)
#make dummy data
dt_a<-data.table(x=unlist(lapply(1:1408, function(x) paste0(LETTERS[as.integer(runif(3,1,26))],collapse=""))))
dt_b<-data.table(y=unlist(lapply(1:2689, function(x) paste0(letters[as.integer(runif(4,1,26))],collapse=""))))
#remove dupes from dummy data
dt_a<-unique(dt_a)
dt_b<-unique(dt_b)


#make crossjoin
cross<-CJ(x=dt_a[,x],y=dt_b[,y])
#make column that is true for match/false for non-match
cross[,Match:=grepl(x,y,ignore.case = T),by=x]
#make z column corresponding to match
cross[,z:="NOMATCH"]
cross[Match==TRUE,z:=x]
#get rid of Match and x column
cross[,Match:=NULL]
cross[,x:=NULL]
#helper function to deal with all the extra rows
fixZ<-function(x) {
  if(any(x!="NOMATCH")) {
    return(x[!x%in%"NOMATCH"])
  } else {
    return("NOMATCH")
  }
}
#run helper function on column z for every y value
dt_b<-unique(cross[,list(z=fixZ(z)),by="y"])

这是旧的:

使用%in%运算符。

library(data.table)
#make dummy data
dt_a<-data.table(x=unlist(lapply(1:1408, function(x) paste0(LETTERS[as.integer(runif(3,1,26))],collapse=""))))
dt_b<-data.table(y=unlist(lapply(1:2689, function(x) paste0(letters[as.integer(runif(3,1,26))],collapse=""))))
#remove dupes from dummy data
dt_a<-unique(dt_a)
dt_b<-unique(dt_b)
#make dummy upper case versions of x and y for case insensitive comparison
dt_b[,upper:=toupper(y)]
dt_a[,upper:=toupper(x)]
#make default z
dt_b[,z:="NOMATCH"]    
#set z to y when y exists in x
dt_b[upper %in% dt_a[,upper],z:=y]   
#replace z with x so case of z matches case of x
setkey(dt_a,upper)
setkey(dt_b,upper)
dt_b[dt_a,z:=ifelse(!is.na(z),x,NA)]


#delete dummy variables
dt_b[,upper:=NULL]
dt_a[,upper:=NULL]

答案 1 :(得分:1)

以下是考虑矢量化的一个例子:

dt_a <- c(1,2,3)
dt_b <- c(3,2,1,0)
dt_a == dt_b
# [1] FALSE  TRUE FALSE FALSE
# Warning message:
# In dt_a == dt_b :
#   longer object length is not a multiple of shorter object length

它们长度不等。评估员将完成操作,但它会警告我们正在回收较小的载体。如果我们确定我们只想比较值dt_a的长度,我们可以将dt_b分组到该长度,以获得相等的长度匹配。

dt_a == dt_b[seq_along(dt_a)]
#[1] FALSE  TRUE FALSE

从那里很容易进行矢量化:

dt_z <- ifelse(dt_a == dt_b[seq_along(dt_a)], dt_a, "NOMATCH")
dt_z
#[1] "NOMATCH" "2"       "NOMATCH"

<强>更新

让我们强调可重复的例子的重要性。它为网站上的每个人提供了尝试不同方法的机会。这是循环重新编码的另一个例子。这是你的循环目前做的吗?

a <- c(5,0,9)
b <- c(2,5,0,1,9)
c <- c()
d <- c()
for (i in 1:5) {
    for (j in 1:3) {
        if (grepl(a[j], b[i], ignore.case=TRUE, perl=TRUE)) {
            c[i] <- a[j];
            break;
        }
        d[i] <- "NOMATCH";
    }
}

c
[1] NA  5  0 NA  9

d
[1] "NOMATCH" NA        "NOMATCH" "NOMATCH" "NOMATCH"

答案 2 :(得分:0)

apply/lapply/sapply/mapply中的向量操作(R)并不直接等同于for/while循环。 apply完全按照它的说法完成:它按顺序在一些类似的参数上应用一个函数,并返回结果。因此,根据定义,您不能break申请。不久前,这是R论坛上的discussed

此外,您只能访问全局环境,甚至可以使用assign<<-更改变量,但这非常危险。

因此,在将其转换为矢量化操作之前,需要对您想要实现的内容进行一些重新思考。

> x <- 7:11
> y <- 1:10
> z <- rep("No match", 5)
> ind <- which(apply(sapply(x, grepl, y), 2, any) == T)
> ind
[1] 1 2 3 4
> m.val <- which(apply(sapply(x, grepl, y), 1, any) == TRUE)
> m.val
[1]  7  8  9 10
> z[ind] <- y[m.val]
> z
[1] "7"        "8"        "9"        "10"       "No match"

虽然

看起来并不是很简单

答案 3 :(得分:0)

dt_b[, z := NA]
for (x in dt_a$x) {
  found <- grepl(x, dt_b$y, ignore.case=TRUE, perl=TRUE)
  dt_b[found & is.na(z), z := x]
}
dt_b[is.na(z), z := "NOMATCH"]

到目前为止,这比其他答案更接近原始功能。 dt_a$x可以拥有任何有效的PCRE模式,而不是寻找完全匹配。使用@DenMacGregor的数据,在我的机器上运行需要几秒钟。

请注意,它利用了grepl被矢量化的事实。通过dt_a$x并仅替换NA值会复制之前看到的break的效果。

为了获得稍快的结果,这将取代grepl行。

  found <- stringi::stri_detect_regex(dt_b$y, x, opts_regex = stri_opts_regex(case_insensitive = TRUE))