在多个列中搜索以多个字符串中的任何一个开头的列；得到计数答案

【问题标题】：Search multiple columns for those which start with any of many strings; get counts在多个列中搜索以多个字符串中的任何一个开头的列；得到计数
【发布时间】：2018-02-19 02:41:00
【问题描述】：

我有一个包含 2M 观察的数据集。我需要搜索最多 50 个字符列来计算（然后过滤）哪些观察以最多 20 个字符串中的任何一个开头。

我编写了代码，它返回每个字符串被找到的频率；但它太慢了。在 100k 观察（9 列，33 个搜索字符串）上运行此程序需要 2 分钟，并且似乎是线性扩展的（对于完整数据集意味着 ≈30 分钟）。我可以在几秒钟内完成 SAS，并且在配备 SSD 的快速笔记本电脑上运行，所以我假设我的代码是问题所在（不是机器或问题本身）。

set.seed(42)
df_to_search <- cbind.data.frame(
   "a"=replicate(1e5,paste0(sample(c(LETTERS,1:10),5,replace = T),collapse = "")),
   "b"=replicate(1e5,paste0(sample(c(LETTERS,1:10),5,replace = T),collapse = "")),
   "c"=replicate(1e5,paste0(sample(c(LETTERS,1:10),5,replace = T),collapse = "")),
   "d"=replicate(1e5,paste0(sample(c(LETTERS,1:10),5,replace = T),collapse = "")),
   "e"=replicate(1e5,paste0(sample(c(LETTERS,1:10),5,replace = T),collapse = "")))

search_strings <- c("AB","BC","CD","DE","EF","G6","F8","H1","I9","J7") %>% paste0("^",.) %>% as.vector()

sapply(search_strings, function(y)
  apply(df_to_search, 1, function(x) {
    str_detect(x, y)
  })) %>% colSums()

此代码产生以下结果：

^AB ^BC ^CD ^DE ^EF ^G6 ^F8 ^H1 ^I9 ^J7 
394 392 387 389 359 417 397 780 378 382

注意：我将搜索字符串转换为向量，以便将其传递给apply，这将速度提高了 3 倍（与嵌套的 sapply 相比）。我尝试过嵌套的 apply 语句，但它没有导致加速。我还将^ 作为正则表达式语法的一部分添加到搜索字符串之前，以将搜索限制为字符串的开头。我对完全不同的方法持开放态度，但我必须能够使用多个字符串、多列搜索字符串的开头，并返回每个搜索字符串的计数。

编辑/更新 这些解决方案比我的要快得多。谢谢！不幸的是，我的示例搜索字符串（无意中）具有误导性。道歉。我的实际搜索字符串的长度不同，有时是所有数字，从 2 到 5 个字符不等。我应该使用类似的东西：

search_strings <- c("64651","BC","654","DEF","EF","G6","F8","25","I9","J7")

我想不出一种获得最快代码的方法：table(substr(unlist...)) 可以轻松处理不同的搜索字符串长度，但 colSums(vapply(...{vapply...})) 工作得很好。

当然欢迎任何有关此新信息的建议，但否则我认为这是可以回答的。再次感谢。

【问题讨论】：

标签： r regex count

【解决方案1】：

更新

只需在substring() 上使用table。它易于阅读，而且速度很快。

starts <- c("AB","BC","CD","DE","EF","G6","F8","H1","I9","J7")
table(substr(unlist(df_to_search, use.names = FALSE), 1, 2))[starts]
## 
##  AB  BC  CD  DE  EF  G6  F8  H1  I9  J7 
## 394 392 387 389 359 417 397 780 378 382 

system.time(table(substr(unlist(df_to_search, use.names = FALSE), 1, 2))[starts])
##    user  system elapsed 
##   0.105   0.000   0.105

如果您需要寻找更好的时机，您可以尝试tabulate 而不是table。这样的事情应该可以工作：

x <- factor(substr(unlist(df_to_search, use.names = FALSE), 1, 2))
setNames(tabulate(x), levels(x))[starts]

原答案

我会做以下事情：

将data.frame 值从factor 转换为character。
使用 R 3.3 中引入的startsWith()

性能相当快。

# vector of starts you want to check
starts <- c("AB","BC","CD","DE","EF","G6","F8","H1","I9","J7")

# converting the data.frame to character
df_to_search[] <- lapply(df_to_search, as.character)

# searching and tabulating
colSums(vapply(starts, function(x) {
  vapply(df_to_search, function(y) sum(startsWith(y, x)), integer(1L))
}, integer(ncol(df_to_search))))
#  AB  BC  CD  DE  EF  G6  F8  H1  I9  J7 
# 394 392 387 389 359 417 397 780 378 382

以下是一些时间安排：

starts <- c("AB","BC","CD","DE","EF","G6","F8","H1","I9","J7")
df_to_search[] <- lapply(df_to_search, as.character)
myfun <- function() {
  colSums(vapply(starts, function(x) {
    vapply(df_to_search, function(y) sum(startsWith(y, x)), integer(1L))
  }, integer(ncol(df_to_search))))
} 
#  user  system elapsed 
# 0.199   0.000   0.199 

myfun_unlist <- function() {
  temp <- unlist(df_to_search, use.names = FALSE)
  vapply(starts, function(x) sum(startsWith(temp, x)), integer(1L))
}
#  user  system elapsed 
# 0.245   0.000   0.245 

cPakfun <- function() {
  sapply(search_strings, function(i) sum(stringr::str_count(unlist(df_to_search), i)))
}
#  user  system elapsed 
# 5.614   0.000   5.613 

cPakfun2 <- function() {
  edited <- paste0("--", starts)
  vec_to_search <- paste0(paste0("--", unlist(df_to_search)), collapse="")
  result <- stringr::str_count(vec_to_search, edited)
  names(result) <- starts
  return(result)
}
#  user  system elapsed 
# 0.902   0.000   0.901 

opfun <- function() {
  sapply(search_strings, function(y)
    apply(df_to_search, 1, function(x) {
      str_detect(x, y)
    })) %>% colSums()
}
#   user  system elapsed 
# 44.988   0.000  45.078

基准测试，以防这是您经常做的事情，而不仅仅是一次性的事情：

library(microbenchmark)

## Add tabulate to the options
myfun_tabulate <- function() {
  df_to_search[] <- lapply(df_to_search, as.character)
  x <- factor(substr(unlist(df_to_search, use.names = FALSE), 1, 2))
  setNames(tabulate(x), levels(x))[starts]
}

res <- microbenchmark(myfun_tabulate(), myfun_table(), myfun(), myfun_unlist(), cPakfun2())
# Unit: milliseconds
#              expr       min       lq     mean   median       uq       max neval
#  myfun_tabulate()  90.19794 100.2941 120.5411 102.7271 153.4527  238.6175   100
#     myfun_table()  96.87556 110.1965 146.5356 154.3941 168.2660  562.4599   100
#           myfun() 125.68799 127.8053 162.0679 130.0665 182.7757  577.3027   100
#    myfun_unlist() 136.92772 138.4104 170.4002 140.0188 198.8845  613.7919   100
#        cPakfun2() 859.22835 911.5291 940.6695 935.6335 955.3801 1154.5395   100

autoplot(res, log = FALSE)

【讨论】：

【解决方案2】：

由于您并不真正关心按列计数，因此一个技巧是 unlist() 您的 data.frame。这将产生一个包含所有值的向量。然后在这个向量上，您可以使用stringr::str_count 来计算模式是否出现。然后sum计数的结果。简而言之，所有“硬”步骤都是矢量化的，您只需“循环”search_strings 中的条目即可。

sapply(search_strings, function(i) sum(stringr::str_count(unlist(df_to_search), i)))

# ^AB ^BC ^CD ^DE ^EF ^G6 ^F8 ^H1 ^I9 ^J7 
# 394 392 387 389 359 417 397 780 378 382

已编辑完全矢量化方法 - 比 sapply 快约 4-5 倍

您可以通过将所有值转换为单个字符串来完全矢量化，每个条目由一个虚拟字符分隔，例如--。

search_strings <- c("AB","BC","CD","DE","EF","G6","F8","H1","I9","J7")
vec2 <- function() {
    edited <- paste0("--", search_strings)
    vec_to_search <- paste0(paste0("--", unlist(df_to_search)), collapse="")
    result <- stringr::str_count(vec_to_search, edited)
    names(result) <- search_strings
    return(result)
}
vec2()
 # AB  BC  CD  DE  EF  G6  F8  H1  I9  J7 
# 394 392 387 389 359 417 397 780 378 382

【讨论】：