Question

我的问题主要是效率问题。

我有一个模式向量，我希望与向量.bad-guys匹配。

最终结果应该返回与向量的每个元素匹配的模式。第二个标准是，如果向量x的特定元素匹配了许多模式，则返回匹配的第一个模式。

例如，假设模式向量是：

并且向量patterns <- c("[0-9]{2}[a-zA-Z]", "[0-9][a-zA-Z] ", " [a-zA-Z]{3} ")是：

最终结果将是：

x <- c("abc 123ab abc", "abc 123 abc ", "a", "12a ", "1a ")

这是我到目前为止所做的：

customeRExp(patterns, x)
[1] "[0-9]{2}[a-zA-Z]" " [a-zA-Z]{3} "
[3]  NA                "[0-9]{2}[a-zA-Z]"
[5] "[0-9][a-zA-Z] "

哪个正确返回：

customeRExp <- function(pattern, x){
                        m <- matrix(NA, ncol=length(x), nrow=length(pattern))
                        for(i in 1:length(pattern)){
                            m[i, ] <- grepl(pattern[i], x)}
                        indx <- suppressWarnings(apply(m, 2, function(y) min(which(y, TRUE))))
                        pattern[indx]
}

customeRExp(patterns, x)

问题是我的数据集很大，而且模式列表也很大。

有更有效的方法吗？

Answer 1

library(purrr) 
library(stringr)
bool_results <- x %>% map(str_detect, patterns)

返回x的每个元素匹配的模式的值，如下所示

[[1]]
[1]  TRUE FALSE FALSE

[[2]]
[1] FALSE FALSE FALSE

[[3]]
[1] FALSE FALSE FALSE

[[4]]
[1]  TRUE  TRUE FALSE

[[5]]
[1] FALSE  TRUE FALSE

要提取哪些模式与哪个布尔值相关联，您可以

lapply(bool_results, function(x) patterns[which(x == TRUE)])

给出了

[[1]]
[1] "[0-9]{2}[a-zA-Z]"

[[2]]
character(0)

[[3]]
character(0)

[[4]]
[1] "[0-9]{2}[a-zA-Z]" "[0-9][a-zA-Z] "  

[[5]]
[1] "[0-9][a-zA-Z] "

Answer 2

如上所述加速循环的默认方法通常只是在C ++中重写。这是使用Boost Xpressive的快速尝试：

// [[Rcpp::depends(BH)]]
#include <Rcpp.h>
#include <boost/xpressive/xpressive.hpp>

namespace xp = boost::xpressive;

// [[Rcpp::export]]
Rcpp::CharacterVector
first_match(Rcpp::CharacterVector x, Rcpp::CharacterVector re) {
    R_xlen_t nx = x.size(), nre = re.size(), i = 0, j = 0;
    Rcpp::CharacterVector result(nx, NA_STRING);
    std::vector<xp::sregex> vre(nre);

    for ( ; j < nre; j++) {
        vre[j] = xp::sregex::compile(std::string(re[j]));
    }

    for ( ; i < nx; i++) {
        for (j = 0; j < nre; j++) {
            if (xp::regex_search(std::string(x[i]), vre[j])) {
                result[i] = re[j];
                break;
            }
        }
    }

    return result;
}

这种方法的目的是在我们找到匹配的正则表达式后立即通过break保存不必要的计算。

性能提升并不是惊天动地（约40％），但它是对当前功能的改进。以下是使用较大版本的示例数据的测试：

x2 <- rep(x, 5000)
p2 <- rep(patterns, 100)

all.equal(first_match(x2, p2), customeRExp(p2, x2))
#[1] TRUE

microbenchmark::microbenchmark(
    first_match(x2, p2),
    customeRExp(p2, x2),
    times = 50
)
# Unit: seconds
#                 expr      min       lq     mean   median       uq      max neval
#  first_match(x2, p2) 1.743407 1.780649 1.900954 1.836840 1.931783 2.544041    50
#  customeRExp(p2, x2) 2.368621 2.459748 2.681101 2.566717 2.824887 3.553025    50

另一种选择是研究使用stringi包，它通常比基本R优越得多。

Answer 3

在概念上类似于nrussell的方法，我们可以丢弃从以下grep s匹配的“x”元素：

ff = function(x, p)
{
    ans = rep_len(NA_integer_, length(x))
    for(i in seq_along(p)) {
        nas = which(is.na(ans))
        ans[nas[grepl(p[i], x[nas])]] = i
    }
    p[ans]    
}
ff(x, patterns)
#[1] "[0-9]{2}[a-zA-Z]" " [a-zA-Z]{3} "    NA                 "[0-9]{2}[a-zA-Z]" "[0-9][a-zA-Z] "

每次迭代中的子集“x”可能比看起来更昂贵，特别是如果子集最终忽略了少量“x”的元素，其中 - 在这种情况下 - 我们最终复制了一个大的“x”（少数元素更短）但仍然grep大“x”。但是，如果（1）大部分“x”确实具有匹配，并且（2）如果“x”的重要部分在每个（并且可能是，早期）迭代中匹配，则可以更有效。使用nrussell的例子，我们有这样一种情况，实际上，“x”的许多元素在“模式”的每次迭代中被丢弃：

microbenchmark::microbenchmark(ff(x2, p2), first_match(x2, p2), customeRExp(p2, x2), times = 25)
#Unit: milliseconds
                expr       min        lq      mean    median        uq       max neval cld
#          ff(x2, p2)  299.7235  306.0875  312.9303  308.0544  320.6126  333.9144    25 a  
# first_match(x2, p2) 1581.4085 1606.3984 1642.4471 1643.0671 1661.9499 1734.9066    25  b 
# customeRExp(p2, x2) 3464.4267 3515.7499 3623.0920 3611.0809 3694.3931 3849.0399    25   c

all.equal(ff(x2, p2), customeRExp(p2, x2))
#[1] TRUE
all.equal(ff(x2, p2), first_match(x2, p2))
#[1] TRUE

nrussell的方法仍然可以完成所需的最小工作，即使在边缘情况下（其他两个将增加比必要的计算时间更多）。

矢量化模式匹配返回R中的模式

3 个答案: