CODEWITHSUNDEEP
rperformancemergedata.tablesequence
Powege
Powege

Reputation: 705

How to efficiently merge two data tables based on overlapping sequences in R?

I have two data tables, for example: 

dt1 <- data.table(ID1 = c("A", "B", "C", "D", "E"),
                  start1 = c(100, 1, 210, 300, 400),
                  end1 = c(200, 90, 240, 380, 500))
dt2 <- data.table(ID2 = c("a1", "a2", "a3", "a4", "a5", "a6"),
                  start2 = c(10, 150, 300, 310, 350, 400),
                  end2 = c(50, 100, 250, 280, 390, 450))

And I am trying to merge them based on whether they have overlapping sequences. For example, the desired output is:

 output <- data.table(ID1 = c("A", "B", "D", "D", "D", "E"),
                     start1 = c(100, 1, 300, 300, 300, 400),
                     end1 = c(200, 90, 380, 380, 380, 500),
                     ID2 = c("a2", "a1", "a3", "a4", "a5", "a6"),
                     start2 = c(150, 10, 300, 310, 350, 400),
                     end2 = c(100, 50, 250, 280, 390, 450))

I can do this in a for loop. For example:

ID1_list <- list() # set output lists 
ID2_list <- list()
for (i in 1:nrow(dt1)){
  vec1 <- seq(from = dt1$start1[i], to = dt1$end1[i])
  ID1_vec <- rep(dt1$ID1, each = nrow(dt2)) # set output vectors
  ID2_vec <- rep(NA, nrow(dt2))
  for (j in 1:nrow(dt2)){
    vec2 <- seq(from = dt2$start[j], to = dt2$end[j])
    if (length(intersect(vec2, vec1)) > 0){
      ID2_vec[j] <- dt2$ID2[j]
    }
  }
  ID1_list[[i]] <- ID1_vec
  ID2_list[[i]] <- ID2_vec
}
output2 <- data.table(ID1 = unlist(ID1_list),
                      ID2 = unlist(ID2_list))
output2 <- output2[complete.cases(output2),]
output2 <- merge(dt1, unique(output2))
output2 <- merge(output2, dt2, by = "ID2")

However, this the data tables I am applying this to are very large and this method is too slow. Does anyone have any suggestions about how I can improve performance?

Upvotes: 0

Views: 69

Answers (1)

Wimpel
Wimpel

Reputation: 27732

a solution using data.table::foverlaps()..

foverlaps()-function errors on your sample data, because end < start in some rows in dt2. So I did some alterations on your sample (switch start to end, and v.v.).

library(data.table)
#in foverlaps(), start should always be before end..
#so switch dt2's values where this is not the case
dt2[ start2 > end2, `:=`( start2 = end2, end2 = start2)]

setkey(dt1, start1, end1)
setkey(dt2, start2, end2)
foverlaps( dt2, dt1 )

#    ID1 start1 end1 ID2 start2 end2
# 1:   B      1   90  a1     10   50
# 2:   A    100  200  a2    100  150
# 3:   D    300  380  a3    250  300
# 4:   D    300  380  a4    280  310
# 5:   D    300  380  a5    350  390
# 6:   E    400  500  a6    400  450

update

ans <- foverlaps( dt2, dt1 )

library( matrixStats )
ans[, overlap_start := rowMaxs( as.matrix(.SD), na.rm = TRUE ), .SDcols = c("start1", "start2")]
ans[, overlap_end   := rowMins( as.matrix(.SD), na.rm = TRUE ), .SDcols = c("end1", "end2")]
ans[, overlap_size  := overlap_end - overlap_start + 1 ]


#    ID1 start1 end1 ID2 start2 end2 overlap_start overlap_end overlap_size
# 1:   B      1   90  a1     10   50            10          50           41
# 2:   A    100  200  a2    100  150           100         150           51
# 3:   D    300  380  a3    250  300           300         300            1
# 4:   D    300  380  a4    280  310           300         310           11
# 5:   D    300  380  a5    350  390           350         380           31
# 6:   E    400  500  a6    400  450           400         450           51

Upvotes: 2

Related Questions