R优化使用stri_extract

时间:2016-08-03 09:21:41

标签: r performance loops optimization

我一直致力于一些文本抓取/分析。我做的一件事是从文档中提取顶部单词以进行比较并了解不同的指标。这很快捷。定义了使用哪些分隔符并从单个单词中提取单词而不是从分析中删除了短语信息成为一个问题。例如,.Net Developer在转型后成为网络和开发人员。我已经有一个其他人放弃的旧项目中的设定短语/单词列表。下一步是从多行中为多个文档提取特定关键字。

我一直在研究几种技术,包括矢量化,并行处理,在R中使用C ++代码等。展望未来,我将尝试所有这些技术,并尝试加快我的流程,并为未来的项目提供这些工具。同时(没有实验)我想知道哪些调整是显而易见的,这将显着减少所花费的时间,例如:在循环外部移动代码部分,使用更好的包等 我也有一个进度条,但如果它显着减慢我的循环,我可以删除它。

这是我的代码:

words <- read.csv("keyphrases.csv")
df <- data.frame(x=(list.files("sec/new/")))
total = length(df$x)
pb <- txtProgressBar(title = "Progress Bar", min = 0, max =total , width = 300, style=3)

for (i in df$x){
          s <- read.csv(paste0("sec/new/",i))
          u <- do.call(rbind, pblapply(words$words, function(x){
              t <- data.frame(ref= s[,2], words = stri_extract(s[,3], coll=x))
              t<-na.omit(t)
          }))
          write.csv(u,paste0("sec/new_results/new/",i), row.names = F)
          setTxtProgressBar(pb, i, title=paste( round(which(df$x== i)/total*100, 2),"% done"))
      }

所以words有60,000行单词/短语 - 每行不超过30个字符。长度i大约为4000,其中每个i有100到5000行,每行有1到5000个字符。如果我的问题需要可重现,可以使用任何随机字符/字符串。

我只使用了lapply,因为将它与rbind和do.call结合使用效果非常好,在循环中循环可能会显着减慢进程。

所以,我还能做些什么吗?将data.frame交换为data.table或使用向量代替。以某种方式在循环外进行读写?也许把它写成其中一个循环没有嵌套?

提前致谢

编辑

需要加速的关键因素是摘录。我是否使用上面的lapply或者将其剪切为:

for(x in words$words){t<-data.table(words=stri_extract(s[,3], coll=x))}

这仍然需要很长时间才能完成。技巧和t是这种情况下的数据表。

EDIT2

尝试创建可重现的数据:

set.seed(42)    
words <- data.frame(words=rnorm(1:60000))
    words$wwords <- as.String(words$words)

set.seed(42)
     file1 <- data.frame(x=rnorm(1:5000))
     file1$x<-as.String(file1$x)

     pblapply(words$words, function(x){
         t <- data.frame(words = stri_extract(file1$x, coll=x))
     })

2 个答案:

答案 0 :(得分:2)

首先要做的事情。是的,我肯定会从data.frame切换到data.table。当你开始合并数据集时,不仅更快更容易使用data.table,当data.frame会给你带来意想不到的和意想不到的结果时,它会做出合理的事情。

其次,使用R来照顾分离器是否有优势?您提到了许多您正在考虑使用的不同技术。如果分析器只是用于分析的噪声,为什么不将工作分成两个工具并使用更好的处理分隔符和延续线的工具等等?对我来说,Python是一个很自然的选择,可以将大量文本解析为关键字 - 包括剥离分隔符和其他&#34;噪声&#34;在分析中你不关心的词。将Python解析的结果输入R,并使用R作为其优势。

有几种不同的方法可以将Python输出到R中。我建议从简单的东西开始:CSV文件。它们是你开始使用的,它们易于用Python阅读和编写,并且易于在R中阅读。后来你可以处理Python和R之间的直接管道,但是在你工作之前它不会给你带来太大的好处原型,起初它还有很多工作要做。让Python读入您的原始数据并生成一个CSV文件,R可以直接放入data.table而无需进一步处理。

至于stri_extract,这次真的不是你需要的工具。你当然可以匹配一堆不同的单词,但它并不是真正的优化。我同意@Chris的说法,在data.tables上使用merge()是一种更有效,更快捷的搜索方法。

答案 1 :(得分:1)

单字版

如果每次查找都有单个单词,则可以通过合并轻松完成:

library(data.table)

#Word List
set.seed(42)
WordList <- data.table(ID = 1:60000, words = sapply(1:60000, function(x) paste(sample(letters, 5), collapse = '')))

#A list of dictionaries
set.seed(42)
Dicts <- list(
  Dict1 = sapply(1:15000, function(x) {
    paste(sample(letters, 5), collapse = '')
  }),
  Dict2 = sapply(1:15000, function(x) {
    paste(sample(letters, 5), collapse = '')
  }),
  Dict3 = sapply(1:15000, function(x) {
    paste(sample(letters, 5), collapse = '')
  })
)

#Create Dictionary Data.table and add Identifier
Dicts <- rbindlist(lapply(Dicts, function(x){data.table(ref = x)}), use.names = T, idcol = T)

# set key for joining
setkey(WordList, "words")
setkey(Dicts, "ref")

现在我们有一个包含所有字典单词的data.table,以及一个包含单词列表中所有单词的data.table。现在我们可以合并:

merge(WordList, Dicts, by.x = "words", by.y = "ref", all.x = T, allow.cartesian = T)
       words    ID   .id
    1: abcli 30174 Dict3
    2: abcrg 26210 Dict2
    3: abcsj  8487 Dict1
    4: abczg 24311 Dict2
    5: abdgl  1326 Dict1
   ---                  
60260: zyxeb 52194    NA
60261: zyxfg 57359    NA
60262: zyxjw 19337 Dict2
60263: zyxoq  5771 Dict1
60264: zyxqa 24544 Dict2

因此,我们可以在abcli中看到Dict3,而zyxeb没有出现在任何词典中。看起来有264个重复(出现在&gt; 1字典中的单词),因为结果data.table大于我们的单词列表(60264> 60000)。如下所示:

merge(WordList, Dicts, by.x = "words", by.y = "ref", all.x = T, allow.cartesian = T)[words == "ahlpk"]
   words    ID   .id
1: ahlpk  7344 Dict1
2: ahlpk  7344 Dict2
3: ahlpk 28487 Dict1
4: ahlpk 28487 Dict2

我们在这里也看到,单词列表中的重复单词将创建多个结果行。

这是非常快速的运行

短语+句子

如果您在句子中搜索短语,则需要执行字符串匹配。但是,您仍然需要进行n(Phrases) * n(Sentences)比较,这将在大多数R数据结构中快速达到内存限制。幸运的是,这是一个embarrassingly parallel操作:

相同设置:

library(data.table)
library(foreach)
library(doParallel)


# Sentence List
set.seed(42)
Sentences <- data.table(ID = 1:60000, Sentence = sapply(1:60000, function(x) paste(sample(letters, 10), collapse = '')))

# A list of phrases
set.seed(42)
Phrases <- list(
  Phrases1 = sapply(1:15000, function(x) {
    paste(sample(letters, 5), collapse = '')
  }),
  Phrases2 = sapply(1:15000, function(x) {
    paste(sample(letters, 5), collapse = '')
  }),
  Phrases3 = sapply(1:15000, function(x) {
    paste(sample(letters, 5), collapse = '')
  })
)

# Create Dictionary Data.table and add Identifier
Phrases <- rbindlist(lapply(Phrases, function(x){data.table(Phrase = x)}), use.names = T, idcol = T)

# Full Outer Join
Sentences[, JA := 1]
Phrases[, JA := 1]

# set key for joining
setkey(Sentences, "JA")
setkey(Phrases, "JA")

我们现在想把我们的Phrases表拆分成可管理的批次

cl<-makeCluster(4)
registerDoParallel(cl)

nPhrases <- as.numeric(nrow(Phrases))
nSentences <- as.numeric(nrow(Sentences))

batch_size <- ceiling(nPhrases*nSentences / 2^30) #Max data.table allocation is 2^31. Lower this if you are hitting memory allocation limits
seq_s <- seq(1,nrow(Phrases), by = floor(nrow(Phrases)/batch_size))
ln_s <- length(seq_s)
if(ln_s > 1){
  str_seq <- paste0(seq_s,":",c(seq_s[2:ln_s],nrow(Phrases) + 1) - 1)
} else {
  str_seq <- paste0(seq_s,":",nrow(Phrases))
}

我们现在准备好把我们的工作送出去。下面的grepl行正在开展工作 - 测试哪些短语与每个句子匹配。然后我们过滤掉任何不匹配。

ls<-foreach(i = 1:ln_s) %dopar% {

  library(data.table)
  TEMP_DT <- merge(Sentences,Phrases[eval(parse(text = str_seq[1]))], by = "JA", allow.cartesian = T)
  TEMP_DT <- TEMP_DT[, match_test := grepl(Phrase,Sentence), by = .(Phrase,Sentence)][match_test == 1]
  return(TEMP_DT)

}

stopCluster(cl)


DT_OUT <- unique(do.call(rbind,ls))

DT_OUT现在总结了匹配的句子,以及它所在的词组+词组列表。

这仍然需要一些时间(因为需要进行大量处理),但不到一年。