2
votes

I am trying to extract the index values from a dataframe (df1) that represent a range of times (start - end) and that encompass the times given in another dataframe (df2). My required output is df3.

df1<-data.frame(index=c(1,2,3,4),start=c(5,10,15,20),end=c(10,15,20,25))
df2<-data.frame(time=c(11,17,18,5,5,22))
df3<-data.frame(time=c(11,17,18,5,5,22),index=c(2,3,3,1,1,4))

Is there a tidyverse solution to this?

3

3 Answers

1
votes

You can do it with R base functions. A combination of which inside sapply and logical comparison will do the work for you.

 inds <- apply(df1[,-1], 1, function(x) seq(from=x[1], to=x[2]))
 index <- sapply(df2$time, function(x){
   tmp <- which(x == inds, arr.ind = TRUE);
   tmp[, "col"]
 } )
 df3 <- data.frame(df2, index)
 df3
  time index
1   11     2
2   17     3
3   18     3
4    5     1
5    5     1
6    8     1
1
votes

Data:

df1<-data.frame(index=c(1,2,3,4),start=c(5,10,15,20),end=c(10,15,20,25))
df2<-data.frame(time=c(11,17,18,2,5,5,8,22))

Code:

# get index values and assign it to df2 column
df2$index <- apply( df2, 1, function(x) { with(df1, index[ x[ 'time' ]  >= start & x[ 'time' ] <= end ] ) }) 

Output:

df2
#   time index
# 1   11     2
# 2   17     3
# 3   18     3
# 4    2      
# 5    5     1
# 6    5     1
# 7    8     1
# 8   22     4
1
votes

Here is one option with findInterval

ftx <- function(x, y) findInterval(x, y)
df3 <- transform(df2, index = pmax(ftx(time, df1$start), ftx(time, df1$end)))

df3
#   time index
#1   11     2
#2   17     3
#3   18     3
#4    5     1
#5    5     1
#6   22     4

Or another option is foverlaps from data.table

library(data.table)
dfN <- data.table(index = seq_len(nrow(df2)), start = df2$time, end = df2$time)
setDT(df1)
setkey(dfN, start, end)
setkey(df1, start, end)
foverlaps(dfN, df1, which = TRUE)[, yid[match(xid, dfN$index)]]
#[1] 2 3 3 1 1 4

As the OP commented about using a solution with pipes, @Jilber Urbina's solution can be implemented with tidyverse functions

library(tidyverse)
df1 %>% 
    select(from = start, to = end) %>% 
    pmap(seq) %>% 
    do.call(cbind, .) %>% 
    list(.) %>%
    mutate(df2, new = ., 
                ind = map2(time, new, ~ which(.x == .y, arr.ind = TRUE)[,2])) %>%
    select(-new)
#   time ind
#1   11   2
#2   17   3
#3   18   3
#4    5   1
#5    5   1
#6   22   4