慢循环R,如何让它更快?

时间:2015-05-19 00:02:36

标签: r for-loop pattern-matching nested-loops reshape

我有一个电子邮件列表,我想比较使用最长公共子字符串的行之间的模式(相似性)来比较它们。

数据是带有电子邮件的数据框:

           V1
1   "01003@163.com"
2   "cloud@coldmail.com"
3   "den_smukk_kiilar@hotmail.com"
4   "Esteban.verduzco@gmail.com"
5   "freiheitmensch@gmail.com"
6   "mitsoanastos@yahoo.com"
7   "ahmedsir744@yahoo.com" 
8   ...

这是我的代码:

library(stringdist)

for(i in 1:nrow(data)) {
      sample <- data[i,]
      for(j in (i+1):nrow(data)) if(i+1 <= nrow(data)) {
        if((stringdist(data[j,],sample,method='lcs'))<=3) {  #number of different characteres 3 (123.456 == 123.321)
          duplicate <- data[j,]
          email1 = as.character(data[i,])
          email2 = as.character(data[j,])
          pair <- cbind(email1, email2)
          output3[dfrow, ] <- pair
          dfrow <- dfrow + 1
        }
      }
    }

和&#34; outupt&#34;是一个显示类似电子邮件的数据框。

         email1          email2
1   "01079@163.com" "01069@163.com"

我有300k的电子邮件,这将永远......

有更好的方法吗?

谢谢!

1 个答案:

答案 0 :(得分:3)

这是一次尝试:

library(stringdist)
library(stringi)
library(dplyr)
library(tidyr)

# Hypothetical data frame     
data <- data.frame(V1 = paste0(stri_rand_strings(5, 3, "[a-z]"), 
                               "@", stri_rand_strings(5, 2, "[a-z]"), ".com"), 
                   stringsAsFactors = FALSE)

基本上,您创建一个字符串距离成对矩阵,将其包装在数据框中,用相应的V1值替换所有等于或小于3的字符串距离,其余的用NA替换。然后,您以整齐的格式删除现在不必要的V1列,gather()数据并删除NA

data %>%
  data.frame(stringdistmatrix(.$V1, .$V1, useNames = TRUE, method = "lcs"), 
             row.names = NULL) %>%

#          V1 wnw.fa.com kty.hm.com brs.wk.com pib.uo.com ryu.iq.com
#1 wnw@fa.com          0         10         10         10         10
#2 kty@hm.com         10          0         10         10          8
#3 brs@wk.com         10         10          0          8          8
#4 pib@uo.com         10         10          8          0         10
#5 ryu@iq.com         10          8          8         10          0

  # here you need to replace '8' by '3' for your example
  mutate_each(funs(ifelse(. <= 8 & . != 0, V1, NA)), -V1) %>% 

#          V1 wnw.fa.com kty.hm.com brs.wk.com pib.uo.com ryu.iq.com
#1 wnw@fa.com         NA       <NA>       <NA>       <NA>       <NA>
#2 kty@hm.com         NA       <NA>       <NA>       <NA> kty@hm.com
#3 brs@wk.com         NA       <NA>       <NA> brs@wk.com brs@wk.com
#4 pib@uo.com         NA       <NA> pib@uo.com       <NA>       <NA>
#5 ryu@iq.com         NA ryu@iq.com ryu@iq.com       <NA>       <NA>

  select(-V1) %>%
  gather(email1, email2) %>%
  na.omit() %>%
  mutate(email1 = stri_replace_first(email1, fixed = ".", "@"))

给出了:

#      email1     email2
#1 kty@hm.com ryu@iq.com
#2 brs@wk.com pib@uo.com
#3 brs@wk.com ryu@iq.com
#4 pib@uo.com brs@wk.com
#5 ryu@iq.com kty@hm.com
#6 ryu@iq.com brs@wk.com