R用于向量/矩阵运算。它允许但不满意for()
循环。嵌套的for()
循环需要永远
我已经读过几乎所有的for()
循环都可以变成适当的向量操作,但对于我的生活,我无法弄清楚如何在这个简单的情况下做到这一点:
我有两个不同长度的数据表dt_a和dt_b(dt_a
:1408行& dt_b
:2689行),列dt_a$x
,dt_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教我可重现问题的重要性和内容。 ^ _ ^
我已经在我的源代码中记录了所有内容(将来某天)将作为开源发布。
答案 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))