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

【问题标题】：Solution to destructive filtering of a large table大表破坏性过滤的解决方案
【发布时间】：2019-07-06 01:18:04
【问题描述】：

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

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

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

这是一个合理的可重现示例......

（编辑：我意识到我正在做的事情可以通过组过滤器来实现。留下一个更新的可重现示例，其中包含以下 cmets 和我更新的解决方案的一些调整。-请注意，原始文件不包括 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 是……慢。有什么想法吗？

【问题讨论】：

如果您担心速度，我强烈建议您进行大规模测试，或者至少更接近规模。在许多情况下，data.table 在小范围内较慢（当差异以毫秒为单位时）而在大范围内较快（当差异以秒或分钟为单位时——即，它很重要）。
data.table 也可以是特定于上下文的。此基准测试中的大部分 data.table 时间可能与 data.table 转换有关。但是，如果您要做的不仅仅是这一转换，那么转换为 data.table 将加快您的所有操作。（如果您是从文件中读取数据，使用 data.table::fread 将比任何其他导入方法更快地生成 data.table 将生成数据框，因此整体上包含 data.table() 可能没有意义基准
另外，请参阅 ?split 和 ?split.data.table 和 ?dplyr::group_split。 This question is highly relevant to you.
嗯..也许我误解了迭代的本质？您是否希望过滤后的 df 最后包含任何内容？还是该点为下一次迭代过滤它？
除了@Gregor 所说的，强制不仅在data.frame 到data.table 的转换过程中，而且在搜索过程中都是开销，因为你正在做as.character(y_unique) 然后用它来搜索整数。您应该将其保留为整数并使用y_list[[as.character(y_check)]]。此外，data.table 可能不适合这种场景，请查看this question and its answer。

标签： r dplyr data.table

【解决方案1】：

使用连接的一些选项（实际尺寸的任何连接方法大约需要 13 秒）：

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)

【讨论】：