R - медленно работающий вяло с сортировкой по упорядоченному фактору

На основе вопроса Более эффективные средства создания корпуса и 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 и content имеют 126522 элемента, Lev.terms имеет 155591 элемент, так что, похоже, я остановил обработку слишком рано. Поскольку в конечном итоге я буду работать с документами ~ 6M, мне нужно спросить... Есть ли способ ускорить этот фрагмент кода?


person Krzysztof Jędrzejewski    schedule 05.04.2015    source источник
comment
Вы должны поставить библиотеку (dplyr); library(whatever_else) вверху, чтобы ваш код воспроизводился. Я бы также поставил dplyr в качестве тега, может быть, вместо corpus.   -  person Frank    schedule 14.07.2016
comment
Помогите нам понять, что делает код, он довольно непрозрачный, пара комментариев не помешала бы; также имена переменных. Я бы позвонил out raw_tokens. lev.terms это набор слов. v1 является вектором слова. v2 кажется ненужным невекторизованным способом репликации идентификатора документа.   -  person smci    schedule 14.07.2016
comment
Итак... я написал этот код, когда только начинал работать с R, поэтому, вероятно, там много неоптимального кода. Но это сработало...   -  person Krzysztof Jędrzejewski    schedule 22.07.2016


Ответы (3)


На данный момент я ускорил его замену

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
person Krzysztof Jędrzejewski    schedule 07.04.2015
comment
Помогите нам понять, почему это должно быть примерно в 5 раз быстрее? Почему фактор должен быть заказан? - person smci; 14.07.2016
comment
Это быстрее, потому что factor ищет значения уровня только среди значений, которые появляются в x. Фактор упорядочивается, чтобы убедиться, что целочисленные значения, присвоенные каждому значению фактора, будут такими же, как и их положение в векторе, указанном в качестве параметра уровней. - person Krzysztof Jędrzejewski; 22.07.2016
comment
Я проверил, и он присваивает те же значения, даже без упорядоченного = T в R 3.2.3, но не гарантируется, что так будет всегда, так как реализация факторной функции может быть изменена. - person Krzysztof Jędrzejewski; 22.07.2016

Я прошел много итераций решения проблемы при создании quanteda::dfm() (см. репозиторий GitHub здесь) и самого быстрого решения, на сегодняшний день включает использование пакетов 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")

на ваших текстах, чтобы увидеть, как это работает с точки зрения производительности.

person Ken Benoit    schedule 09.07.2015

Пробовали ли вы экспериментировать с методом сортировки (алгоритмом) и указать быструю сортировку или сортировку оболочки?

что-то типа:

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

or:

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)

or

sort(bar)

Удачи!

person henderso    schedule 05.04.2015
comment
Даже когда я полностью удаляю сортировку, тайминги остаются прежними. Похоже, что то, как я нахожу индексы a элементов в b, занимает столько времени. - person Krzysztof Jędrzejewski; 06.04.2015