Как пословно сравнить две строки в R

Question

У меня есть набор данных, назовем его «ORIGINALE», состоящий из нескольких разных строк только для двух столбцов, первый из которых называется «DESCRIPTION», а второй «CODICE». Столбец описания содержит правильную информацию, в то время как код столбца, который является ключом, почти всегда пуст, поэтому я пытаюсь найти соответствующий код в другом наборе данных, назовем его «ССЫЛКА». Я использую описание столбца на естественном языке и пытаюсь сопоставить его с описанием во втором наборе данных. Я должен сопоставить слово за словом, так как может быть другой порядок слов, синонимов или сокращений. Затем я подсчитываю показатель сходства, чтобы оставить только лучшее совпадение, и принимаю те, которые выше определенного значения. Есть ли способ его улучшить? Я работаю примерно с 300000 строками, и, хотя я знаю, что это всегда требует времени, возможно, есть способ сделать это даже немного быстрее.

ORIGINALE <- data.frame(DESCRIPTION = c("mr peter 123 rose street 3b LA"," 4c flower str jenny jane Chicago", "washington miss sarah 430f name strt"), CODICE = (NA, NA, NA))
REFERENE <- dataframe (DESCRIPTION = c("sarah brown name street 430f washington", "peter green 123 rose street 3b LA", "jenny jane flower street 4c Chicago"), CODICE = c("135tg67","aw56", "83776250"))

algoritmo <- function(ORIGINALE, REFERENCE) {
   split1 <- strsplit(x$DESCRIPTION, " ")
   split2 <- strsplit(y$DESCRIPTION, " ")
   risultato <- vector()
   distanza <- vector()
      for(i in 1:NROW(split1)) {
      best_dist <- -5
      closest_match <- -5
        for(j in 1:NROW(split2)) {
          dist <- stringsim(as.character(split1[i]), as.character(split2[j]))
            if (dist > best_dist) {
              closest_match <- y$DESCRIPTION[j]
              best_dist <- dist 
            } 
        } 
      distanza <- append(distanza, best_dist)    
      risultato <- append(risultato, closest_match)
      }
    confronto <<- tibble(x$DESCRIPTION, risultato, distanza)
  }

match <- subset.data.frame(confronto, confronto$distanza >= "0.6")
missing <- subset.data.frame(confronto, confronto$distanza <"0.6")

Answer 1

А как насчет:

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

data_o <- ORIGINALE %>% mutate(desc_o = DESCRIPTION) %>% select(desc_o)
data_r <- REFERENE %>% mutate(desc_r = DESCRIPTION) %>% select(desc_r)
data <- crossing(data_o,data_r)
data %>% mutate(dist= stringsim(as.character(desc_o),as.character(desc_r))) %>%
         group_by(desc_o) %>% 
         filter(dist==max(dist))

  desc_o                                 desc_r                                   dist
  <chr>                                  <chr>                                   <dbl>
1 " 4c flower str jenny jane Chicago"    jenny jane flower street 4c Chicago     0.486
2 "mr peter 123 rose street 3b LA"       peter green 123 rose street 3b LA       0.758
3 "washington miss sarah 430f name strt" sarah brown name street 430f washington 0.385

Answer 2

Здесь может помочь библиотека R tm (интеллектуальный анализ текста):

library(tm)
library(proxy) # for computing cosine similarity
library(data.table)

ORIGINALE = data.table(DESCRIPTION = c("mr peter 123 rose street 3b LA"," 4c flower str jenny jane Chicago", "washington miss sarah 430f name strt"), CODICE = c(NA, NA, NA))
REFERENCE = data.table(DESCRIPTION = c("sarah brown name street 430f washington", "peter green 123 rose street 3b LA", "jenny jane flower street 4c Chicago"), CODICE = c("135tg67","aw56", "83776250"))

# combine ORIGINALE and REFERENCE into one data.table
both = rbind(ORIGINALE,REFERENCE)

# create "doc_id" and "text" columns (required by tm)
both[,doc_id:=1:.N]
names(both)[1] = 'text'

# convert to tm corpus
corpus = SimpleCorpus(DataframeSource(both))

# convert to a tm document term matrix
dtm = DocumentTermMatrix(corpus)

# convert to a regular matrix
dtm = as.matrix(dtm)

# look at it (t() transpose for readability)
t(dtm)
            Docs
Terms        1 2 3 4 5 6
  123        1 0 0 0 1 0
  peter      1 0 0 0 1 0
  rose       1 0 0 0 1 0
  street     1 0 0 1 1 1
  chicago    0 1 0 0 0 1
  flower     0 1 0 0 0 1
  jane       0 1 0 0 0 1
  jenny      0 1 0 0 0 1
  str        0 1 0 0 0 0
  430f       0 0 1 1 0 0
  miss       0 0 1 0 0 0
  name       0 0 1 1 0 0
  sarah      0 0 1 1 0 0
  strt       0 0 1 0 0 0
  washington 0 0 1 1 0 0
  brown      0 0 0 1 0 0
  green      0 0 0 0 1 0

# compute similarity between each combination of documents 1:3 and documents 4:6
similarity = proxy::dist(dtm[1:3,], dtm[4:6,], method="cosine")

# result:
ORIGINALE               REFERENCE document
 document              4         5         6
        1      0.7958759 0.1055728 0.7763932   <-- difference (smaller = more similar)
        2      1.0000000 1.0000000 0.2000000
        3      0.3333333 1.0000000 1.0000000

# make a table of which REFERENCE document is most similar
most_similar = rbindlist(
  apply(
    similarity,1,function(x){
      data.table(i=which.min(x),distance=min(x))
    }
  )
)

# result:
   i  distance
1: 2 0.1055728
2: 3 0.2000000
3: 1 0.3333333
# rows 1, 2, 3 or rows of ORIGINALE; i: 2 3 1 are rows of REFERENCE

# add the results back to ORIGINALE
ORIGINALE1 = cbind(ORIGINALE,most_similar)
REFERENCE[,i:=1:.N]
ORIGINALE2 = merge(ORIGINALE1,REFERENCE,by='i',all.x=T,all.y=F)

# result:
   i                        DESCRIPTION.x CODICE.x  distance                           DESCRIPTION.y CODICE.y
1: 1 washington miss sarah 430f name strt       NA 0.3333333 sarah brown name street 430f washington  135tg67
2: 2       mr peter 123 rose street 3b LA       NA 0.1055728       peter green 123 rose street 3b LA     aw56
3: 3     4c flower str jenny jane Chicago       NA 0.2000000     jenny jane flower street 4c Chicago 83776250

# now the documents are in a different order than in ORIGINALE2.
# this is caused by merging by i (=REFERENCE document row).
# if order is important, then add these two lines around the merge line:
ORIGINALE1[,ORIGINALE_i:=1:.N]
ORIGINALE2 = merge(...
ORIGINALE2 = ORIGINALE2[order(ORIGINALE_i)]

Answer 3

Хороший вопрос. Циклы for в R работают медленно:

for(i in 1:NROW(split1)) {
for(j in 1:NROW(split2)) {

Для быстрого R вам нужно векторизовать свой алгоритм. Я уже не так удобен с data.frame, поэтому я буду использовать его преемника, data.table.

library(data.table)
ORIGINALE = data.table(DESCRIPTION = c("mr peter 123 rose street 3b LA"," 4c flower str jenny jane Chicago", "washington miss sarah 430f name strt"), CODICE = c(NA, NA, NA))
REFERENCE = data.table(DESCRIPTION = c("sarah brown name street 430f washington", "peter green 123 rose street 3b LA", "jenny jane flower street 4c Chicago"), CODICE = c("135tg67","aw56", "83776250"))

# split DESCRIPTION to make tables that have one word per row
ORIGINALE_WORDS = ORIGINALE[,.(word=unlist(strsplit(DESCRIPTION,' ',fixed=T))),.(DESCRIPTION,CODICE)]
REFERENCE_WORDS = REFERENCE[,.(word=unlist(strsplit(DESCRIPTION,' ',fixed=T))),.(DESCRIPTION,CODICE)]

# remove empty words introduced by extra spaces in your DESCRIPTIONS
ORIGINALE_WORDS = ORIGINALE_WORDS[word!='']
REFERENCE_WORDS = REFERENCE_WORDS[word!='']

# merge the tables by word
merged = merge(ORIGINALE_WORDS,REFERENCE_WORDS,by='word',all=F,allow.cartesian=T)

# count matching words for each combination of ORIGINALE DESCRIPTION and REFERENCE DESCRIPTION and CODICE
counts = merged[,.N,.(DESCRIPTION.x,DESCRIPTION.y,CODICE.y)]

# keep only the highest N CODICE.y for each DESCRIPTION.x
topcounts = merged[order(-N)][!duplicated(DESCRIPTION.x)]

# merge the counts back to ORIGINALE
result = merge(ORIGINALE,topcounts,by.x='DESCRIPTION',by.y='DESCRIPTION.x',all.x=T,all.y=F)

Вот результат:

                            DESCRIPTION CODICE                           DESCRIPTION.y CODICE.y N
1:     4c flower str jenny jane Chicago     NA     jenny jane flower street 4c Chicago 83776250 5
2:       mr peter 123 rose street 3b LA     NA       peter green 123 rose street 3b LA     aw56 6
3: washington miss sarah 430f name strt     NA sarah brown name street 430f washington  135tg67 4

PS: Есть более эффективные с точки зрения памяти способы сделать это, и этот код может привести к тому, что ваша машина будет взламывать sh из-за ошибки нехватки памяти или go медленно из-за необходимости виртуальной памяти, но если нет, она должна быть быстрее, чем петли for.