代码之家 › 专栏 › 技术社区 › Harlan

处理对齐数据帧组的高效TIDDER技术

tidyverse dataframe r

Harlan · 技术社区 · 7 年前

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))

因此,我的处理操作相当复杂,在一个 idx 一次,从两个独立的数据帧开始,其中一个数据帧每帧有一行或多行(通常是几十行) idx公司 ,另一个可以有零行、一行或多行

我知道我可以这样做,但速度很慢,因为 filter 对每个值的操作都需要完整的表扫描和子集。

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

我也知道我可以用 split data_frame s

我想要的是 left_join data_帧 在每个组的笛卡尔组合中,它只给了我一对子组,我可以根据需要处理它们。(A完整这对我没有帮助。)

2 回复 | 直到 7 年前

Jake Thompson 7 年前

一种可能是在连接之前先嵌套两个数据帧:

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

这将产生一个数据帧,每个数据帧的数据 idx A 在里面 data_a B data_b map_df 呼叫

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

CPak 7 年前

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

第一个想法是使用 split 正如你所建议的,保持 split.A 和 split.B map2 要遍历匹配的列表,请执行以下操作:

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)
}

这是您当前使用的方法,使用 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)
}

dplyr::过滤器 这就是与基R子集相比

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

这使用了@JakeThompson的方法(在当前的方法中,它似乎是一个胜利者)

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")
}

进行一些验证,以确保某些函数的结果有意义

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

基准测试结果

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