如何将与data.frame单元格一起使用的函数应用于data.frame列

Question

This question is the adaptation of a prior question I felt I asked in an unclear way. I am checking whether columns V1 and V2 have common codes by row. Codes are separated by a forward slash "/". The function below should take one cell from V1 and one cell from V2 on the same row and should transform them into vectors. Each element of a vector is one code. Then the function should check whether the two vectors obtained have elements in common. These elements initially are 4-digit codes. If there is any 4-digit code that matches between the two vectors, the function should return 4. If there are no elements in common, the function should reduce the number of digits of each code and then check again. Every time that the function reduces the number of digits, it also reduces the score it returns at the end. I would like the value returned by the function to be written in a column of my choice.

This is my starting condition

structure(list(ID = c(2630611040, 2696102020, 2696526020), V1 = c("7371/3728", 
"2834/2833/2836/5122/8731", "3533/3541/3545/5084"), V2 = c("7379", 
"3841", "3533/3532/3531/1389/8711")), .Names = c("ID", "V1", 
"V2"), class = "data.frame", row.names = c(NA, 3L))

         ID                       V1                       V2
1 2630611040                7371/3728                     7379
2 2696102020 2834/2833/2836/5122/8731                     3841
3 2696526020      3533/3541/3545/5084 3533/3532/3531/1389/8711

And I would like to get this

          ID                       V1                       V2   V3
1 2630611040                7371/3728                     7379   3
2 2696102020 2834/2833/2836/5122/8731                     3841   0
3 2696526020      3533/3541/3545/5084 3533/3532/3531/1389/8711   4

My function is this

coderelat<-function(a, b){

a<-unique(as.integer(unlist(str_split(a, "/")))) #Transforming cells into vectors of codes
b<-unique(as.integer(unlist(str_split(b, "/"))))

a<-a[!is.na(a)]
b<-b[!is.na(b)]

if (length(a)==0 | length(b)==0) { # Check that both cells are not empty

  ir=NA     
  return(ir)

  } else {


for (i in 3:1){

    diff<-intersect(a, b) # See how many products the shops have in common

            if (length(diff)!=0) { #As you find a commonality, give ir the corresponding scoring

              ir=i+1
              break

            } else if (i==1 & length(diff)==0) { #If in the last cycle, there is still no commonality put ir=0

              ir=0
              break

            } else { # If there is no commonality and you are not in the last cycle, reduce the nr. of digits and re-check commonality again

              a<- unique(as.integer(substr(as.character(a), 1, i)))
              b<- unique(as.integer(substr(as.character(b), 1, i)))

        }

    }     
  }
return(ir)
}

The function works when I manually supply single cells. But it doesn't work when I write soemthing like this:

df$V4<-coderelat(df$V1, df$V2)

I really appreciate any help because I don't know anymore how to make this work.

Many thanks in advance. Riccardo

Answer 1

Here's a solution using data.tables.

get.match <-function(a,b) {
  A <- unique(strsplit(a,"/",fixed=TRUE)[[1]])
  B <- unique(strsplit(b,"/",fixed=TRUE)[[1]])
  for (i in 4:1) if(length(intersect(substr(A,1,i),substr(B,1,i)))>0) return(i)
  return(0L)
}
library(data.table)
setDT(df)[,V3:=get.match(V1,V2),by=ID]
df
#            ID                       V1                       V2 V3
# 1: 2630611040                7371/3728                     7379  3
# 2: 2696102020 2834/2833/2836/5122/8731                     3841  0
# 3: 2696526020      3533/3541/3545/5084 3533/3532/3531/1389/8711  4