Turning nested for() loops in R into proper vector operations

Question

R is written for vector/matrix operations. It allows but is not happy with for() loops. Nested for() loops take forever

I've read that pretty much all for() loops can be turned into proper vector operations, but for the life of me, I can't figure out how to do it in this simple case:

I have two data tables, dt_a and dt_b of different lengths (dt_a: 1408 rows & dt_b: 2689 rows), with columns dt_a$x, dt_b$y, and dt_b$z. I want to search for matches of any value in of column dt_a$x in each value of dt_b$y and if they match, set dt_b$z <- dt_a$x. If there's no match, set it to "NOMATCH".

This is a programming 101 operation with for loops:

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";
    }
}   

However, this operation takes more than 6 minutes to run, iterating through all the loops. I'll soon need to adapt it to a much larger data set, so the order of magnitude time increases will not be viable.

What's the correct way to do this nested for() loop operation using proper R vector operations?

Thanks!

Update

The answer by @nickk vectorizes one of the loops making the nesting unecessary and reducing the execution by an order of magnitude. I've credited it as most useful answer because I was able to get it to work in my code. The answers provided by @deanmacgregor were very useful in helping me understand more about what is going on. I couldn't get them to run in my code, but that's probably my fault for not understanding something. The cross-join approach, in particular, is probably the best solution. I need more practice in order to make it work with my data, but I don't want to wait too long before resolving this question.

Additional thanks to @romantsegelskyi for teaching me proper question formatting, and to @pierrelafortune and @brodieG for teaching me the importance and content of reproducible questions. ^_^

I've credited you all in my source code which will (someday) be released as open source.

Answer 1

Just saw from comments that exact matches don't work. Here's a new method using 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"])

This is old:

Use the %in% operator.

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]

Answer 2

Here's an example to think about vectorization:

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

They are of unequal length. The evaluator will complete the action, but it will warn us that the smaller vector is being recycled. If we are sure that we only want to compare the values the length of dt_a we can subset dt_b up to that length for an equal length match.

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

From there it is easy to vectorize:

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

Update

Let us emphasize the importance of a reproducible example. It gives everyone on the site a chance to try out different approaches. Here is another example with your loop recoded. Is this what your loop currently does?

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"

Answer 3

Vector operations (apply/lapply/sapply/mapply) in R are not directly equivalent to for/while loops. apply does exactly as it says: it applies a function on a number of similar arguments sequentially, and returns the result. Hence, by definition you cannot break out of an apply. This was discussed on R forums some time ago.

Moreover, you can only access the global environment and even change variables using assign or <<-, but this is pretty dangerous.

So it requires a bit of rethinking of what you want to achieve before you will be able to convert it to vectorized operations.

> 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"

That doesn't seem like much simplification though

Answer 4

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"]

This is closer to the functionality of the original than the other answers so far. dt_a$x can have any valid PCRE pattern rather than looking for exact matches. Using @DeanMacGregor's data, it takes a few seconds to run on my machine.

Note that it takes advantage of the fact that grepl is vectorised. Working through dt_a$x and only replacing NA values replicates the effect of the break seen before.

For slightly faster results, this will do in place of the grepl line.

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