Question

我有一个问题，我需要根据一列选择并保存表的一部分，然后从源表中消除与已保存表的一列中的值匹配的行。

我发现dplyr和data.table比base R慢，并且想知道我在这里做错了什么（我不知道的反模式吗？）还是有人知道更快的解决方案这个。

我需要在搜索df和y_unique搜索的约1万次迭代中将其扩展到约1000万行。

这是一个合理的可复制示例...

（edit：我意识到我所做的事情可以通过组过滤器来实现。留下了更新的可重现示例，其中包含以下注释和我的更新解决方案中的一些调整。-请注意，原始示例不包含bind_cols（ y_list）详细信息。回想起来，我应该在此示例中添加该信息。）

library(dplyr)
library(data.table)
library(microbenchmark)

microbenchmark(base = {
  for(y_check in y_unique) {
    y_list[[as.character(y_check)]] <- df[df$y == y_check, ]
    df <- df[!df$x %in% y_list[[as.character(y_check)]]$x, ]
  }
  out <- bind_rows(y_list)
}, dplyr = {
  for(y_check in y_unique) {
    y_list[[as.character(y_check)]] <- filter(df, y == y_check)
    df <- df[!df$x %in% y_list[[as.character(y_check)]]$x, ]
  }
  out <- bind_rows(y_list)
}, data.table = {
  for(y_check in y_unique) {
    y_list[[as.character(y_check)]] <- dt[y == y_check]
    dt <- dt[!x %in% y_list[[as.character(y_check)]]$x]
  }
  out <- do.call(rbind, y_list)
}, alternate = {
  df <- group_by(df, x)
  out <- filter(df, y == min(y))
}, times = 10, setup = {
  set.seed(1)
  df <- data.frame(x = sample(1:1000, size = 1000, replace = TRUE),
                   y = sample(1:100, size = 1000, replace = TRUE))
  dt <- data.table(df)
  y_unique <- sort(unique(df$y))
  y_list <- setNames(rep(list(list()), length(y_unique)), y_unique)
})

我得到：

Unit: milliseconds
       expr        min        lq       mean     median        uq        max neval
       base  12.939135  13.22883  13.623098  13.500897  13.95468  14.517167    10
      dplyr  41.517351  42.22595  50.041123  45.199978  61.33194  65.927611    10
 data.table 228.014360 233.98309 248.281965 240.172383 263.39943 287.706941    10
  alternate   3.310031   3.42016   3.745013   3.454537   4.17488   4.497455    10

在我的真实数据上，我大致相同。基数比dplyr快2倍以上，而data.table则很慢。有什么想法吗？

Answer 1

使用连接的一些选项（实际尺寸的任何连接方法大约为13s）

DT <- copy(dt)
setorder(DT, y, x)
DT[DT[.(unique(x)), on=.(x), .(y=first(y)), by=.EACHI], on=.(x,y)]

或者如果原始订购很重要：

DT2 <- copy(dt)
setorder(DT2[, rn := .I], y, x)
dt[sort(DT2[.(unique(x)), on=.(x), rn[y==first(y)], by=.EACHI]$V1)]

，也使用OP中提到的min：

DT0[, rn := .I]
dt[DT0[.(unique(x)), on=.(x), rn[y==min(y)], by=.EACHI][order(V1), V1]]

计时代码：

base <- function() {
    for(y_check in y_unique) {
        y_list[[as.character(y_check)]] <- df[df$y == y_check, ]
        df <- df[!df$x %in% y_list[[as.character(y_check)]]$x, ]
    }
    do.call(rbind, y_list)
} #base

mtd0 <- function() {
    for(y_check in y_unique) {
        y_list[[as.character(y_check)]] <- dt[y == y_check]
        dt <- dt[!x %in% y_list[[as.character(y_check)]]$x]
    }
    out <- rbindlist(y_list)
} #mtd0

join_mtd <- function() {
    setorder(DT, y, x)
    dt[DT[.(unique(x)), on=.(x), .(y=first(y)), by=.EACHI], on=.(x,y)]
} #join_mtd

join_mtd2 <- function() {
    setorder(DT2[, rn := .I], y, x)
    dt[sort(DT2[.(unique(x)), on=.(x), rn[y==first(y)], by=.EACHI]$V1)]
} #join_mtd2

join_mtd3 <- function() {
    DT0[, rn := .I]
    dt[DT0[.(unique(x)), on=.(x), rn[y==min(y)], by=.EACHI][order(V1), V1]]
} #join_mtd3

bench::mark(base(), data.table_0=mtd0(), 
    jm=join_mtd(), jm2=join_mtd2(), jm3=join_mtd2(), check=FALSE)

检查：

baseans <- setDT(base())
data.table_0 <- mtd0()
ordbase <- setorder(copy(baseans), y, x)
jm <- join_mtd()
jm2 <- join_mtd2()
jm3 <- join_mtd3()

identical(baseans, data.table_0)
#[1] TRUE
identical(ordbase, setorder(jm, y, x))
#[1] TRUE
identical(ordbase, setorder(jm2, y, x))
#[1] TRUE
identical(ordbase, setorder(jm3, y, x))
#[1] TRUE

时间：

# A tibble: 5 x 14
  expression        min     mean   median      max `itr/sec` mem_alloc  n_gc n_itr total_time result                   memory                time    gc            
  <chr>        <bch:tm> <bch:tm> <bch:tm> <bch:tm>     <dbl> <bch:byt> <dbl> <int>   <bch:tm> <list>                   <list>                <list>  <list>        
1 base()         38.59s   38.59s   38.59s   38.59s    0.0259    27.3GB   308     1     38.59s <data.frame [632,329 x ~ <Rprofmem [43,206 x ~ <bch:t~ <tibble [1 x ~
2 data.table_0   24.65s   24.65s   24.65s   24.65s    0.0406      14GB   159     1     24.65s <data.table [632,329 x ~ <Rprofmem [72,459 x ~ <bch:t~ <tibble [1 x ~
3 jm              1.28s    1.28s    1.28s    1.28s    0.779       75MB     7     1      1.28s <data.table [632,329 x ~ <Rprofmem [2,418 x 3~ <bch:t~ <tibble [1 x ~
4 jm2             1.44s    1.44s    1.44s    1.44s    0.696     62.5MB     9     1      1.44s <data.table [632,329 x ~ <Rprofmem [1,783 x 3~ <bch:t~ <tibble [1 x ~
5 jm3             1.57s    1.57s    1.57s    1.57s    0.636     62.5MB     9     1      1.57s <data.table [632,329 x ~ <Rprofmem [178 x 3]>  <bch:t~ <tibble [1 x ~

数据：

library(data.table)
library(bench)

set.seed(1L)
nr <- 10e6/10
ni <- 10e3/10
df <- data.frame(x = sample(nr, size = nr, replace = TRUE),
    y = sample(ni, size = nr, replace = TRUE))
dt <- data.table(df)
DT0 <- copy(dt)
DT <- copy(dt)
DT2 <- copy(dt)

y_unique <- sort(unique(df$y))
y_list <- setNames(rep(list(list()), length(y_unique)), y_unique)

大表破坏性过滤的解决方案

1 个答案: