13

我的文件有超过 400 万行，我需要一种更有效的方法将我的数据转换为语料库和文档术语矩阵，以便我可以将其传递给贝叶斯分类器。

考虑以下代码：

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

我的问题是，我可以用什么来更快地创建语料库和 DTM？如果我使用超过 300k 行，它似乎非常慢。

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

我也查看了qdap包，但是在尝试加载包时它给了我一个错误，而且我什至不知道它是否会起作用。

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

4

4 回答 4

16

哪种方法？

data.table绝对是正确的方法。正则表达式操作很慢，尽管其中的操作stringi要快得多（除了要好得多）。任何与

quanteda::dfm()在为我的quanteda包创建时，我经历了多次解决问题的迭代（请参阅此处的 GitHub存储库）。到目前为止，最快的解决方案是使用data.table和Matrix包来索引文档和标记化特征，计算文档中的特征，并将结果直接插入稀疏矩阵。

在下面的代码中，我以 quanteda 包中的示例文本为例，您可以（并且应该！）从 CRAN 或开发版本安装它

devtools::install_github("kbenoit/quanteda")

我很想看看它是如何处理你的 4m 文件的。根据我使用这种大小的语料库的经验，它会很好地工作（如果你有足够的内存）。

请注意，在我的所有分析中，我无法通过任何类型的并行化来提高 data.table 操作的速度，因为它们是用 C++ 编写的。

quantedadfm()函数的核心

这是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) 上找到。

量子在你的例子

为了简单起见，这如何？

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
于 2015-07-09T05:42:42.387 回答
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
于 2014-08-15T20:37:02.443 回答
2

你有几个选择。@TylerRinker 评论说qdap，这当然是一种方法。

或者（或另外）您也可以从健康的并行性中受益。有一个不错的 CRAN 页面，详细介绍了 R 中的 HPC 资源。不过它有点过时了，multicore包的功能现在包含在parallel.

apply您可以使用包的多核功能parallel或集群计算（也由该包支持，以及由snowfall和支持）扩展您的文本挖掘biopara。

另一种方法是采用一种MapReduce方法。此处提供了关于大数据组合tm和MapReduce大数据的精彩演示。虽然该演示文稿已有几年历史，但所有信息仍然是最新的、有效的和相关的。同一作者有一篇关于该主题的更新的学术文章，主要关注插件。要绕过使用向量源而不是您可以使用强制：tm.plugin.dcDirSource

data("crude")
as.DistributedCorpus(crude)

如果这些解决方案都不符合您的口味，或者您只是喜欢冒险，您可能还会看到您的 GPU 解决问题的能力。GPU 相对于 CPU 的性能存在很多差异，这可能是一个用例。如果您想尝试一下，可以使用gputoolsCRAN 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
于 2014-08-15T17:40:19.897 回答
1

这比我之前的回答要好。

quanteda包有了显着的发展，现在使用起来更快、更简单，因为它内置了解决这类问题的工具——这正是我们设计它的目的。OP 的一部分询问如何为贝叶斯分类器准备文本。我也为此添加了一个示例，因为quanteda可以毫不费力地处理textmodel_nb()300k 文档，而且它正确实现了多项式 NB 模型（这最适合文本计数矩阵 - 另请参阅https:// stackoverflow.com/a/54431055/4158274）。

在这里，我演示了内置的就职语料库对象，但下面的函数也适用于纯字符向量输入。我使用相同的工作流程在几分钟内在笔记本电脑上处理和拟合模型到数以千万计的推文，所以速度很快。

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()第 th 份文件相同。

# 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
于 2019-02-27T10:03:47.377 回答