优化 R 循环需要 18 小时运行

Question

我有一个 R 代码可以工作并且可以做我想做的事情，但是运行需要很长时间。这是对代码的作用和代码本身的解释。

我有一个包含街道地址（字符串）的 200000 行向量：数据。示例：

> data[150000,]
                              address 
"15 rue andre lalande residence marguerite yourcenar 91000 evry france"

我有一个 131x2 字符串元素矩阵，它是 5grams（单词的一部分）和 NGrams 袋子的 id（5Grams 袋子的例子：["stack"，"tacko"， "ackov", "ckover", ",overf", ... ]) : list_ngrams

list_ngrams 示例：

  idSac ngram
1     4 stree
2     4 tree_ 
3     4 _stre
4     4 treet
5     5 avenu
6     5 _aven
7     5 venue
8     5 enue_

我还有一个用 0 初始化的 200000x31 数值矩阵：idv_x_bags

我总共有 131 个 5 克和 31 袋 5 克。

我想循环字符串地址并检查它是否包含我列表中的 n-gram 之一。如果是，我将一个放在相应的列中，代表包含 5 克的袋子的 ID。示例：

在此地址：“15 rue andre lalande residence marguerite yourcenar 91000 evry france”。 "residence" 这个词存在于包 ["resid","eside","dence",...] 中，id 是 5。所以我要在列中输入 1称为 5。因此对应的行 "idv_x_bags" 矩阵将如下所示：

> idv_x_sacs[150000,]
  4   5   6   8  10  12  13  15  17  18  22  26  29  34  35  36  42  43  45  46  47  48  52  55  81  82 108 114 119 122 123 
  0   1   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0

这是执行以下操作的代码：

idv_x_sacs <- matrix(rep(0,nrow(data)*31),nrow=nrow(data),ncol=31)
colnames(idv_x_sacs) <- as.vector(sqldf("select distinct idSac from list_ngrams order by idSac"))$idSac

    for(i in 1:nrow(idv_x_bags)) 
    {
        for(ngram in list_ngrams$ngram)
      {
        if(grepl(ngram,data[i,])==TRUE)
        {
          idSac <- sqldf(sprintf("select idSac from list_ngramswhere ngram='%s'",ngram))[[1]]
          idv_x_bags[i,as.character(idSac)] <- 1
        }
      }
    }

代码完美地完成了我的目标，但它需要大约 18 个小时，这是巨大的。我尝试使用 Rcpp 库用 C++ 重新编码它，但我遇到了很多问题。我尝试使用 apply 对其进行重新编码，但我做不到。这是我所做的：

apply(cbind(data,1:nrow(data),1,function(x){
  apply(list_ngrams,1,function(y){
   if(grepl(y[2],x[1])==TRUE){idv_x_bags[x[2],str_trim(as.character(y[1]))]<-1} 
  })
})

我需要一些帮助来使用 apply 或比当前方法运行更快的其他方法对我的循环进行编码。非常感谢你。

Answer 1

逐步检查这个和运行这个简单的例子，看看它是如何工作的。我的 N-Grams 没有多大意义，但它也适用于实际 N_Grams。

 library(dplyr)
 library(reshape2)

 # your example dataset
 dt_sen = data.frame(sen = c("this is a good thing", "this is bad"), stringsAsFactors = F)
 dt_ngr = data.frame(id_ngr = c(2,2,2,3,3,3),
                     ngr = c("th","go","tt","drf","ytu","bad"), stringsAsFactors = F)

 # sentence dataset
 dt_sen

sen
    1 this is a good thing
    2          this is bad


 #ngrams dataset
 dt_ngr

  id_ngr ngr
1      2  th
2      2  go
3      2  tt
4      3 drf
5      3 ytu
6      3 bad



 # create table of matches
 expand.grid(unique(dt_sen$sen), unique(dt_ngr$id_ngr)) %>%
   data.frame() %>%
   rename(sen = Var1,
          id_ngr = Var2) %>%
   left_join(dt_ngr, by = "id_ngr") %>%
   group_by(sen, id_ngr,ngr) %>%
   do(data.frame(match = grepl(.$ngr,.$sen))) %>%
   group_by(sen,id_ngr) %>%
   summarise(sum_success = sum(match)) %>%
   mutate(match = ifelse(sum_success > 0,1,0)) -> dt_full

 dt_full
Source: local data frame [4 x 4]
Groups: sen

                   sen id_ngr sum_success match
1 this is a good thing      2           2     1
2 this is a good thing      3           0     0
3          this is bad      2           1     1
4          this is bad      3           1     1


 # reshape table
 dt_full %>% dcast(., sen~id_ngr, value.var = "match")
                   sen 2 3
1 this is a good thing 1 0
2          this is bad 1 1

优化 R 循环需要 18 小时运行

Optimization of an R loop taking 18 hours to run

r

apply

rcpp

n-gram

优化 R 循环需要 18 小时 运行

Optimization of an R loop taking 18 hours to run

r

apply

rcpp

n-gram

优化 R 循环需要 18 小时运行