Ускорение обработки больших кадров данных в R

Контекст

Я пытался реализовать алгоритм, недавно предложенный в этой статье. Учитывая большой объем текста (корпус), алгоритм должен возвращать характерные n-граммы (т.е. Последовательность из n слов) корпуса. Пользователь может решить соответствующее n, и в данный момент я пытаюсь с n = 2-6, как в оригинальной бумаге. Другими словами, используя алгоритм, я хочу извлечь от 2 до 6 грамм, которые характеризуют корпус.

Я смог реализовать часть, которая вычисляет оценку, на основе которой идентифицируются определенные n-граммы, но пыталась устранить нехарактерные.

Данные

У меня есть список под названием token.df, который содержит пять фреймов данных, включая все n-граммы, которые появляются в корпусе. Каждый кадр данных соответствует каждому n в n-граммах. Например, token.df[[2]] включает все биграммы (2 грамма) и их баллы (называемые ми ниже) в алфавитном порядке.

> head(token.df[[2]])
w1    w2      mi
_      eos  17.219346
_   global   7.141789
_     what   8.590394
0        0   2.076421
0       00   5.732846
0      000   3.426785

Здесь bigram 0 0 (хотя они и не совсем такие слова) имеет оценку 2.076421. Поскольку кадры данных включают все n-граммы, которые появляются в корпусе, каждый из них имеет более одного миллиона строк.

> sapply(token.df, nrow)
[[1]]
NULL

[[2]]
[1] 1006059  # number of unique bigrams in the corpus

[[3]]
[1] 2684027  # number of unique trigrams in the corpus

[[4]]
[1] 3635026  # number of unique 4-grams in the corpus

[[5]]
[1] 3965120  # number of unique 5-grams in the corpus

[[6]]
[1] 4055048  # number of unique 6-grams in the corpus

Task

Я хочу определить, какие n-граммы сохранить и какие из них отбрасывать. Для этой цели алгоритм делает следующее.

  • биграммы
    • В нем сохраняются битрамы, чьи баллы выше, чем у триграмм, чьи первые два слова совпадают с битрамами.
  • 3-5 грамм
    • Для каждого n-грамма, где n = {3, 4, 5}, он смотрит на
      • n-1 грамм, которые соответствуют первым n-1 словам n-грамма и
      • n + 1 грамм, чьи первые n слов соответствуют n-грамм.
    • Алгоритм сохраняет n-грамм только в том случае, если его оценка выше, чем оценки n-1 грамма и n + 1 грамм, указанных выше.
  • 6-граммы
    • Он сохраняет 6 грамм, чьи баллы выше, чем у 5-граммов, которые соответствуют первым пяти словам из 6 граммов.

Пример

> token.df[[2]][15, ]
 w1  w2       mi
  0 001 10.56292
> token.df[[3]][33:38, ]
 w1  w2       w3        mi
  0 001     also  3.223091
  0 001 although  5.288097
  0 001      and  2.295903
  0 001      but  4.331710
  0 001 compared  6.270625
  0 001      dog 11.002312
> token.df[[4]][46:48, ]
 w1  w2            w3      w4        mi
  0 001      compared      to  5.527626
  0 001           dog walkers 10.916028
  0 001 environmental concern 10.371769

Здесь bigram 0 001 не сохраняется, потому что одна из триграмм, чьи первые два слова совпадают с bigram (собака 0 001), имеет более высокий балл, чем bigram (11.002312 > 10.56292). Собака триграммы 0 001 сохраняется, потому что ее оценка (11.002312) выше, чем у биграма, которая соответствует первым двум словам триграммы (0 001; score = 10.56292), а ее значение - 4 грамма, первые три слова которого соответствуют триграмма (0 001 собачьего ходока, оценка = 10.916028).

Проблема и неудачные попытки

То, что я хотел бы знать, - это эффективный способ достижения вышеуказанного. Чтобы определить, какие биграммы для сохранения, например, мне нужно выяснить для каждой строки token.df[[2]], строки которой в token.df[[3]] имеют первые два слова, идентичные значению bigram. Однако, так как число строк велико, моя итерация под ним занимает слишком много времени для запуска. Они фокусируются на случае с битрамами, потому что задача выглядела проще, чем в случае с 3-5 граммами.

  • Подход цикла for.
    Так как приведенный ниже код просматривает все строки token.df[[3]] на каждой итерации, по оценкам, требуется несколько месяцев. Хотя это немного лучше, аналогично случаю by().

    # for loop
retain <- numeric(nrow(token.df[[2]]))
for (i in 1:nrow(token.df[[2]])) {
    mis <- token.df[[3]]$mi[token.df[[2]][i, ]$w1 == token.df[[3]][ , 1] & token.df[[2]][i, ]$w2 == token.df[[3]][ , 2]]
    retain[i] <- ifelse(token.df[[2]]$mi[i] > max(mis), TRUE, FALSE)
}

# by
mis <- by(token.df[[2]], 1:nrow(token.df[[2]]), function(x) token.df[[3]]$mi[x$w1 == token.df[[3]]$w1 & x$w2 == token.df[[3]]$w2])
retain <- sapply(seq(mis), function(i) token.df[[2]]$mi[i] > max(mis[[i]]))

  • Подход указателя.
    Проблема с вышеизложенным заключается в большом количестве итераций над (вертикально) длинным фреймом данных. Чтобы облегчить проблему, я подумал, что могу использовать тот факт, что n-граммы сортируются по алфавиту в каждом кадре данных и используют какой-то указатель, указывающий, в какой строке начать искать. Однако этот подход слишком длительный для запуска (по крайней мере, несколько дней).

    retain <- numeric(nrow(token.df[[2]]))
nrow <- nrow(token.df[[3]]) # number of rows of the trigram data frame
pos <- 1 # pointer
for (i in seq(nrow(token.df[[2]]))) {
    j <- 1
    target.rows <- numeric(10)
    while (TRUE) {
        if (pos == nrow + 1 || !all(token.df[[2]][i, 1:2] == token.df[[3]][pos, 1:2])) break
        target.rows[j] <- pos
        pos <- pos + 1
        if (j %% 10 == 0) target.rows <- c(target.rows, numeric(10))
        j <- j + 1
    }
    target.rows <- target.rows[target.rows != 0]
    retain[i] <- ifelse(token.df[[2]]$mi[i] > max(token.df[[3]]$mi[target.rows]), TRUE, FALSE)
}

Есть ли способ выполнить эту задачу за разумные промежутки времени (например, за одну ночь)? Теперь, когда итерационные подходы были напрасны, мне интересно, возможна ли какая-либо векторизация. Но я открыт для любых способов ускорить процесс.

Данные имеют древовидную структуру в том, что один биграм делится на одну или несколько триграмм, каждая из которых, в свою очередь, делится на один или более 4-граммов и т.д. Я не уверен, как лучше обрабатывать такие данные.

Воспроизводимый пример

Я подумал о том, чтобы раскрыть часть реальных данных, которые я использую, но сокращение данных разрушает всю суть проблемы. Я предполагаю, что люди не хотят загружать весь набор данных 250 МБ только для этого, и я не имею права на его загрузку. Ниже представлен случайный набор данных, который все еще меньше, чем я использую, но помогает справиться с этой проблемой. С помощью приведенного выше кода (подход указателя) он занимает мой компьютер 4-5 секунд для обработки первых 100 строк token.df[[2]] ниже, и он, по-видимому, занимает 12 часов, чтобы обработать все битрамы.

token.df <- list()
types <- combn(LETTERS, 4, paste, collapse = "")
set.seed(1)
data <- data.frame(matrix(sample(types, 6 * 1E6, replace = TRUE), ncol = 6), stringsAsFactors = FALSE)
colnames(data) <- paste0("w", 1:6)
data <- data[order(data$w1, data$w2, data$w3, data$w4, data$w5, data$w6), ]
set.seed(1)
for (n in 2:6) token.df[[n]] <- cbind(data[ , 1:n], mi = runif(1E6))

Любые идеи по ускорению кода высоко ценятся.

Ответы

Ответ 1

Ниже на моей машине прогоняется менее 7 секунд для всех биграмм:

library(dplyr)
res <- inner_join(token.df[[2]],token.df[[3]],by = c('w1','w2'))
res <- group_by(res,w1,w2)
bigrams <- filter(summarise(res,keep = all(mi.y < mi.x)),keep)

Здесь нет ничего особенного в dplyr. Не менее быстрое (или более быстрое) решение можно было бы сделать с помощью data.table или непосредственно в SQL. Вам просто нужно переключиться на использование объединений (как в SQL), а не повторять все через все. На самом деле я не удивлюсь, если просто использовать merge в базе R, а затем aggregate не будет на порядок быстрее, чем то, что вы сейчас делаете. (Но вы действительно должны делать это с помощью data.table, dplyr или непосредственно в базе данных SQL).

В самом деле, это:

library(data.table)
dt2 <- setkey(data.table(token.df[[2]]),w1,w2)
dt3 <- setkey(data.table(token.df[[3]]),w1,w2)
dt_tmp <- dt3[dt2,allow.cartesian = TRUE][,list(k = all(mi < mi.1)),by = c('w1','w2')][(k)]

еще быстрее (~ 2x). Я даже не уверен, что я сжимал всю скорость, которую мог бы получить из любого пакета, если честно.

(отредактировать от Rick. Попытка как комментарий, но синтаксис перепутался)
Если используется data.table, это должно быть еще быстрее, поскольку data.table имеет функцию by-without-by (см. ?data.table для получения дополнительной информации):

 dt_tmp <- dt3[dt2,list(k = all(mi < i.mi)), allow.cartesian = TRUE][(k)]

Обратите внимание, что при объединении data.tables вы можете предикатировать имена столбцов с помощью i., чтобы указать использование столбца из таблицы data.table в аргументе i=.