计算400万观测数据集的每一行中是否出现一个单词

时间:2017-08-28 22:30:46

标签: r text text-analysis

我正在使用R并编写一个脚本,如果在400万个观察数据文件的每一行中出现~2000个单词之一,则会计算该脚本。带有观察值(df)的数据集包含两列,一列带有文本(df $ lead_paragraph),另一列带有日期(df $ date)。

使用以下内容,我可以计算列表(p)中的任何单词是否出现在df文件的lead_paragraph列的每一行中,并将答案输出为新列。

   df$pcount<-((rowSums(sapply(p, grepl, df$lead_paragraph, 
   ignore.case=TRUE) == TRUE, na.rm=T) > 0) * 1)

但是,如果我在列表p中包含太多单词,则运行代码会导致R。

崩溃

我的替代策略是简单地将其分解成碎片,但我想知道是否有更好,更优雅的编码解决方案可供使用。我倾向于使用for循环,但是我正在阅读的所有内容都表明这在R中并不是首选。我对R来说并不是一个非常好的编码器,所以如果不清楚我会道歉。

    df$pcount1<-((rowSums(sapply(p[1:100], grepl, df$lead_paragraph, 
    ignore.case=TRUE) == TRUE, na.rm=T) > 0) * 1)
    df$pcount2<-((rowSums(sapply(p[101:200], grepl, df$lead_paragraph, 
    ignore.case=TRUE) == TRUE, na.rm=T) > 0) * 1) 
    ...
    df$pcount22<-((rowSums(sapply(p[2101:2200], grepl, df$lead_paragraph, 
    ignore.case=TRUE) == TRUE, na.rm=T) > 0) * 1)

2 个答案:

答案 0 :(得分:0)

我没有完成这个......但这应该指向正确的方向。使用data.table软件包速度更快,但希望这可以让您了解该过程。

我使用随机日期和字符串重新创建了数据集 从http://www.norvig.com/big.txt提取到data.frame 名为nrv_df

library(stringi)

> head(nrv_df)
                                                             lead_para       date
1     The Project Gutenberg EBook of The Adventures of Sherlock Holmes 2018-11-16
2                                            by Sir Arthur Conan Doyle 2019-06-05
3                           15 in our series by Sir Arthur Conan Doyle 2017-08-08
4  Copyright laws are changing all over the world Be sure to check the 2014-12-17
5 copyright laws for your country before downloading or redistributing 2016-09-13
6                            this or any other Project Gutenberg eBook 2015-06-15

> dim(nrv_df)
[1] 103598      2

I then randomly sampled words from the entire body to get 2000 unique words
> length(p)
[1] 2000
> head(p)
[1] "The"        "Project"    "Gutenberg"  "EBook"      "of"         "Adventures"
> tail(p)
[1] "accomplice" "engaged"    "guessed"    "row"        "moist"      "red"   

然后,利用stringi包并使用正则表达式匹配完成 在单词的情况下,我加入了向量p中的每个字符串,以及 然后使用|折叠,以便我们查找word-boundary的任何字词 之前或之后:

> p_join2 <- stri_join(sprintf("\\b%s\\b", p), collapse = "|")
> p_join2

[1] "\\bThe\\b|\\bProject\\b|\\bGutenberg\\b|\\bEBook\\b|\\bof\\b|\\bAdventures\\b|\\bSherlock\\b|\\bHolmes\\b|\\bby\\b|\\bSir\\b|\\bArthur\\b|\\bConan\\b|\\bDoyle\\b|\\b15\\b|\\bin\\b|\\bour\\b|\\bseries\\b|\\bCopyright\\b|\\blaws\\b|\\bare\\b|\\bchanging\\b|\\ball\\b|\\bover\\b|\\bthe\\b|\\bworld\\b|\\bBe\\b|\\bsure\\b|\\bto\\b|\\bcheck\\b|\\bcopyright\\b|\\bfor\\b|\\byour\\b|\\bcountry\\b|..."

然后只需计算单词,您就可以nrv_df$counts <-将其添加为列...

> stri_count_regex(nrv_df$lead_para[25000:26000], p_join2, stri_opts_regex(case_insensitive = TRUE))
[1] 12 11  8 13  7  7  6  7  6  8 12  1  6  7  8  3  5  3  5  5  5  4  7  5  5  5  5  5 10  2  8 13  5  8  9  7  6  5  7  5  9  8  7  5  7  8  5  6  0  8  6
[52]  3  4  0 10  7  9  8  4  6  8  8  7  6  6  6  0  3  5  4  7  6  5  7 10  8 10 10 11

编辑:

因为找到比赛的数量并不重要...... 首先是对每个段落进行工作并检测p2中是否存在lead_paragraph中任何一个搅拌的函数

f <- function(i, j){
     if(any(stri_detect_fixed(i, j, omit_no_match = TRUE))){
         1
     }else {
         0
     }
 }

现在......在linux上使用parallel库。并且只测试1000行,因为它是一个例子给我们:

library(parallel)
library(stringi)
> rst <- mcmapply(function(x){
    f(i = x, j = p2)
}, vdf2$lead_paragraph[1:1000], 
mc.cores = detectCores() - 2,
USE.NAMES = FALSE)
> rst
   [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
  [70] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [139] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0
 [208] 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [277] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [346] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1
 [415] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [484] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [553] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [622] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [691] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [760] 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [829] 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 [898] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1
 [967] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

答案 1 :(得分:0)

这也有效:

library(corpus)

# simulate the problem as in @carl-boneri's answer
lead_para <- readLines("http://www.norvig.com/big.txt")

# get a random sample of 2000 word types
types <- text_types(lead_para, collapse = TRUE)
p <- sample(types, 2000)

# find whether each entry has at least one of the terms in `p`
ix <- text_detect(lead_para, p)

即使只使用单核,它也比以前的解决方案快20多倍:

system.time(ix <- text_detect(lead_para, p))
##  user  system elapsed 
## 0.231   0.008   0.240

system.time(rst <- mcmapply(function(x) f(i = x, j = p_join2),
                            lead_para, mc.cores = detectCores() - 2,
                            USE.NAMES = FALSE))
##   user  system elapsed 
## 11.604   0.240   5.805