创建包含4M行的语料库和DTM的更有效方法

13

我的文件有超过4M行,我需要更高效的方法将数据转换为语料库和文档-词项矩阵,以便将其传递给贝叶斯分类器。

请考虑以下代码:

library(tm)

GetCorpus <-function(textVector)
{
  doc.corpus <- Corpus(VectorSource(textVector))
  doc.corpus <- tm_map(doc.corpus, tolower)
  doc.corpus <- tm_map(doc.corpus, removeNumbers)
  doc.corpus <- tm_map(doc.corpus, removePunctuation)
  doc.corpus <- tm_map(doc.corpus, removeWords, stopwords("english"))
  doc.corpus <- tm_map(doc.corpus, stemDocument, "english")
  doc.corpus <- tm_map(doc.corpus, stripWhitespace)
  doc.corpus <- tm_map(doc.corpus, PlainTextDocument)
  return(doc.corpus)
}

data <- data.frame(
  c("Let the big dogs hunt","No holds barred","My child is an honor student"), stringsAsFactors = F)

corp <- GetCorpus(data[,1])

inspect(corp)

dtm <- DocumentTermMatrix(corp)

inspect(dtm)

输出结果:

> inspect(corp)
<<VCorpus (documents: 3, metadata (corpus/indexed): 0/0)>>

[[1]]
<<PlainTextDocument (metadata: 7)>>
let big dogs hunt

[[2]]
<<PlainTextDocument (metadata: 7)>>
 holds bar

[[3]]
<<PlainTextDocument (metadata: 7)>>
 child honor stud
> inspect(dtm)
<<DocumentTermMatrix (documents: 3, terms: 9)>>
Non-/sparse entries: 9/18
Sparsity           : 67%
Maximal term length: 5
Weighting          : term frequency (tf)

              Terms
Docs           bar big child dogs holds honor hunt let stud
  character(0)   0   1     0    1     0     0    1   1    0
  character(0)   1   0     0    0     1     0    0   0    0
  character(0)   0   0     1    0     0     1    0   0    1
我的问题是:如何更快地创建语料库和文档词矩阵?如果我要使用超过300k行,似乎速度会极慢。

我听说可以使用data.table,但我不确定如何使用。

我也尝试了qdap包,但加载时出现错误,并且我不确定它是否适用。

参考:http://cran.r-project.org/web/packages/qdap/qdap.pdf

2
qdap在这个任务中不会更快,因为它使用tm包作为后端。但是,使用data.table/dplyr的正则表达式或并行处理可能会更快。 - Tyler Rinker
@TylerRinker非常感谢您的建议。您是否能够指导我正确的方向或(理想情况下)提供一个使用我上面提供的R代码的逐字逐句的例子? - user1477388
4个回答

16

哪种方法更好?

data.table绝对是正确的选择。正则表达式操作很慢,虽然stringi中的操作要快得多(而且更好)。任何使用

我尝试了许多次迭代来解决创建quanteda::dfm()的问题,这是我的quanteda软件包中的一个功能(请参见GitHub repo here)。到目前为止,最快的解决方案涉及使用data.tableMatrix软件包来索引文档和标记化特征,在文档内计算特征,并将结果直接插入稀疏矩阵。

在下面的代码中,我以使用quanteda软件包找到的文本为例,您可以从CRAN或开发版本安装该软件包。

devtools::install_github("kbenoit/quanteda")

我非常希望能看到它在你的四百万份文档上是如何工作的。根据我使用类似规模语料库的经验,如果你有足够的内存,它的表现会相当好。

请注意,通过任何形式的并行化,我都无法改善data.table操作的速度,因为它们是用C ++编写的。

quanteda dfm()函数的核心

这是基于data.table的源代码的最简版本,以防有人想要尝试改进它。它输入了一个由字符向量表示的标记化文本列表。在quanteda包中,全功能的dfm()可以直接在文档或语料库对象的字符向量上运行,并默认实现小写、数字去除和空格去除(但如果需要,这些都可以被修改)。

require(data.table)
require(Matrix)

dfm_quanteda <- function(x) {
    docIndex <- 1:length(x)
    if (is.null(names(x))) 
        names(docIndex) <- factor(paste("text", 1:length(x), sep="")) else
            names(docIndex) <- names(x)

    alltokens <- data.table(docIndex = rep(docIndex, sapply(x, length)),
                            features = unlist(x, use.names = FALSE))
    alltokens <- alltokens[features != ""]  # if there are any "blank" features
    alltokens[, "n":=1L]
    alltokens <- alltokens[, by=list(docIndex,features), sum(n)]

    uniqueFeatures <- unique(alltokens$features)
    uniqueFeatures <- sort(uniqueFeatures)

    featureTable <- data.table(featureIndex = 1:length(uniqueFeatures),
                               features = uniqueFeatures)
    setkey(alltokens, features)
    setkey(featureTable, features)

    alltokens <- alltokens[featureTable, allow.cartesian = TRUE]
    alltokens[is.na(docIndex), c("docIndex", "V1") := list(1, 0)]

    sparseMatrix(i = alltokens$docIndex, 
                 j = alltokens$featureIndex, 
                 x = alltokens$V1, 
                 dimnames=list(docs=names(docIndex), features=uniqueFeatures))
}

require(quanteda)
str(inaugTexts)
## Named chr [1:57] "Fellow-Citizens of the Senate and of the House of Representatives:\n\nAmong the vicissitudes incident to life no event could ha"| __truncated__ ...
## - attr(*, "names")= chr [1:57] "1789-Washington" "1793-Washington" "1797-Adams" "1801-Jefferson" ...
tokenizedTexts <- tokenize(toLower(inaugTexts), removePunct = TRUE, removeNumbers = TRUE)
system.time(dfm_quanteda(tokenizedTexts))
##  user  system elapsed 
## 0.060   0.005   0.064 

当然,这只是一个片段,但完整的源代码可以轻松在GitHub存储库(dfm-main.R)中找到。

以您的示例为例使用quanteda

对于简单性来说,这个怎么样?

require(quanteda)
mytext <- c("Let the big dogs hunt",
            "No holds barred",
            "My child is an honor student")
dfm(mytext, ignoredFeatures = stopwords("english"), stem = TRUE)
# Creating a dfm from a character vector ...
# ... lowercasing
# ... tokenizing
# ... indexing 3 documents
# ... shaping tokens into data.table, found 14 total tokens
# ... stemming the tokens (english)
# ... ignoring 174 feature types, discarding 5 total features (35.7%)
# ... summing tokens by document
# ... indexing 9 feature types
# ... building sparse matrix
# ... created a 3 x 9 sparse dfm
# ... complete. Elapsed time: 0.023 seconds.

# Document-feature matrix of: 3 documents, 9 features.
# 3 x 9 sparse Matrix of class "dfmSparse"
# features
# docs    bar big child dog hold honor hunt let student
# text1   0   1     0   1    0     0    1   1       0
# text2   1   0     0   0    1     0    0   0       0
# text3   0   0     1   0    0     1    0   0       1

1
@user1477388 谢谢!dfm() 在 Cyrillic 字符上也很好用。我们解决 TermDocument 与 DocumentTerm 的问题的方法很简单:文档始终只是行。这与任何数据分析结构相同,其中行索引案例或单位,列指示有关单位的变量或特征。术语或其变体只是一种特征类型。 - Ken Benoit
2
这是一个不错的加速。如果其他条件相同,我鼓励OP将检查移动到此解决方案。 - Tyler Rinker
太棒了!有没有一种方法可以在不修改dfm的情况下使用bigrams(或n-grams),即不是单个单词而是两个单词组合“Let the”,“the big”,“big dogs”,“dogs hunt”在您的mytext [1]中? - HOSS_JFL
谢谢!是的,dfm() 函数可以接受 ngrams 参数,例如:`dfm(mytext, ngrams = 2, concatenator = " ")`以生成您想要的结果。 - Ken Benoit
1
注意:我的原始解决方案非常快,但我已经改变了dfm()代码,使用更快的方法,利用构建稀疏矩阵的方法。请参见https://dev59.com/qVwZ5IYBdhLWcg3wWfGl#31601473,了解我发现这种方法的地方。 - Ken Benoit
你如何使用quanteda包提供的稀疏矩阵进行矩阵乘法?将问题转移到这个线程这里 - hhh

12

我认为你可能需要考虑更加专注于正则表达式的解决方案。这些是作为开发者我所遇到的一些问题和思考。我目前在密切关注 stringi 套件进行开发,因为它具有一些一致命名的函数,非常适合进行字符串操作。

在这个回复中,我试图使用比 tm 更方便的方法更快的工具(肯定比 qdap 快得多)。这里我甚至还没有探索过并行处理或 data.table/dplyr,而是专注于用 stringi 进行字符串操作,并将数据保持在矩阵中,使用特定的包来处理该格式的数据。我采用了你的示例并将其扩大了100000倍。即使进行词干提取,这在我的机器上也需要17秒。

data <- data.frame(
    text=c("Let the big dogs hunt",
        "No holds barred",
        "My child is an honor student"
    ), stringsAsFactors = F)

## eliminate this step to work as a MWE
data <- data[rep(1:nrow(data), 100000), , drop=FALSE]

library(stringi)
library(SnowballC)
out <- stri_extract_all_words(stri_trans_tolower(SnowballC::wordStem(data[[1]], "english"))) #in old package versions it was named 'stri_extract_words'
names(out) <- paste0("doc", 1:length(out))

lev <- sort(unique(unlist(out)))
dat <- do.call(cbind, lapply(out, function(x, lev) {
    tabulate(factor(x, levels = lev, ordered = TRUE), nbins = length(lev))
}, lev = lev))
rownames(dat) <- sort(lev)

library(tm)
dat <- dat[!rownames(dat) %in% tm::stopwords("english"), ] 

library(slam)
dat2 <- slam::as.simple_triplet_matrix(dat)

tdm <- tm::as.TermDocumentMatrix(dat2, weighting=weightTf)
tdm

## or...
dtm <- tm::as.DocumentTermMatrix(dat2, weighting=weightTf)
dtm

1
这是一个很棒的答案。我正在使用UTF-8编码的文本(俄语字符),而这个答案支持它,而另一个答案似乎不支持(在我的Windows机器上)。我如何使用此方法删除数字和标点符号?我看了http://cran.r-project.org/web/packages/stringi/stringi.pdf,但我不确定如何在这种情况下应用这些方法。此外,dtm <- tm :: as.DocumentTermMatrix(dat2,weighting = weightTf)这一行似乎混淆了术语和文档,而TermDocumentMatrix正确区分了两者。 - user1477388
根据您的代码,我已经准备了一个函数,用于计算TermDocumentMatrix,避免创建密集矩阵,这是我理解中在您的示例中由do.call(...)创建的。但是它的运行速度非常慢。您有任何想法如何加快它的速度吗? - Krzysztof Jędrzejewski

2
您有几个选择。@TylerRinker评论了关于qdap,这当然是一种选择。
另外(或者同时),您也可以获益于并行计算。有一个很好的CRAN页面详细介绍了R中的HPC资源。不过它有点过时了,现在multicore包的功能已经被合并到parallel中了。
您可以使用parallel包的多核心apply函数或集群计算(也由该包支持,以及由snowfallbiopara支持)来扩大文本挖掘的规模。
另一种方法是采用MapReduce方法。有一个关于将tmMapReduce结合处理大数据的演示文稿,可以在这里找到。虽然这个演示文稿已经有几年了,但所有信息仍然是最新、有效和相关的。同样的作者们在这个主题上还有一篇更新的学术文章,重点关注tm.plugin.dc插件。为了避免使用向量源而不是DirSource,您可以使用强制转换:
data("crude")
as.DistributedCorpus(crude)

如果这些解决方案都不符合您的口味,或者您感到冒险,您也可以看看您的GPU处理问题的能力如何。 GPU与CPU相对性能的差异很大,这可能是一种使用情况。 如果您想尝试一下,可以使用 gputools 或其他在CRAN HPC任务视图上提到的GPU包。 示例:
library(tm)
install.packages("tm.plugin.dc")
library(tm.plugin.dc)

GetDCorpus <-function(textVector)
{
  doc.corpus <- as.DistributedCorpus(VCorpus(VectorSource(textVector)))
  doc.corpus <- tm_map(doc.corpus, content_transformer(tolower))
  doc.corpus <- tm_map(doc.corpus, content_transformer(removeNumbers))
  doc.corpus <- tm_map(doc.corpus, content_transformer(removePunctuation))
  # <- tm_map(doc.corpus, removeWords, stopwords("english")) # won't accept this for some reason...
  return(doc.corpus)
}

data <- data.frame(
  c("Let the big dogs hunt","No holds barred","My child is an honor student"), stringsAsFactors = F)

dcorp <- GetDCorpus(data[,1])

tdm <- TermDocumentMatrix(dcorp)

inspect(tdm)

输出:

> inspect(tdm)
<<TermDocumentMatrix (terms: 10, documents: 3)>>
Non-/sparse entries: 10/20
Sparsity           : 67%
Maximal term length: 7
Weighting          : term frequency (tf)

         Docs
Terms     1 2 3
  barred  0 1 0
  big     1 0 0
  child   0 0 1
  dogs    1 0 0
  holds   0 1 0
  honor   0 0 1
  hunt    1 0 0
  let     1 0 0
  student 0 0 1
  the     1 0 0

感谢提供资源,但我真的找不到任何关于如何应用Hadoophive包或分布式语料库tm.plugic.dc的例子。这些包似乎使用DirSource,而我只有一个向量源。有没有好的代码示例? - user1477388
1
我知道你的意思。当我按照示例来做自己的工作时,我也不得不调整我的代码以适应这种差异。但是它肯定是可以完成的。我会看看能否找到一个很好的例子,展示如何这样做。 - Hack-R
1
@user1477388 这并不是一个很长或漂亮的例子,但是通过 data("crude"); dcrude <- as.DistributedCorpus(crude) 的强制转换是否足以让您可以使用 Vingettes 或其他资源中的其余主要示例? - Hack-R
1
@user1477388,你在单词“plugin”中打错了一个字母。如果这个错误只出现在你的评论中,而不是实际运行的代码中,那么大多数软件包都可以通过从源代码下载并安装来解决这个问题。 - Hack-R
1
尝试先将其转换为VCorpus,然后使用as.DCorpus - Hack-R
显示剩余4条评论

1
这比我之前的答案更好。quanteda包已经显著发展,现在更快、更简单易用,因为它内置了解决此类问题的工具,这正是我们设计它的目的。OP的一部分要求如何为贝叶斯分类器准备文本。我也添加了一个例子,因为quanteda的textmodel_nb()可以轻松处理30万个文档,并正确实现多项式NB模型(这是文本计数矩阵最合适的模型,另请参见https://dev59.com/17Hma4cB1Zd3GeqPL3d8#54431055)。在这里,我演示了内置就职演讲语料库对象,但下面的函数也适用于普通的字符向量输入。我使用相同的工作流程,在笔记本电脑上处理和拟合了数千万条推文的模型,速度很快。
library("quanteda", warn.conflicts = FALSE)
## Package version: 1.4.1
## Parallel computing: 2 of 12 threads used.
## See https://quanteda.io for tutorials and examples.

# use a built-in data object
data <- data_corpus_inaugural
data
## Corpus consisting of 58 documents and 3 docvars.

# here we input a corpus, but plain text input works fine too
dtm <- dfm(data, tolower = TRUE, remove_numbers = TRUE, remove_punct = TRUE) %>%
  dfm_wordstem(language = "english") %>%
  dfm_remove(stopwords("english"))

dtm
## Document-feature matrix of: 58 documents, 5,346 features (89.0% sparse).    
tail(dtm, nf = 5)
## Document-feature matrix of: 6 documents, 5 features (83.3% sparse).
## 6 x 5 sparse Matrix of class "dfm"
##               features
## docs           bleed urban sprawl windswept nebraska
##   1997-Clinton     0     0      0         0        0
##   2001-Bush        0     0      0         0        0
##   2005-Bush        0     0      0         0        0
##   2009-Obama       0     0      0         0        0
##   2013-Obama       0     0      0         0        0
##   2017-Trump       1     1      1         1        1

这是一个相对简单的例子,但为了说明问题,让我们拟合一个朴素贝叶斯模型,将特朗普文件保留。这是发布时最后一次就职演说(“2017-Trump”),在位置上等同于第ndoc()个文件。
# fit a Bayesian classifier
postwar <- ifelse(docvars(data, "Year") > 1945, "post-war", "pre-war")
textmod <- textmodel_nb(dtm[-ndoc(dtm), ], y = postwar[-ndoc(dtm)], prior = "docfreq")

与其他拟合模型对象(例如lm()glm()等)一起使用的相同类型的命令也适用于拟合的朴素贝叶斯文本模型对象。因此:

summary(textmod)
## 
## Call:
## textmodel_nb.dfm(x = dtm[-ndoc(dtm), ], y = postwar[-ndoc(dtm)], 
##     prior = "docfreq")
## 
## Class Priors:
## (showing first 2 elements)
## post-war  pre-war 
##   0.2982   0.7018 
## 
## Estimated Feature Scores:
##          fellow-citizen  senat   hous  repres among vicissitud   incid
## post-war        0.02495 0.4701 0.2965 0.06968 0.213     0.1276 0.08514
## pre-war         0.97505 0.5299 0.7035 0.93032 0.787     0.8724 0.91486
##            life  event   fill greater anxieti  notif transmit  order
## post-war 0.3941 0.1587 0.3945  0.3625  0.1201 0.3385   0.1021 0.1864
## pre-war  0.6059 0.8413 0.6055  0.6375  0.8799 0.6615   0.8979 0.8136
##          receiv   14th    day present  month    one  hand summon countri
## post-war 0.1317 0.3385 0.5107 0.06946 0.4603 0.3242 0.307 0.6524  0.1891
## pre-war  0.8683 0.6615 0.4893 0.93054 0.5397 0.6758 0.693 0.3476  0.8109
##           whose  voic    can  never   hear  vener
## post-war 0.2097 0.482 0.3464 0.2767 0.6418 0.1021
## pre-war  0.7903 0.518 0.6536 0.7233 0.3582 0.8979

predict(textmod, newdata = dtm[ndoc(dtm), ])
## 2017-Trump 
##   post-war 
## Levels: post-war pre-war

predict(textmod, newdata = dtm[ndoc(dtm), ], type = "probability")
##            post-war       pre-war
## 2017-Trump        1 1.828083e-157

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接