Заменить функцию apply на lapply

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

Первый набор данных (df1) выглядит так:

   word1    word2               pattern
   air      10     (^|\\s)air(\\s.*)?\\s10($|\\s)
 airport    20   (^|\\s)airport(\\s.*)?\\s20($|\\s)
   car      30     (^|\\s)car(\\s.*)?\\s30($|\\s)

Другой набор данных (df2), из которого я хочу сопоставить, выглядит так:

   sl_no    query
   1      air 10     
   2    airport 20   
   3    airport 20
   3    airport 20
   3      car 30

Окончательный результат, который я хочу, должен выглядеть так: word1 word2 total_occ air 10 1 airport 20 3 car 30 1

Я могу сделать это, используя apply в R

process <- 
function(x) 
{
  length(grep(x[["pattern"]], df2$query))
}           

df1$total_occ=apply(df1,1,process)

но на это уходит время, так как мой набор данных довольно большой.

Я обнаружил, что функцию "mclapply" пакета "parallel" можно использовать для запуска таких вещей на многоядерных компьютерах, для которых я сначала пытаюсь запустить lapply. Это дает мне ошибку, говоря

lapply(df,process)

Ошибка в x [, "pattern"]: неверное количество измерений

Пожалуйста, дайте мне знать, какие изменения я должен внести, чтобы работать нормально.


r apply lapply mclapply
person HoneyBadger    schedule 17.06.2015    source источник
comment
Вы повторяете шаблоны, так что это должен быть ваш первый аргумент для lapply, верно?   -  person Frank    schedule 17.06.2015
comment
Вот почему вы получаете эту ошибку: lapply применит некоторую функцию к каждому элементу списка по очереди; поэтому функция должна иметь возможность работать с элементами списка. Элементами в этом контексте фрейма данных являются его столбцы, поэтому вы просите R применить process к каждому столбцу df.   -  person tegancp    schedule 17.06.2015

Ответы (1)


arrow_upward
3
arrow_downward

Почему не просто lapply() вместо pattern?

Вот я только что вытащил ваш pattern, но с таким же успехом это может быть df$pattern

pattern <- c("(^|\\s)air(\\s.*)?\\s10($|\\s)",
             "(^|\\s)airport(\\s.*)?\\s20($|\\s)",
             "(^|\\s)car(\\s.*)?\\s30($|\\s)")

Использование ваших данных для df2

txt <- "sl_no    query
   1      'air 10'     
   2    'airport 20'   
   3    'airport 20'
   3    'airport 20'
   3      'car 30'"
df2 <- read.table(text = txt, header = TRUE)

Просто выполните итерацию по pattern напрямую

> lapply(pattern, grep, x = df2$query)
[[1]]
[1] 1

[[2]]
[1] 2 3 4

[[3]]
[1] 5

Если вам нужен более компактный вывод, как предлагается в вашем вопросе, вам нужно запустить lengths() поверх возвращенного вывода (спасибо @Frank за указание на новую функцию lengths().)). Например

lengths(lapply(pattern, grep, x = df2$query))

который дает

> lengths(lapply(pattern, grep, x = df2$query))
[1] 1 3 1

Вы можете добавить это к исходным данным через

dfnew <- cbind(df1[, 1:2],
               Count = lengths(lapply(pattern, grep, x = df2$query)))
person Gavin Simpson    schedule 17.06.2015
comment
А потом lengths об этом, если у них последняя версия R - person Frank; 17.06.2015
comment
@Frank Yup; Я просто заметил эту часть Q, поскольку ее не было в разметке. Добавил это сейчас. - person Gavin Simpson; 17.06.2015
comment
Хм, я вижу, вы добавили версию с length, но вы можете сохранить исходный способ и просто обернуть его новой функцией lengths, например lengths(lapply(...etc...)) - person Frank; 17.06.2015
comment
@Frank +1 Я не знал о lengths()! Спасибо за предупреждение об этой новой функции. Обновлю ответ. (Когда lengths() попал в R?) - person Gavin Simpson; 17.06.2015
comment
Просто в 3.2.0. Я видел, как кто-то показал, что это намного быстрее, чем sapply(x,length), но в основном это действительно удобно. - person Frank; 17.06.2015
comment
Да, действительно удобно. Нужно решить, стоит ли использовать это в некоторых моих пакетах. Очистит некоторый код, но за счет зависимости от R 3.2.0 ... - person Gavin Simpson; 17.06.2015
comment
@Gavin - Спасибо за подробное решение, это именно то, что я хотел сделать. Это просто избавило меня от необходимости копаться :) - person HoneyBadger; 17.06.2015