R - scalanie ramek danych na pasujących A, B i * najbliższych * C?

Question

mam dwa dataframes tak:

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) 

Chcę połączyć to.merge do df (z all.x=T) takie, że:

• df$x == to.merge$x I
• df$y == to.merge$y I
• abs(df$time - to.merge$time) <= 1; w przypadku wielu to.merge, które spełniają, wybieramy ten, który minimalizuje te odległości.

Jak mogę to zrobić?

więc my pożądany rezultat jest (jest to df z odpowiednim value kolumnie to.merge dodano do odpowiadających rzędów):

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 

gdzie to.merge był następujący:

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 

Uwaga - (2 , 1, 17, a) nie pasowało do df, ponieważ time 17 było więcej niż 1 z dala od df$time 11 dla (X, Y) = (2, 1) .

Ponadto, istnieją dwa wiersze to.merge które spełniały warunek dla dopasowania do df „s (2, 1, 11) rzędu, a«C»rząd został wybrany zamiast«b»rzędu, ponieważ jego time był najbliżej 11.

Wreszcie, mogą być wiersze w to.merge, które nie pasują do niczego w df.

---

Jednym ze sposobów, który działa to pętla for-, ale to trwa zbyt długo na przetwarzanie moich danych (df ma ~ wiersze 12K i to.merge ma ~ wiersze 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] 
    } 
} 

czuję, że można jakoś zrobić seryjnej, jak:

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) 

ale to nie scalić (2, 1, 11) wiersz bo to.merge$closest_time_in_df dla (2, 1, 11.5, c) jest 12, ale czasem 12 w df odpowiada (x, y) = (2, 5) nie (2, 1), więc połączenie nie powiedzie się.

Answer 1

Korzystanie merge kilka razy i aggregate raz, oto jak to zrobić.

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

Zastosowanie data.table i roll='nearest' lub ograniczyć do 1, roll = 1, rollends = c(TRUE,TRUE)

np

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 

Można ograniczyć siebie do patrzenia do przodu i do tyłu (1), ustawiając roll=-1 i 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 

Lub możesz rzucić = 1 pierwszy, a następnie rzucić = -1, a następnie połączyć wyniki (sprzątając val.1 colum n od drugiego walcowania przyłączyć)

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