在R中缓慢的wordcloud

时间:2018-05-08 17:27:09

标签: r

尝试使用带有文本的300MB .csv文件创建一个文字云,但它需要花费数小时才能在具有16GB内存的笔记本电脑上使用。不确定这通常需要多长时间...但这是我的代码:

library("tm")
library("SnowballC")
library("wordcloud")
library("RColorBrewer")

dfTemplate <- read.csv("CleanedDescMay.csv", header=TRUE, stringsAsFactors = FALSE)

template <- dfTemplate
template <- Corpus(VectorSource(template))
template <- tm_map(template, removeWords, stopwords("english"))
template <- tm_map(template, stripWhitespace)
template <- tm_map(template, removePunctuation)

dtm <- TermDocumentMatrix(template)

m <- as.matrix(dtm)
v <- sort(rowSums(m), decreasing=TRUE)
d <- data.frame(word = names(v), freq=v)
head(d, 10)


par(bg="grey30")
png(file="WordCloudDesc1.png", width=1000, height=700, bg="grey30")
wordcloud(d$word, d$freq, col=terrain.colors(length(d$word), alpha=0.9), random.order=FALSE, rot.per = 0.3, max.words=500)
title(main = "Top Template Words", font.main=1, col.main="cornsilk3",    cex.main=1.5)
dev.off()

感谢任何建议!

1 个答案:

答案 0 :(得分:1)

第1步:个人资料

您是否尝试使用一小部分来分析整个工作流程,以确定哪些步骤花费的时间最多? Profiling with RStudio here

如果没有,那应该是你的第一步。

如果tm_map()函数需要很长时间:

如果我没记错,我发现使用stringi比专用语料库工具更快。

对于预清洁步骤,我的工作流程看起来如下所示。这肯定可以进一步优化 - magrittr管道%>%确实有助于一些额外的处理时间,但我觉得这是一个可接受的权衡,因为没有几十个嵌套的理智括号。

library(data.table)
library(stringi)
library(parallel)


## This function handles the processing pipeline
textCleaner <- function(InputText, StopWords, Words, NewWords){
  InputText %>% 
    stri_enc_toascii(.) %>% 
    toupper(.) %>% 
    stri_replace_all_regex(.,"[[:cntrl:]]"," ") %>% 
    stri_replace_all_regex(.,"[[:punct:]]"," ") %>% 
    stri_replace_all_regex(.,"[[:space:]]+"," ") %>% ## Replaces multiple spaces with 
    stri_replace_all_regex(.,"^[[:space:]]+|[[:space:]]+$","") %>% ## Remove leading and trailing spaces
    stri_replace_all_regex(.,"\\b"%s+%StopWords%s+%"\\b","",vectorize_all = FALSE) %>%  ## Stopwords
    stri_replace_all_regex(.,"\\b"%s+%Words%s+%"\\b",NewWords,vectorize_all = FALSE) ## Replacements
}




## Replacement Words, I would normally read in a .CSV file
Replace <- data.table(Old = c("LOREM","IPSUM","DOLOR","SIT"),
                      New = c("I","DONT","KNOW","LATIN"))

## These need to be defined globally
GlobalStopWords <- c("AT","UT","IN","ET","A")
GlobalOldWords <- Replace[["Old"]]
GlobalNewWords <- Replace[["New"]]

## Generate some sample text
DT <- data.table(Text = stringi::stri_rand_lipsum(500000))

## Running Single Threaded
system.time({
  DT[,CleanedText := textCleaner(Text, GlobalStopWords,GlobalOldWords, GlobalNewWords)]
})
#   user  system elapsed 
# 66.969   0.747  67.802 

清理文本的过程令人尴尬地平行,因此从理论上讲,您应该可以通过多个内核节省大量时间。

我曾经并行运行这个管道,但今天回过头来看,结果是通信开销使得8个内核需要两倍于单线程。我不确定这与我的原始用例是否相同,但我想这可能只是一个很好的例子,说明为什么尝试并行化而不是优化会导致比价值更多的麻烦。

## This function handles the cluster creation
    ## and exporting libraries, functions, and objects
    parallelCleaner <- function(Text, NCores){
      cl <- parallel::makeCluster(NCores)
      clusterEvalQ(cl, library(magrittr))
      clusterEvalQ(cl, library(stringi))
      clusterExport(cl, list("textCleaner",
                             "GlobalStopWords",
                             "GlobalOldWords",
                             "GlobalNewWords"))
      Text <- as.character(unlist(parallel::parLapply(cl, Text,
                                                      fun = function(x) textCleaner(x,
                                                                                    GlobalStopWords,
                                                                                    GlobalOldWords,
                                                                                    GlobalNewWords))))
      parallel::stopCluster(cl)
      return(Text)
    }

    ## Run it Parallel
    system.time({
      DT[,CleanedText := parallelCleaner(Text = Text,
                                         NCores =  8)]
    }) 
#   user  system elapsed 
#  6.700   5.099 131.429 

如果TermDocumentMatrix(template)是主犯:

  

更新:我提到Drew Schmidt和Christian Heckendorf最近还向CRAN提交了一个名为ngram的R包,可能值得一试:ngram Github Repository。事实证明我应该在解释从源代码构建命令行工具这个非常繁琐的过程之前尝试过它 - 这样可以节省我很多时间,大约在18个月之前!

这是一个更大的内存密集型而且相当一样快 - 我的内存使用率达到了31 GB左右,这对你来说可能是也可能不是。考虑到所有事情,这似乎是一个非常好的选择。

对于500,000段案例,ngrams在运行时间约7分钟时钟:

#install.packages("ngram")
library(ngram)
library(data.table)
system.time({
  ng1 <- ngram::ngram(DT[["CleanedText"]],n = 1)
  ng2 <- ngram::ngram(DT[["CleanedText"]],n = 2)
  ng3 <- ngram::ngram(DT[["CleanedText"]],n = 3)

  pt1 <- setDT(ngram::get.phrasetable(ng1))
  pt1[,Ngrams := 1L]
  pt2 <- setDT(ngram::get.phrasetable(ng2))
  pt2[,Ngrams := 2L]
  pt3 <- setDT(ngram::get.phrasetable(ng3))
  pt3[,Ngrams := 3L]

  pt <- rbindlist(list(pt1,pt2,pt3))
})

#    user  system elapsed 
# 411.671  12.177 424.616 

pt[Ngrams == 2][order(-freq)][1:5]

#      ngrams  freq         prop Ngrams
# 1: SED SED  75096 0.0018013693      2
# 2:  AC SED  33390 0.0008009444      2
# 3:  SED AC  33134 0.0007948036      2
# 4:  SED EU  30379 0.0007287179      2
# 5:  EU SED  30149 0.0007232007      2

您可以尝试使用效率更高的ngram生成器。我使用了一个名为ngrams (available on github here)的命令行工具,由Zheyuan Yu-部分实现了Vlado Keselj博士的Text-Ngrams 1.6,将预处理的文本文件从磁盘中取出并生成一个。具有ngram频率的csv输出。

您需要使用make自行构建源代码,然后使用来自system()的{​​{1}}调用与其进行交互,但我发现它的运行速度要快几个数量级使用一小部分内存。使用它,我能够在一小时内从~700MB的文本输入生成5克,所有输出的CSV结果是2.9 GB文件,9300万行。

继续上面的示例,在我的工作目录中,我的工作目录中有一个文件夹R,其中包含使用ngrams-master创建的ngrams可执行文件。

make

我想我可能已经做了一些调整以获得我想要的输出格式,如果您感兴趣我可以尝试找到我所做的更改以生成不同于writeLines(DT[["CleanedText"]],con = "ExampleText.txt") system2(command = "ngrams-master/ngrams",args = "--type=word --n = 3 --in ExampleText.txt", stdout = "ExampleGrams.csv") # ngrams have been generated, start outputing. # Subtotal: 165 seconds for generating ngrams. # Subtotal: 12 seconds for outputing ngrams. # Total 177 seconds. Grams <- fread("ExampleGrams.csv") # Read 5917978 rows and 3 (of 3) columns from 0.160 GB file in 00:00:06 Grams[Ngrams == 3 & Frequency > 10][sample(.N,5)] # Ngrams Frequency Token # 1: 3 11 INTERDUM_NEC_RIDICULUS # 2: 3 18 MAURIS_PORTTITOR_ERAT # 3: 3 14 SOCIIS_AMET_JUSTO # 4: 3 23 EGET_TURPIS_FERMENTUM # 5: 3 14 VENENATIS_LIGULA_NISL 的输出默认并上传到Github。 (在我熟悉平台之前,我做了那个项目,所以我不能很好地记录我所做的,生活和学习的变化。)

  

更新2:我在Github上创建了一个fork,msummersgill/ngrams反映了我以.CSV格式输出结果的轻微调整。如果有人如此倾向,我有一种预感,这可以包含在基于.csv的包中,这对于CRAN提交是否可以接受 - 任何接受者?老实说,我不知道三元搜索树是如何工作的,但它们似乎显着更高的内存效率,并且比目前R中可用的任何其他N-gram实现更快。

Drew Schmidt和Christian Heckendorf也向CRAN提交了一个名为Rcpp的R包,但我还没有亲自使用它,但也值得一试:ngram Github Repository

The Whole Shebang:

使用上述相同的管道,但其大小更接近您处理ngram的大小达到~274MB)

ExampleText.txt

虽然由于DT <- data.table(Text = stringi::stri_rand_lipsum(500000)) system.time({ DT[,CleanedText := textCleaner(Text, GlobalStopWords,GlobalOldWords, GlobalNewWords)] }) # user system elapsed # 66.969 0.747 67.802 writeLines(DT[["CleanedText"]],con = "ExampleText.txt") system2(command = "ngrams-master/ngrams",args = "--type=word --n = 3 --in ExampleText.txt", stdout = "ExampleGrams.csv") # ngrams have been generated, start outputing. # Subtotal: 165 seconds for generating ngrams. # Subtotal: 12 seconds for outputing ngrams. # Total 177 seconds. Grams <- fread("ExampleGrams.csv") # Read 5917978 rows and 3 (of 3) columns from 0.160 GB file in 00:00:06 Grams[Ngrams == 3 & Frequency > 10][sample(.N,5)] # Ngrams Frequency Token # 1: 3 11 INTERDUM_NEC_RIDICULUS # 2: 3 18 MAURIS_PORTTITOR_ERAT # 3: 3 14 SOCIIS_AMET_JUSTO # 4: 3 23 EGET_TURPIS_FERMENTUM # 5: 3 14 VENENATIS_LIGULA_NISL 生成的词汇量有限,示例可能不是一个完美的表示,但在500,000个段落上使用少于8 GB的RAM的总运行时间约为4.2分钟,对于语料库来说已经足够快了(科比?)我过去不得不解决。

如果wordcloud()是减速的来源:

我不熟悉这个功能,但@Gregor对你原来帖子的评论似乎会解决这个问题。

stringi::stri_rand_lipsum()

wordcloud