R: Search for string SIMILAR and return with conditional symbol

My df has following entries:

A
xxx
xxx
xxx1
xx1x
yyyy
gggg

I want to add symbols to a column B of my df based on the similarity of column A, based on the following conditions.

• I set the threshold as = or > 75% similar.

• Column A is so开发者_JS百科rted already. So, checking similarity for the ONE above is needed.

• If upper one is similar, the symbol will be copied from the upper one's column B.

• If upper one is dissimilar, the symbol will be copied from the same row's column A.

For instance, as row 1 and row 2 are the same. Their symbol is same as column A. As row 3 is (3 letters out of 4 letters are with same letters and in the same sequence) 75% similar to row1 and row2. its sybmol in column B will be copied from the upper one, i.e. xxx. As xx1x (row4) is only 2 out of 4 letters similar to row3, it will just use its own symbol, i.e. xx1x. Since yyyy and gggg are totally different, they will keep their own sybmol as in column A.

Thus, my final result should be like this:

A      B
xxx    xxx
xxx    xxx
xxx1   xxx
xx1x   xx1x
yyyy   yyyy
gggg   gggg

I figure out this similarity % by guess (it don't need to be use if there are formal method for string similarity search), if there are any formal method for checking string similarity in R, it could be nice to use.

Could you mind to instruct how to add this symbol column efficiently with R?

Set up data:

x=c("xxx", "xxx", "xxx1", "xx1x", "yyyy", "gggg")

The code:

same <- sapply(seq(length(x)-1), 
  function(i)any(agrep(x[i+1], x[1], max.distance=0.25)))
ex <- embed(x, 2)
cbind(A=x, B=c(x[1], ifelse(same, ex[, 2], ex[, 1])))

The result:

     A      B     
[1,] "xxx"  "xxx" 
[2,] "xxx"  "xxx" 
[3,] "xxx1" "xxx" 
[4,] "xx1x" "xxx1"
[5,] "yyyy" "yyyy"
[6,] "gggg" "gggg"

Why does it work?

Some key concepts and really helpful functions:

Firstly, agrep provides a test for how similar strings are, using the Levenshtein edit distance, which effectively counts the number of individual character changes needed to transform one string to another. The parameter max.distance=0.25 means that 25% of the pattern string is allowed to be different.

For example, test whether any of the original strings are similar to "xxx": this returns 1:4:

agrep("xxx", x, max.distance=0.25)
[1] 1 2 3 4

Secondly, embed provides a useful way of testing lagged variables. For example, embed(x, 2) turnsx` into a lagged array. This makes it easy to compare x[1] to x[2] since they are now on the same row in the array:

embed(x, 2)
     [,1]   [,2]  
[1,] "xxx"  "xxx" 
[2,] "xxx1" "xxx" 
[3,] "xx1x" "xxx1"
[4,] "yyyy" "xx1x"
[5,] "gggg" "yyyy"

Finally, I use cbind and vector subsetting to stitch together the original vector and the new vector.

To make this work on a data frame rather than a vector, I turned the code into a function as follows:

df <- data.frame(A=c("xxx", "xxx", "xxx1", "xx1x", "yyyy", "gggg"))

f <- function(x){
  x <- as.vector(x)
  same <- sapply(seq(length(x)-1), 
      function(i)any(agrep(x[i+1], x[1], max.distance=0.25)))
  ex <- embed(x, 2)
  c(x[1], ifelse(same, ex[, 2], ex[, 1]))
}
df$B <- f(df$A)
df

     A    B
1  xxx  xxx
2  xxx  xxx
3 xxx1  xxx
4 xx1x xxx1
5 yyyy yyyy
6 gggg gggg

Here's a more 'basic' solution (edited to fix some problems raised in the comments):

dat <- data.frame(A=c('xxx','xxx','xxx1','xx1x','yyyy','gggg'))
dat$B <- rep(NA,nrow(dat))

tmp <- strsplit(as.character(dat$A),"")
dat$B[1] <- dat$A[1]
for (i in 2:length(tmp)){
    n <- min(length(tmp[[i]]),length(tmp[[i-1]]))
    x <- sum(tmp[[i]][1:n] == tmp[[i-1]][1:n]) / length(tmp[[i]])
    if (x >= 0.75){
        dat$B[i] <- paste(tmp[[i-1]],collapse="")
    }
    else{ dat$B[i] <- paste(tmp[[i]],collapse="")}
}