R - 使用有序因子排序的慢速lapply函数

Question

根据问题更高效的创建语料库和DTM的方法，我已经准备了自己的方法来从大型语料库中构建术语文档矩阵，希望这个方法不需要存储术语x文档的内存。

sparseTDM <- function(vc){
  id = unlist(lapply(vc, function(x){x$meta$id}))
  content = unlist(lapply(vc, function(x){x$content}))
  out = strsplit(content, "\\s", perl = T)
  names(out) = id
  lev.terms = sort(unique(unlist(out)))
  lev.docs = id

  v1 = lapply(
    out,
    function(x, lev) {
      sort(as.integer(factor(x, levels = lev, ordered = TRUE)))
    },
    lev = lev.terms
  )

  v2 = lapply(
    seq_along(v1),
    function(i, x, n){
      rep(i,length(x[[i]]))
    },
    x = v1,
    n = names(v1)
  )

  stm = data.frame(i = unlist(v1), j = unlist(v2)) %>%
    group_by(i, j) %>%
    tally() %>%
    ungroup()

  tmp = simple_triplet_matrix(
    i = stm$i,
    j = stm$j,
    v = stm$n,
    nrow = length(lev.terms),
    ncol = length(lev.docs),
    dimnames = list(Terms = lev.terms, Docs = lev.docs)
  )

  as.TermDocumentMatrix(tmp, weighting = weightTf)
}

在计算v1时，速度变慢了。它运行了30分钟，我停止了它。

我准备了一个小例子：

b = paste0("string", 1:200000)
a = sample(b,80)
microbenchmark(
  lapply(
    list(a=a),
    function(x, lev) {
      sort(as.integer(factor(x, levels = lev, ordered = TRUE)))
    },
    lev = b
  )
)

结果如下：

Unit: milliseconds
expr      min       lq      mean   median       uq      max neval
...  25.80961 28.79981  31.59974 30.79836 33.02461 98.02512   100

Id和内容共有126522个元素，Lev.terms共有155591个元素，因此看起来我停止了处理。由于最终我将处理约6M个文档，所以我需要问一下...有没有办法加速这段代码片段？

- Krzysztof Jędrzejewski

---

你应该在代码顶部放置library(dplyr); library(其他必要的库)，以便使你的代码可重现。我还会将dplyr作为标签，也许可以替换corpus。 - Frank

请帮助我们理解代码的作用，它相当难以理解，加上一些注释会很有帮助；此外，变量名也需要说明。我本来会把 out 命名为 raw_tokens。lev.terms 是一个词袋模型。v1 是一个词向量。v2 似乎是一种不必要的非向量化方式来复制文档 ID。 - smci

所以...我在开始使用R时编写了这段代码，所以可能有很多非最优代码。但它能工作... - Krzysztof Jędrzejewski

Answer 1

目前我已经加速了它，替换了

sort(as.integer(factor(x, levels = lev, ordered = TRUE)))

使用

ind = which(lev %in% x)
cnt = as.integer(factor(x, levels = lev[ind], ordered = TRUE))
sort(ind[cnt])

现在的时间表如下：

expr      min       lq     mean   median       uq      max neval
...  5.248479 6.202161 6.892609 6.501382 7.313061 10.17205   100

- Krzysztof Jędrzejewski

---

帮助我们理解为什么那个应该快大约5倍？因素为什么必须有序？ - smci

它更快，因为factor仅在x中出现的值中查找级别值。Factor被排序以确保分配给每个因子值的整数值与作为levels参数给定的向量中的位置相同。 - Krzysztof Jędrzejewski

我已经检查过，在 R 3.2.3 中，即使没有设置 ordered = T，它也会分配相同的值，但不能保证它将始终如此，因为 factor 函数的实现可能会发生改变。 - Krzysztof Jędrzejewski

Answer 2

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

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) 中轻松找到。

我还鼓励您使用该软件包中的完整dfm()。 您可以使用以下命令从CRAN或开发版本安装它：

devtools::install_github("kbenoit/quanteda")

在您的文本上测试其性能表现。

- Ken Benoit

Answer 3

你尝试过使用排序方法（算法）进行实验，并指定快速排序或希尔排序吗？

类似这样：

sort(as.integer(factor(x, levels = lev, ordered = TRUE)), method=shell)

或者：

sort(as.integer(factor(x, levels = lev, ordered = TRUE)), method=quick)

此外，如果排序算法一遍又一遍地重新执行这些步骤，您可以尝试使用一些中间变量来评估嵌套函数。

foo<-factor(x, levels = lev, ordered = TRUE)
bar<-as.integer(foo)
sort(bar, method=quick)

或者

sort(bar)

祝你好运！

- henderso

---

即使我完全删除排序，时间仍然相同。看起来，我在b中查找a元素的索引的方式需要花费那么多时间。 - Krzysztof Jędrzejewski