在巨大的数据帧中在 R 中执行 CountIf超过 2000 万行 这基本上就是@Gregor-Thomas 在评论中给出的答案

如何解决在巨大的数据帧中在 R 中执行 CountIf超过 2000 万行 这基本上就是@Gregor-Thomas 在评论中给出的答案

我有一个包含 600 个代码（就像下面的代码）的数据框来匹配一个 2800 万行的数据框。我想查看第一个数据帧中的每个代码在第二个数据帧中出现的次数（两者都有一个包含匹配数据帧的列）。它基本上是一个 Countif（就像一个 Excel）， 请参阅我有数据帧 1，示例如下：数据帧 1 中的代码是唯一的，600 个唯一代码，在数据帧 2 中它们会重复。

| Code 4 Dig| Name           |
| --------  | -------------- |
| 0111      | Name 1         |
| 0894      | Name 2         |
| 7895      | Name 3         |
| 8412      | Name 4         |

2800万行的header有点像这样（ID与我无关，只是想算一下第一个数据的code出现了多少次）：

| Code 4 Dig| ID             |
| --------  | -------------- |
| 0894      | ID152           |
| 0894      | ID 25           |
| 0894      | ID10            |
| 7895      | ID 125          |

非常感谢！！

解决方法

这是一个 dplyr 方法。在我的电脑上，在 20M 行上运行大约需要一秒钟，在 200M 行上运行需要 4-7 秒。

library(dplyr)

big_table %>%                # take the big table
  count(code) %>%            # count how many appearances of each code
  left_join(lookup_table)    # join those counts to orig table to get `Name`
                             # note: any code not in lookup_table would show NA for `Name`

源数据：

lookup_table <- data.frame(code = 1:600,names = paste("Name",1:600))

big_table <- lookup_table %>%
  mutate(times = rpois(n(),34000)) %>%     # random times for each row  
  uncount(times) %>%                        # copy row this many times
  slice_sample(n = nrow(.))                 # to shuffle

,

这基本上就是@Gregor-Thomas 在评论中给出的答案

没有发布您自己解决问题的尝试，我只能猜测该解决方案是否适合您的用例。

# Load libraries
library(tidyverse)
library(data.table)

# Create example data
df1 <- tibble::tribble(
~"Code 4 Dig",~"Name","0111","Name 1","0894","Name 2","7895","Name 3","8412","Name 4"
  )

df2 <- tibble::tribble(
~"Code 4 Dig",~"ID","ID152","ID 25","ID10","ID 125"
  )

# Convert example dataframes to data.tables
setDT(df1)
setDT(df2)

# Set keys for joining
setkey(df1,`Code 4 Dig`)
setkey(df2,`Code 4 Dig`)

# Join the tables
Result <- df1[df2,nomatch=0]

# Summarise to get counts
counts <- Result[,.(counts = .N),by = `Code 4 Dig`]
counts
#>    Code 4 Dig counts
#> 1:       0894      3
#> 2:       7895      1

--

而且，为了显示它适用于 600 个数字 (df1) 和 2800 万行 (df2)：

# Load libraries
library(tidyverse)
library(data.table)

# Create example data
pick.nums <- function(n) {
  floor(10^(sample(3:8,n,replace = TRUE))*runif(n))
}

pick.nums(5)
#> [1] 52198541  8972430    98870      720  4013067

df1 <- data.frame("Code 4 Dig" = c(pick.nums(600)),"Name" = paste("name_",pick.nums(600),sep = ""),check.names = FALSE)

df2 <- data.frame("Code 4 Dig" = c(pick.nums(28000000)),"ID" = paste("ID_",c(pick.nums(28000000)),check.names = FALSE)

# Convert example dataframes to data.tables
setDT(df1)
setDT(df2)

# Set keys for joining
setkey(df1,by = `Code 4 Dig`]
counts
#>      Code 4 Dig counts
#>   1:          9   5166
#>   2:         13   5122
#>   3:         24   5193
#>   4:         25   5198
#>   5:         30   5227
#>  ---                  
#> 437:    8841332      1
#> 438:    8966071      2
#> 439:    8969648      1
#> 440:    9040953      1
#> 441:    9591721      1

,

28M 行对于 R 来说并不是很大。可以使用基础 R、dplyr 或 data.table 来实现。

我将借用 jared_mamrot 的示例，并在 dplyr 和 dtplyr（又名更简单的 data.table）中显示速度。

下面的 dplyr 代码大约需要 6 秒才能运行。坦率地说，如果这是一次性脚本或每月一次的脚本，那么我不会费心加快速度。如果您正在为客户按需运行此程序并且需要在不到一秒的时间内获得结果，请继续使用 dtplyr 或 data.table 答案。

library(tidyverse)

pick.nums <- function(n) {
  floor(10^(sample(3:8,replace = TRUE))*runif(n))
}

df1 <- data.frame("Code 4 Dig" = c(pick.nums(600)),check.names = FALSE)

microbenchmark::microbenchmark({
  result <- df1 %>% 
    inner_join(df2) %>% 
    group_by(`Code 4 Dig`) %>%
    summarise(count = n())
},times = 3)
# Unit: seconds
#      min       lq     mean   median       uq      max neval
# 4.569945 5.466638 5.986419 6.363332 6.694656 7.025981     3

str(result)
tibble [437 x 2] (S3: tbl_df/tbl/data.frame)
$ Code 4 Dig: num [1:437] 7 9 38 59 79 88 91 100 103 105 ...
$ count     : int [1:437] 10556 5207 5175 5179 5145 5162 5248 5214 5228 5282 ...

如果你需要它运行得非常快，那么 dtplyr 方法可以在 0.035 秒内完成连接和计数。但是，在进行联接之前，输入数据需要 1.9 秒的时间。所以它仍然需要几秒钟。

library(dtplyr)

microbenchmark::microbenchmark(
dt1 <- df1 %>% lazy_dt(key_by = `Code 4 Dig`),dt2 <- df2 %>% lazy_dt(key_by = `Code 4 Dig`),times = 3)
# Unit: milliseconds
#         min         lq        mean    median          uq         max
#    1.039201    1.17975    1.575267    1.3203    1.843301    2.366301
# 1708.594001 1737.07515 1952.342434 1765.5563 2074.216651 2382.877001


microbenchmark::microbenchmark({
  resultdt <- dt1 %>% 
    inner_join(dt2) %>% 
    group_by(`Code 4 Dig`) %>%
    summarise(count = n()) %>%
    as_tibble()
},times = 3)
# Unit: milliseconds
# min      lq    mean  median       uq     max neval
# 29.4548 32.8968 35.3977 36.3388 38.36915 40.3995     3

str(resultdt)
tibble [437 x 2] (S3: tbl_df/tbl/data.frame)
$ Code 4 Dig: num [1:437] 7 9 38 59 79 88 91 100 103 105 ...
$ count     : int [1:437] 10556 5207 5175 5179 5145 5162 5248 5214 5228 5282 ...