用R文本分析进行干扰

Question

我正在对TM包进行大量分析.我最大的问题之一是与词干和词干变换有关.

假设我有几个与会计相关的术语(我知道拼写问题).
在阻止后我们有:

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

结果:3个条款(帐户,帐户,帐户)我希望1(帐户),因为所有这些都与同一个词有关.

1)纠正拼写是一种可能性,但我从来没有在R中尝试过.这是否可能？

2)另一种选择是建立一个参考列表,即账户=(账户,账户,会计,会计,账户,账户,账户),然后将所有事件替换为主条款.我怎么会在R？

再一次,任何帮助/建议将不胜感激.

Answer 1

我们可以设置一个同义词列表并替换这些值.例如

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

这说我们想用"账户"代替"账户"和"账户"(我假设我们在完成账户后这样做).现在让我们创建测试数据.

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列表即可.每个子列表应具有名称"word"和"syns".

Answer 2

弗莱克先生回答了问题#2.我正在回答问题#1.

这是一种使用已知单词数据库(DICTIONARYfrom qdapDictionaries)的二进制搜索的方法.二进制查找肯定是慢的,但是如果我们对替换做出一些假设(比如字符数的差异范围).所以这是基本的想法:

1. 转Corpus成用字的独特袋qdap的bag_o_words
2. 在字典(qdapDictionaries' DICTIONARY数据集)中查找这些单词以查找无法识别的单词match
   • misses步骤#2中的这些将是我们查找的内容
3. 确定字典中单词的字符数,以便以后消除粗略差异 nchar
4. 运行的每个元件misses通过一个环路(sapply)并执行以下操作:
   一个.misses使用tm::stemDocument
   b来阻止每个元素.使用nchar
   c 确定字符数并从字典中删除不在该范围内的字符数.用agrepa max.distance来消除字典中的更多单词
   d.使用二进制查找(反向工程师agrep)来确定最接近遗漏元素的字典中的单词[注意这是一个来自qdap被调用的非导出函数qdap:::Ldist]
5. 结果是一个我们可以用于gsubbing 的命名向量
6. tm_map与自定义tm风格的gsub函数一起使用来替换单词
7. 用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))

Answer 3

这个问题激发了我尝试为qdap包编写拼写检查.这里有一个互动版本可能很有用.它可用于qdap >= version 2.1.1.这意味着您现在需要开发版本..以下是安装步骤:

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然后允许您将"更正"应用于任何新的文本字符串.