Более быстрый способ суммирования переменных на основе столбца в R

Я хочу обобщить некоторые переменные в моем кадре данных на основе столбца. Однако мой кадр данных довольно большой ( > 30 000 000 строк), и использование функции суммирования в dplyr требует возраста для запуска. Есть ли более быстрый способ в R ускорить процесс суммирования?

У меня есть формат данных df в формате:

  proid  X1  X2  X3 X4
1     1  zz   a   e  a
2     2  ff   g   z  b
3     1  cd   s   f  d 
4     3  ab   t   e  e
5     2  ta   b   h  k
      ....

Я хочу объединить переменные X1-X4, когда они имеют одинаковое значение prodid. Конкатенированные строки разделяются запятыми. Поэтому приведенная выше таблица должна дать мне новую таблицу:

  proid     X1   X2   X3  X4
1     1  zz,cd  a,s  e,f a,d 
2     2  ff,ta  g,b  z,h b,k
3     3     ab    t    e   e
      ....

Я использовал следующий код dplyr:

concat <- function(x){
  x <- na.omit(x)
  if(length(x)==0){
    return(as.character(NA))
  }else{
    return(paste(x,collapse=","))
  }
}

dg<-group_by(df,proid)
df<-summarise(dg,proid,concat(X1),concat(X2),concat(X3),concat(X4))

Ответы

Ответ 1

Отредактируйте примечание: удалили оригинальную часть моего ответа, которая не обращалась к методу NA и добавила контрольную отметку.

concat2 <- function(x) if(all(is.na(x))) NA_character_ else paste(na.omit(x), collapse = ",")

Использование data.table:

setDT(df)[, lapply(.SD, concat2), by = proid, .SDcols = -c("X4")]
#   proid    X1  X2  X3
#1:     1 zz,cd a,s e,f
#2:     2 ff,ta g,b z,h
#3:     3    NA   t   e

Использование dplyr:

df %>% group_by(proid) %>% summarise_each(funs(concat2), -X4)

Benchmark, меньшие данные, чем в фактическом прецеденте, и не полностью репрезентативные, поэтому просто хотелось получить впечатление, как concat2 сравнивается с concat и т.д.

library(microbenchmark)
library(dplyr)
library(data.table)

N <- 1e6
x <- c(letters, LETTERS)
df <- data.frame(
  proid = sample(1e4, N, TRUE),
  X1 = sample(sample(c(x, NA), N, TRUE)),
  X2 = sample(sample(c(x, NA), N, TRUE)),
  X3 = sample(sample(c(x, NA), N, TRUE)),
  X4 = sample(sample(c(x, NA), N, TRUE))
  )

dt <- as.data.table(df)

concat <- function(x){
  x <- na.omit(x)
  if(length(x)==0){
    return(as.character(NA))
  }else{
    return(paste(x,collapse=","))
  }
}

concat2 <- function(x) if(all(is.na(x))) NA_character_ else paste(na.omit(x), collapse = ",")

concat.dplyr <- function(){
  df %>% group_by(proid) %>% summarise_each(funs(concat), -X4)
}

concat2.dplyr <- function(){
  df %>% group_by(proid) %>% summarise_each(funs(concat2), -X4)
}

concat.data.table <- function(){
  dt[, lapply(.SD, concat), by = proid, .SDcols = -c("X4")]
}

concat2.data.table <- function(){
  dt[, lapply(.SD, concat2), by = proid, .SDcols = -c("X4")]
}


microbenchmark(concat.dplyr(), 
               concat2.dplyr(), 
               concat.data.table(), 
               concat2.data.table(),
               unit = "relative",
               times = 10L)
Unit: relative
                 expr      min       lq   median       uq      max neval
       concat.dplyr() 1.058839 1.058342 1.083728 1.105907 1.080883    10
      concat2.dplyr() 1.057991 1.065566 1.109099 1.145657 1.079201    10
  concat.data.table() 1.024101 1.018443 1.093604 1.085254 1.066560    10
 concat2.data.table() 1.000000 1.000000 1.000000 1.000000 1.000000    10

Выводы: data.table выполняет бит немного быстрее, чем dplyr на данных образца, а concat2 - немного быстрее, чем concat. Однако различия в этом наборе выборочных данных остаются незначительными.

Ответ 2

na.omit выполняет тонну ненужных проверок и операций. Замена его простым вызовом is.na даст вам приличное ускорение:

concat3 = function(x) {
  x = x[!is.na(x)]
  if (length(x) == 0)
    NA_character_
  else
    paste(x, collapse = ",")
}

Использование данных docendo (но со строками вместо факторов - факторы замедляют все версии вниз):

microbenchmark(dt[, lapply(.SD, concat3), by = proid, .SDcols = -c("X4")],
               dt[, lapply(.SD, concat2), by = proid, .SDcols = -c("X4")],
               times = 5)
#Unit: milliseconds
#                                                       expr       min       lq     mean   median       uq      max neval
# dt[, lapply(.SD, concat3), by = proid, .SDcols = -c("X4")]  960.2475 1079.177 1251.545 1342.684 1402.571 1473.045     5
# dt[, lapply(.SD, concat2), by = proid, .SDcols = -c("X4")] 1718.8121 1892.696 2159.148 2171.772 2470.205 2542.253     5