慢速循环R，如何使其更快？

Question

I have a list of e-mails and I would like to compare patterns (similarity) among the rows using longest common substring to compare them.

data is a data frame with e-mails:

           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   ...

This is my code:

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
        }
      }
    }

and the "outupt" is a data frame showing the similar e-mails.

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

I have 300k e-mails, this will take forever...

Is there a better way to do it?

Thanks!

Answer 1

Here's an attempt:

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)

Basically you create a string distance pairwise matrix, wrap it in a data frame, replace all string distances that are equal or less than 3 with the corresponding V1 value and the rest with NA . Then, you remove the now unnecessary V1 column, gather() the data in a tidy format and remove NA s.

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 = ".", "@"))

Which gives:

#      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