R Оптимизация двойной петли, которая использует stri_extract

Question

Я работаю над некоторым анализом текста. Одна вещь, которую я сделал, - это вытащить верхние слова из документов, чтобы сравнить и узнать о разных показателях. Это было быстро и легко. Возникла проблема с определением того, какие разделители использовать, и вытягивая отдельные слова, а не фразы, удаляющие информацию из анализа. Например, .NET Developer становится net и разработчиком после преобразования. У меня уже был список заданных фраз/слов из старого проекта, который кто-то оставил. Следующим шагом было выведение определенных ключевых слов из нескольких строк для нескольких документов.

Я изучал несколько методов, включая векторизация, параллельную обработку, используя код C++ внутри R и другие. Двигаясь вперед, я буду экспериментировать со всеми этими методами и попытаться ускорить мой процесс, а также дать мне эти инструменты для будущих проектов. В то же время (без экспериментов) мне интересно, какие корректировки очевидны, что значительно уменьшит время, затраченное, например, движущиеся части кода за пределами цикла, используя лучшие пакеты и т. д. У меня также есть индикатор выполнения, но я могу удалить его, если он значительно замедлит мой цикл.

Вот мой код:

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 имеет 60000 строк слов/коротких фраз - не более 30 символов каждая. Длина i составляет около 4000, где каждый я имеет от 100 до 5000 строк, причем каждая строка имеет от 1 до 5000 символов. Любые случайные символы/строки могут использоваться, если мой вопрос должен быть воспроизводимым.

Я использовал только lapply, потому что объединение его с rbind и do.call работало очень хорошо, наличие цикла внутри цикла также может замедлить процесс.

Так что с летучей мыши есть что-то, что я могу сделать правильно? Обмен данными data.frame с таблицей данных или использованием векторов. Делать чтение и запись вне цикла каким-то образом? Возможно, напишите так, чтобы одна из петель не была вложенной?

Заранее спасибо

EDIT

Ключевой элемент, который нуждается в ускорении является экстракт. использовать ли я 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)) 
    }) 

Answer 1

Single Word Версия

Если у вас есть отдельные слова в каждом поиске, это легко выполняется с объединением:

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 со всеми словарями слова и дат a.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 дубликатов (слова, которые появляются в словаре> 1), поскольку итоговая таблица данных больше нашего списка слов (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") 

Теперь мы хотим, чтобы разбить нашу фразы таблицы на управляемые партии

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 Теперь суммирует предложения, которые соответствуют, вместе со списком фраз + фраз, что он находится в.

Это еще займет некоторое время (так как есть много обработки, что необходимо) , но нигде почти год.

Answer 2

Прежде всего. Да, я бы определенно переключился с data.frame на data.table. Мало того, что это быстрее и проще в использовании, когда вы начинаете слияние наборов данных data.table будет делать разумные вещи, когда data.frame даст вам неожиданные и непреднамеренные результаты.

Во-вторых, есть ли преимущество использования R для обслуживания ваших разделителей? Вы упомянули несколько различных методов, которые вы планируете использовать. Если разделители являются просто шумом для целей вашего анализа, почему бы не разделить работу на два инструмента и использовать инструмент, который намного лучше справляется с разделителями и линиями продолжения и т. Д.? Для меня Python - это естественный выбор, например, разбор кучи текста по ключевым словам, включая отключение разделителей и другие «шумовые» слова, которые вам не нужны в вашем анализе. Подайте результаты анализа Python на R и используйте R для своих сильных сторон.

Существует несколько различных способов получить вывод Python в R. Я бы предложил начать с чего-то простого: CSV-файлов. Это то, с чего вы начинаете, их легко читать и писать на Python и легко читать в R. Позже вы можете иметь дело с прямой трубой между Python и R, но это не дает вам много преимуществ, пока вы не будете работать прототип, и сначала это намного больше. Сделайте Python прочитанным в ваших исходных данных и получите CSV-файл, который R может упасть прямо в таблицу данных без дальнейшей обработки.

Что касается stri_extract, это действительно не тот инструмент, который вам нужен на этот раз. Вы, конечно, можете сочетаться с кучей разных слов, но на самом деле это не то, для чего оно оптимизировано. Я согласен с @Chris в том, что использование merge() в data.tables является гораздо более эффективным и быстрым способом поиска нескольких ключевых слов.