Stemming с анализом текста R

Я делаю много анализа с TM пакета. Одна из моих самых больших проблем связана со стеммингом и подобными ему преобразованиями.

предположим, у меня есть несколько связанных с бухгалтерией терминов (я знаю о проблемах правописания).
После stemming мы имеем:

accounts   -> account  
account    -> account  
accounting -> account  
acounting  -> acount  
acount     -> acount  
acounts    -> acount  
accounnt   -> accounnt

результат: 3 условия (учетная запись, acount, account), где я хотел бы 1 (учетная запись), поскольку все они относятся к одному и тому же термину.

1) исправить правописание возможно, но я никогда не пытался это сделать в R. возможно ли это вообще?

2) другой вариант-сделать ссылочный список, т. е. account = (account, account, acount, acounts, accountnt), а затем заменить все вхождения на основной термин. Как бы я это сделал в R?

еще раз, любая помощь/предложения будут с благодарностью.

12
r stemming text tm

3 ответов

мы могли бы создать список синонимов и заменить эти значения. Например

synonyms <- list(
    list(word="account", syns=c("acount", "accounnt"))
)

это говорит о том, что мы хотим заменить "acount" и "account" на "account" (я предполагаю, что мы делаем это после stemming). Теперь давайте создадим тестовые данные.

raw<-c("accounts", "account", "accounting", "acounting", 
     "acount", "acounts", "accounnt")

а теперь определим функцию преобразования, которая заменит слова в нашем списке первичным синонимом.

library(tm)
replaceSynonyms <- content_transformer(function(x, syn=NULL) { 
    Reduce(function(a,b) {
        gsub(paste0("\b(", paste(b$syns, collapse="|"),")\b"), b$word, a)}, syn, x)   
})

здесь мы используем

13

г-н Флик ответил на вопрос #2. Я приближаюсь, отвечая на вопрос № 1.

вот подход, который использует двоичный поиск известной базы данных word (DICTIONARY С qdapDictionaries). Двоичный поиск медленный, но если мы сделаем некоторые предположения о замене (например, диапазон различий в количестве символов). Итак, вот основная идея:

  1. повернуть Corpus в уникальный мешок слов, используя qdap ' s bag_o_words
  2. посмотреть эти слова в словаре (qdapDictionaries' DICTIONARY набор данных), чтобы найти слова не распознать с помощью match
    • эти misses из шага # 2 будет то, что мы ищем
  3. определить количество символов для слов в словаре, чтобы устранить грубую разницу позже с помощью nchar
  4. выполнить каждый элемент misses через петлю (sapply) и сделайте следующее:
    a. stem каждый элемент из misses используя tm::stemDocument
    си. определите количество символов и удалите те из словаря, которые не находятся в этом диапазоне, используя nchar
    С. используйте agrep С max.distance чтобы исключить больше слов из словаря
    d. используйте двоичный поиск (что обратные инженеры agrep), чтобы определить слово из словаря, который ближе всего к пропущенному элементу [Примечание это не экспортируется функция из qdap под названием qdap:::Ldist]
  5. результат-это именованный вектор, который мы можем использовать для gsubbing
  6. использовать tm_map с пользовательским tm ароматизированные заменить словами
  7. сделайте stemming с tm_map и stemDocument

вот код. Я сделал подделку Corpus используя слова, которые вы предоставляете, и некоторые случайные слова, чтобы продемонстрировать, как это сделать от начала до конца. Вы можете играть с range и max.distance, предоставленный для sapply. Чем слабее вы с этими медленный поиск будет, но tightiening эти слишком многое сделает его более вероятным для ошибки. Это действительно не ответ на исправление орфографии в общем смысле, но работает здесь, потому что вы все равно были. Есть Aspell пакета, но я никогда не использовал его раньше. 

terms <- c("accounts", "account", "accounting", "acounting", "acount", "acounts", "accounnt")

library(tm); library(qdap)

fake_text <- unlist(lapply(terms, function(x) {
    paste(sample(c(x, sample(DICTIONARY[[1]], sample(1:5, 1)))), collapse=" ")
}))

fake_text

myCorp <- Corpus(VectorSource(fake_text))
terms2 <- unique(bag_o_words(as.data.frame(myCorp)[[2]]))
misses <- terms2[is.na(match(terms2, DICTIONARY[[1]]))]

chars <- nchar(DICTIONARY[[1]])

replacements <- sapply(misses, function(x, range = 3, max.distance = .2) {
    x <- stemDocument(x)
    wchar <- nchar(x)
    dict <- DICTIONARY[[1]][chars >= (wchar - range) & chars <= (wchar + range)]
    dict <- dict[agrep(x, dict, max.distance=max.distance)]
    names(which.min(sapply(dict, qdap:::Ldist, x)))
})

replacer <- content_transformer(function(x) { 
    mgsub(names(replacements), replacements, x, ignore.case = FALSE, fixed = FALSE)
})

myCorp <- tm_map(myCorp, replacer)
inspect(myCorp <- tm_map(myCorp, stemDocument))
8

этот вопрос вдохновил меня на попытку написать проверку орфографии для . Есть интерактивная версия, которая может быть полезна здесь. Он доступен в qdap >= version 2.1.1. Это означает, что вам понадобится версия dev на данный момент.. вот шаги по установке:

library(devtools)
install_github("qdapDictionaries", "trinker")
install_github("qdap", "trinker")
library(tm); library(qdap)

## воссоздавать Corpus как вы описываете. 

terms <- c("accounts", "account", "accounting", "acounting", "acount", "acounts", "accounnt")

fake_text <- unlist(lapply(terms, function(x) {
    paste(sample(c(x, sample(DICTIONARY[[1]], sample(1:5, 1)))), collapse=" ")
}))

fake_text

inspect(myCorp <- Corpus(VectorSource(fake_text)))

## интерактивная проверка орфографии (check_spelling_interactive)

m <- check_spelling_interactive(as.data.frame(myCorp)[[2]])
preprocessed(m)
inspect(myCorp <- tm_map(myCorp, correct(m)))

на correct функция просто захватывает функцию закрытия из вывода check_spelling_interactive и позволяет затем применить "исправление" к любой новой текстовой строке(строкам).

6