R - penambangan teks pada beberapa kolom dengan jarak levenshtein

Saya ingin membandingkan string teks beberapa kali di beberapa kolom, melalui jarak levenshtein (fungsi adist di R). Yang ingin saya lakukan adalah membandingkan source1$name dengan source2$name. Jika tidak ada kecocokan (yaitu jika NA dikembalikan untuk match.s1.s2$s2.i maka lakukan fungsi yang sama menggunakan alamat (source1$address dan source2$address) yang tercantum dalam dua bingkai data. Pada dasarnya saya mencari cara untuk menyaring kecocokan saya di beberapa bidang. Contoh ada di bawah.

name <- c("holiday inn", "geico", "zgf", "morton phillips")
address <- c("400 lafayette pl tupelo ms", "227 geico plaza chevy chase md", 
         "811 quincy st washington dc", "1911 1st st rockville md")

source1 <- data.frame(name, address)

name <- c("williams sonoma", "mamas bbq", "davis polk", "hop a long diner",
      "joes crag shack", "mike lowry place", "holiday inn", "zummer")

name2 <- c(NA, NA, NA, NA, NA, NA, "hi express", "zummer gunsul frasca")
address <- c("2 reads way new castle de", "248 w 4th st newark de",
         "1100 21st st nw washington dc", "1804 w 5th st wilmington de",
         "1208 kenwood parkway holdridge nb", "4203 ocean drive miami fl",
         "400 lafayette pl tupelo ms", "811 quincy st washington dc")
source2 <- data.frame(name, name2, address)

removeSPE <- function(x) gsub("[[:punct:]]", " ", x)

cleanup <- function(x){
x <- as.character(x) # convert to character
x <- tolower(x) # make all lowercase
x <- sapply(x, removeSPE) # remove special characters
x <- trimws(x) # remove extra white space
#x <- sapply(x, removeStopWords) # remove stopwords, defined above
#x <- trimws(x) # since stopwords have been removed, there is extra white space left, this removes it
x <- gsub("^. .$", "", x)
return(x)
}

source1$name <- cleanup(source1$name)
source2$name <- cleanup(source2$name)
source2$name2 <- cleanup(source2$name2)

source1$address <- cleanup(source1$address)
source2$address <- cleanup(source2$address)

source1$name <- cleanup(source1$name)
source2$name <- cleanup(source2$name)
source2$name2 <- cleanup(source2$name2)

dist.name<- adist(source1$name,source2$name, partial = TRUE, ignore.case = TRUE)
dist.name2 <- adist(source1$name, source2$name2, partial = TRUE, ignore.case = TRUE)
dist.address <- adist(source1$address, source2$address, partial = TRUE, ignore.case = TRUE)

min.name<-apply(dist.name, 2, min)
min.name2 <- apply(dist.name2, 2, min)


match.s1.s2<-NULL  
for(i in 1:nrow(dist.address))
{
s2.i<-match(min.name[i],dist.name[i,])
s1.i<-i
match.s1.s2<-
rbind(data.frame(s2.i=s2.i,s1.i=s1.i,s2name=source2[s2.i,]$name, s1name=source1[s1.i,]$name, 
                            adist=min.name[i], s1.i.address = source1[s1.i,]$address,
                            s2.i.address = source2[s2.i,]$address),match.s1.s2)
}

match.s1.s2

Hasil yang diinginkan adalah baris 3 di source1 cocok dengan baris 8 dari source2 dan baris 4 dari source1 cocok dengan baris 7 dari source2. apakah ada cara untuk memasukkan dist.name2 dan dist.address (didefinisikan di atas) ke dalam for-loop di atas? Mungkin pernyataan sementara? Bingkai data aktual yang akan saya gunakan memiliki sekitar 500 dan 24.000 baris.


r text for-loop tm levenshtein-distance
person jvalenti    schedule 21.12.2017    source sumber

Jawaban (1)


arrow_upward
1
arrow_downward

Jarak kosinus tampaknya melakukan pekerjaan yang cukup baik:

out_df <- c()
for(x in source1$name) {
  for(y in source2$full2) {
    if (is.na(source2[source2$full2 == y, "name2"])) {
      x2 <- source1[source1$name == x, "address"]
      y2 <- source2[source2$full2 == y, "address"]
      row <- data.frame(x, y2, stringdist(x, y, method="cosine", q = 1))
      names(row) <- c("name1", "full2", "distance")
      out_df <- rbind(out_df, row)
    } else {
      row <- data.frame(x, y, stringdist(x, y, method="cosine", q = 1))
      names(row) <- c("name1", "full2", "distance")
      out_df <- rbind(out_df, row)
    }
  }
}

names(out_df) <- c("name1", "full2", "distance")

grab <- aggregate(distance ~ name1, data = out_df, FUN = min)

merge(out_df, grab)

Anda masih harus memikirkan cara mengecualikan hasil yang tidak Anda inginkan.

person AidanGawronski    schedule 21.12.2017
comment
bagaimana dengan alamatnya? - person jvalenti; 21.12.2017
comment
Maksud saya menggunakan jarak antar alamat sebagai kriteria kecocokan jika ada NA untuk nama yang cocok. Jadi jika kecocokan nama tidak menghasilkan kecocokan, maka carilah kecocokan yang paling dekat dengan alamat tersebut. sepertinya ini hanya menambahkan alamat ke bingkai data. - person jvalenti; 21.12.2017
comment
Saya sudah lama mengedit akun alamat, tapi saya rasa SO tidak memberi tahu Anda. - person AidanGawronski; 31.01.2018