R - unire i dataframes sulla corrispondenza di A, B e * più vicino * C?

Question

ho due dataframes in questo modo:

set.seed(1) 
df <- cbind(expand.grid(x=1:3, y=1:5), time=round(runif(15)*30)) 
to.merge <- data.frame(x=c(2, 2, 2, 3, 2), 
         y=c(1, 1, 1, 5, 4), 
         time=c(17, 12, 11.6, 22.5, 2), 
         val=letters[1:5], 
         stringsAsFactors=F) 

voglio fondere to.merge in df (con all.x=T) tale che:

• df$x == to.merge$x E
• df$y == to.merge$y E
• abs(df$time - to.merge$time) <= 1; nel caso di più to.merge che soddisfano, scegliamo quello che minimizza queste distanze.

Come posso fare questo?

Quindi il mio risultato desiderato è (questo è solo df con la corrispondente value colonna to.merge aggiunto per le righe corrispondenti):

x y time val 
1 1 1 8 NA 
2 2 1 11 c 
3 3 1 17 NA 
4 1 2 27 NA 
5 2 2 6 NA 
6 3 2 27 NA 
7 1 3 28 NA 
8 2 3 20 NA 
9 3 3 19 NA 
10 1 4 2 NA 
11 2 4 6 NA 
12 3 4 5 NA 
13 1 5 21 NA 
14 2 5 12 NA 
15 3 5 23 d 

dove to.merge era:

x y time val 
1 2 1 17.0 a 
2 2 1 12.0 b 
3 2 1 11.6 c 
4 3 5 22.5 d 
5 2 4 2.0 e 

Nota - (2 , 1, 17, a) non corrisponde a df perché il time 17 era più di 1 a partire da df$time 11 per (X, Y) = (2, 1) .

Inoltre, vi erano due righe in to.merge che ha soddisfatto la condizione di matching per df 's (2, 1, 11) fila, ma la 'c' fila è stato scelto al posto della '' fila b perché la sua time era il più vicino a 11.

Infine, potrebbero essere presenti righe nello to.merge che non corrispondono a nulla in df.

---

Un modo che funziona è un ciclo for-, ma ci vuole troppo tempo per i miei dati (df ha ~ righe 12k e to.merge ha ~ righe 250k)

df$value <- NA 
for (i in 1:nrow(df)) { 
    row <- df[i, ] 
    idx <- which(row$x == to.merge$x & 
       row$y == to.merge$y & 
       abs(row$time - to.merge$time) <= 1) 
    if (length(idx)) { 
     j <- idx[which.min(row$time - to.merge$time[idx])] 
     df$val[i] <- to.merge$val[j] 
    } 
} 

sento che possa in qualche modo fare una fusione, come:

to.merge$closest_time_in_df <- sapply(to.merge$time, 
            function (tm) { 
            dts <- abs(tm - df$time) 
            # difference must be at most 1 
            if (min(dts) <= 1) { 
             df$time[which.min(dts)] 
            } else { 
             NA 
            } 
            }) 
merge(df, to.merge, 
     by.x=c('x', 'y', 'time'), 
     by.y=c('x', 'y', 'closest_time_in_df'), 
     all.x=T) 

ma questo non unisce la riga (2, 1, 11) perché to.merge$closest_time_in_df per (2, 1, 11.5, c) è 12, ma un momento di 12 in df corrisponde a (x, y) = (2, 5) non (2, 1), quindi l'unione non riesce.

Answer 1

utilizzando merge paio di volte e aggregate una volta, ecco come fare.

set.seed(1) 
df <- cbind(expand.grid(x = 1:3, y = 1:5), time = round(runif(15) * 30)) 
to.merge <- data.frame(x = c(2, 2, 2, 3, 2), y = c(1, 1, 1, 5, 4), time = c(17, 12, 11.6, 22.5, 2), val = letters[1:5], stringsAsFactors = F) 

#Find rows that match by x and y 
res <- merge(to.merge, df, by = c("x", "y"), all.x = TRUE) 
res$dif <- abs(res$time.x - res$time.y) 
res 
## x y time.x val time.y dif 
## 1 2 1 17.0 a  11 6.0 
## 2 2 1 12.0 b  11 1.0 
## 3 2 1 11.6 c  11 0.6 
## 4 2 4 2.0 e  6 4.0 
## 5 3 5 22.5 d  23 0.5 

#Find rows that need to be merged 
res1 <- merge(aggregate(dif ~ x + y, data = res, FUN = min), res) 
res1 
## x y dif time.x val time.y 
## 1 2 1 0.6 11.6 c  11 
## 2 2 4 4.0 2.0 e  6 
## 3 3 5 0.5 22.5 d  23 

#Finally merge the result back into df 
final <- merge(df, res1[res1$dif <= 1, c("x", "y", "val")], all.x = TRUE) 
final 
## x y time val 
## 1 1 1 8 <NA> 
## 2 1 2 27 <NA> 
## 3 1 3 28 <NA> 
## 4 1 4 2 <NA> 
## 5 1 5 21 <NA> 
## 6 2 1 11 c 
## 7 2 2 6 <NA> 
## 8 2 3 20 <NA> 
## 9 2 4 6 <NA> 
## 10 2 5 12 <NA> 
## 11 3 1 17 <NA> 
## 12 3 2 27 <NA> 
## 13 3 3 19 <NA> 
## 14 3 4 5 <NA> 
## 15 3 5 23 d 

Answer 2

Usa data.table e roll='nearest' o di limitare a 1, roll = 1, rollends = c(TRUE,TRUE)

esempio

library(data.table) 
# create data.tables with the same key columns (x, y, time) 
DT <- data.table(df, key = names(df)) 
tm <- data.table(to.merge, key = key(DT)) 

# use join syntax with roll = 'nearest' 


tm[DT, roll='nearest'] 

#  x y time val 
# 1: 1 1 8 NA 
# 2: 1 2 27 NA 
# 3: 1 3 28 NA 
# 4: 1 4 2 NA 
# 5: 1 5 21 NA 
# 6: 2 1 11 c 
# 7: 2 2 6 NA 
# 8: 2 3 20 NA 
# 9: 2 4 6 e 
# 10: 2 5 12 NA 
# 11: 3 1 17 NA 
# 12: 3 2 27 NA 
# 13: 3 3 19 NA 
# 14: 3 4 5 NA 
# 15: 3 5 23 d 

È possibile limitare la vostra auto per guardare avanti e indietro (1) impostando roll=-1 e rollends = c(TRUE,TRUE)

new <- tm[DT, roll=-1, rollends =c(TRUE,TRUE)] 
new 
    x y time val 
1: 1 1 8 NA 
2: 1 2 27 NA 
3: 1 3 28 NA 
4: 1 4 2 NA 
5: 1 5 21 NA 
6: 2 1 11 c 
7: 2 2 6 NA 
8: 2 3 20 NA 
9: 2 4 6 NA 
10: 2 5 12 NA 
11: 3 1 17 NA 
12: 3 2 27 NA 
13: 3 3 19 NA 
14: 3 4 5 NA 
15: 3 5 23 d 

Oppure puoi lanciare = 1 prima, quindi tirare = -1, quindi combinare i risultati (riordinare il val.1 colum n dalla seconda laminazione join)

new <- tm[DT, roll = 1][tm[DT,roll=-1]][is.na(val), val := ifelse(is.na(val.1),val,val.1)][,val.1 := NULL] 
new 
    x y time val 
1: 1 1 8 NA 
2: 1 2 27 NA 
3: 1 3 28 NA 
4: 1 4 2 NA 
5: 1 5 21 NA 
6: 2 1 11 c 
7: 2 2 6 NA 
8: 2 3 20 NA 
9: 2 4 6 NA 
10: 2 5 12 NA 
11: 3 1 17 NA 
12: 3 2 27 NA 
13: 3 3 19 NA 
14: 3 4 5 NA 
15: 3 5 23 d