Исправление с помощью R Text Analysis

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

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

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

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

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

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

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

ОТВЕТЫ

Ответ 1

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

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

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

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)   
})

Здесь мы используем функцию content_transformer для определения настраиваемого преобразования. И в основном мы просто делаем gsub для замены каждого слова. Затем мы можем использовать это на корпусе

tm <- Corpus(VectorSource(raw))
tm <- tm_map(tm, stemDocument)
tm <- tm_map(tm, replaceSynonyms, synonyms)
inspect(tm)

и мы можем видеть, что все эти значения преобразуются в "учетную запись" по желанию. Чтобы добавить другие синонимы, просто добавьте дополнительные списки в основной список synonyms. Каждый суб-список должен иметь имена "слово" и "син".

Ответ 2

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

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

  • Поверните Corpus в уникальный пакет слов, используя qdap bag_o_words
  • Посмотрите эти слова в словаре (qdapDictionaries 'DICTIONARY набор данных), чтобы найти слова, которые не распознаются с помощью match
    • Эти misses из шага # 2 будут искать то, что мы искали
  • Определить количество символов для слов в словаре, чтобы устранить валовую разницу позже, используя nchar
  • Запустите каждый элемент misses через цикл (sapply) и выполните следующие действия:
    а. закрепить каждый элемент из misses с помощью tm::stemDocument
    б. определить количество символов и устранить слова из словаря, которые не входят в этот диапазон, используя nchar
    с. используйте agrep с max.distance, чтобы удалить больше слов из словаря
    д. используйте двоичный поиск (который обращает инженеров agrep), чтобы определить слово из словаря, наиболее близкого к пропущенному элементу [обратите внимание, что это неэкспортированная функция из qdap, называемая qdap:::Ldist]
  • Результатом является именованный вектор, который мы можем использовать для gsub bing
  • Используйте tm_map с пользовательской tm приправленной gsub функцией для замены слов
  • Сделайте вывод с tm_map и stemDocument

Вот код. Я сделал подделку Corpus, используя слова, которые вы предоставляете, и некоторые случайные слова, чтобы продемонстрировать, как это сделать от начала до конца. Вы можете играть с range и max.distance, который поставляется в sapply. Чем слабее вы с ними, тем медленнее поиск будет, но ужесточение их слишком сильно приведет к большей ошибке. Это действительно не является ответом на исправление орфографии в общем смысле, но работает здесь, потому что вы все равно превалируете. Там 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))

Ответ 3

Этот вопрос вдохновил меня на попытку написать проверку орфографии для пакета qdap. Там есть интерактивная версия, которая может быть полезной здесь. Он доступен в 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 и позволяет затем применить "исправление" к любой новой текстовой строке.