technique efficace ridy R pour le traitement des groupes de trames de données alignées

Question

J'essaie de trouver un moyen efficace (et idéalement bien rangé) de traiter une paire de trames de données groupées. La configuration ressemble plus ou moins comme ceci:

A = crossing(idx=1:1e5, asdf=seq(1:rpois(1,50)) 
B = tbl(idx=sample(1:1e5, replace=TRUE), yet_more_stuff='whatever') 
proc_one_group <- function(one_A, one_b) { ... } 
# example: 
proc_one_group(filter(A, idx==50), filter(B, idx==50)) 

Ainsi, mon opération de traitement, ce qui est assez complexe, fonctionne sur un idx à la fois, à partir de deux trames de données séparées, où l'un d'entre eux a un ou plus (généralement des dizaines) lignes par idx, et l'autre peut avoir zéro, une ou plusieurs lignes par idx.

Une façon que je sais que je peux faire ceci est ceci, mais c'est très lent, parce que l'opération filter sur chaque valeur exige un balayage complet de table et un sous-ensemble.

map_df(unique(A$idx), ~ proc_one_group(filter(A, idx==.), filter(B, idx==.))) 

Je sais aussi que je peux utiliser split pour créer une liste de sous-trames de data_frames relativement efficace, mais je ne sais pas une bonne façon de le faire alors O (1) par l'indice des recherches les deux data_frame s.

Ce que je sorte de veux est la première étape d'un left_join, où il figure les sous-groupes d'index de chaque groupe, mais au lieu de créer réellement un seul data_frame de la combinaison cartésienne de chaque groupe, il me donne juste la paire de sous-groupes que je peux traiter au besoin. (Un plein left_join ne m'aide pas ici.)

Des idées?

Answer 1

Une possibilité serait d'imbriquer vos deux trames de données d'abord, avant de rejoindre:

library(tidyverse) 

set.seed(1234) 

A = crossing(idx = 1:1e5, asdf = seq(1:rpois(1, 50))) 
B = data_frame(idx = sample(1:1e5, replace = TRUE), yet_more_stuff = "whatever") 

proc_one_group <- function(one_A, one_B) { ... } 

nest_A <- A %>% 
    group_by(idx) %>% 
    nest(.key = "data_a") 
nest_B <- B %>% 
    group_by(idx) %>% 
    nest(.key = "data_b") 

all_data <- full_join(nest_A, nest_B, by = "idx") 
all_data 
#> # A tibble: 100,000 x 3 
#>  idx   data_a   data_b 
#> <int>   <list>   <list> 
#> 1  1 <tibble [41 x 1]>   <NULL> 
#> 2  2 <tibble [41 x 1]> <tibble [2 x 1]> 
#> 3  3 <tibble [41 x 1]> <tibble [2 x 1]> 
#> 4  4 <tibble [41 x 1]> <tibble [1 x 1]> 
#> 5  5 <tibble [41 x 1]>   <NULL> 
#> 6  6 <tibble [41 x 1]>   <NULL> 
#> 7  7 <tibble [41 x 1]> <tibble [2 x 1]> 
#> 8  8 <tibble [41 x 1]>   <NULL> 
#> 9  9 <tibble [41 x 1]> <tibble [1 x 1]> 
#> 10 10 <tibble [41 x 1]> <tibble [1 x 1]> 
#> # ... with 99,990 more rows 

Il en résulte une seule trame de données, les données pour chaque idx de trame de données A dans data_a, et les données de la trame de données B au data_b. Une fois cela fait, la grande trame de données n'a pas besoin d'être filtrée pour chaque cas dans l'appel map_df.

all_data %>% 
    map2_df(data_a, data_b, proc_one_group) 

Answer 2

Voici quelques résultats d'analyse comparative:

A = crossing(idx=1:1e3, asdf=seq(1:rpois(1,50))) 
B = tibble(idx=sample(1:1e3, replace=TRUE), yet_more_stuff='whatever') 

La première idée est d'utiliser split comme vous le suggérez, en gardant l'ordre de split.A et split.B même.Vous pouvez utiliser map2 pour parcourir les listes matched:

myfun <- function(A,B) { 
    split.A <- split(A, A$idx) 
    splitsort.A <- split.A[order(names(split.A))] 
    splitsort.B <- map(names(splitsort.A), ~B[as.character(B$idx) == .x,]) 
    ans <- map2(splitsort.A, splitsort.B, ~unique(.x$idx) == unique(.y$idx)) 
    return(ans) 
} 

Telle est l'approche que vous utilisez actuellement, en utilisant dplyr::filter

OP <- function(A,B) { 
    ans <- map(unique(A$idx), ~unique(filter(A, idx==.x)$idx) == unique(filter(B, idx==.x)$idx)) 
    return(ans) 
} 

Ceci est la même logique, mais en évitant dplyr::filter qui est plus lent comparé à la base R subsetting

OP2 <- function(A,B) { 
    ans <- map(unique(A$idx), ~unique(A[A$idx==.x,]$idx) == unique(B[B$idx==.x,]$idx)) 
    return(ans) 
} 

Il utilise @ l'approche de JakeThompson (Il semble être un gagnant parmi les méthodes actuelles)

JT <- function(A,B) { 
    nest.A <- A %>% group_by(idx) %>% nest() 
    nest.B <- B %>% group_by(idx) %>% nest() 
    ans <- full_join(nest.A, nest.B, by="idx") 
} 

Certains validation pour faire en sorte que les résultats de certaines des fonctions du sens

identical(OP(A,B), OP2(A,B)) 
# TRUE 

E <- myfun(A,B) 
any(E==FALSE) 
# NA 

F <- myfun(A,B) 
any(F==FALSE) 
# NA 

identical(sum(E==TRUE, na.rm=TRUE), sum(F==TRUE, na.rm=TRUE)) 
# TRUE 

Analyse comparative résultats

library(microbenchmark) 
microbenchmark(myfun(A,B), OP(A,B), OP2(A,B), JT(A,B), times=2L) 
# Unit: seconds 
     # expr  min  lq  mean median  uq  max neval 
# myfun(A, B) 3.164046 3.164046 3.254588 3.254588 3.345129 3.345129  2 
    # OP(A, B) 14.926431 14.926431 15.053662 15.053662 15.180893 15.180893  2 
    # OP2(A, B) 3.202414 3.202414 3.728423 3.728423 4.254432 4.254432  2 
    # JT(A, B) 1.330278 1.330278 1.378241 1.378241 1.426203 1.426203  2