Несколько функций для нескольких столбцов по группам и создание информативных имен столбцов

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

library(dplyr)
iris %>% 
   group_by(Species) %>% 
  summarise_at(vars(Sepal.Length, Sepal.Width), .funs = c(sum=sum,mean= mean), na.rm=TRUE)

## A tibble: 3 x 5
#  Species    Sepal.Length_sum Sepal.Width_sum Sepal.Length_mean Sepal.Width_mean
#  <fct>                 <dbl>           <dbl>             <dbl>            <dbl>
#1 setosa                 245.            171.              5.00             3.43
#2 versicolor             297.            138.              5.94             2.77
#3 virginica              323.            149.              6.60             2.97

или используя ввод вектора символов для столбцов и функций:

Colchoice <- c("Sepal.Length", "Sepal.Width")
FunChoice <- c("mean", "sum")
iris %>% 
  group_by(Species) %>% 
  summarise_at(vars(Colchoice), .funs = setNames(FunChoice, FunChoice), na.rm=TRUE)
## A tibble: 3 x 5
#  Species    Sepal.Length_mean Sepal.Width_mean Sepal.Length_sum Sepal.Width_sum
#  <fct>                  <dbl>            <dbl>            <dbl>           <dbl>
#1 setosa                  5.00             3.43             245.            171.
#2 versicolor              5.94             2.77             297.            138.
#3 virginica               6.60             2.97             323.            149.

Вот ответ data.table:

funs_list <- lapply(FunChoice, as.symbol)
dcast(dt, category~1, fun=eval(funs_list), value.var = Colchoice)

Он супербыстрый и делает то, что вы хотите.

Рассмотрите возможность создания списка таблиц данных, в котором вы перебираете каждый ColChoice и применяете каждую функцию FuncChoice (задавая имена соответственно). Затем, чтобы объединить все таблицы данных вместе, запустите merge в вызове Reduce. Кроме того, используйте get для получения объектов среды (функций / столбцов).

Примечание: ColChoice был переименован для случая верблюда, а функция length заменяет .N для функциональной формы для подсчета:

set.seed(12212018)  # RUN BEFORE data.table() BUILD TO REPRODUCE OUTPUT
...

ColChoice <- c("c1", "c4")
FunChoice <- c("length", "mean", "sum")

output <- lapply(ColChoice, function(col)
                   dt[, setNames(lapply(FunChoice, function(f) get(f)(get(col))), 
                                 paste0(col, "_", FunChoice)), 
                      by=category]
          )

final_dt <- Reduce(function(x, y) merge(x, y, by = "category"), output)

head(final_dt)

#    category c1_length   c1_mean   c1_sum c4_length   c4_mean   c4_sum
# 1:        a      3893 10000.001 38930003      3893  9.990517 38893.08
# 2:        b      4021 10000.028 40210113      4021  9.977178 40118.23
# 3:        c      3931 10000.008 39310030      3931  9.996538 39296.39
# 4:        d      3954 10000.010 39540038      3954 10.004578 39558.10
# 5:        e      4016  9999.998 40159992      4016 10.002131 40168.56
# 6:        f      3974  9999.987 39739947      3974  9.994220 39717.03

Если я правильно понял, этот вопрос состоит из двух частей:

1. Как группировать и агрегировать с помощью нескольких функций по списку столбцов и автоматически генерировать новые имена столбцов.
2. Как передать имена функций как вектор символов.

Для части 1, это Около, дубликат Применение нескольких функций к нескольким столбцам в data.table, но с дополнительным требованием, что результаты должны быть сгруппированы с использованием by =.

Следовательно, Эдди ответ необходимо изменить, добавив параметр recursive = FALSE в вызове unlist():

my.summary = function(x) list(N = length(x), mean = mean(x), median = median(x))
dt[, unlist(lapply(.SD, my.summary), recursive = FALSE), 
   .SDcols = ColChoice, by = category]

    category c1.N   c1.mean c1.median c4.N   c4.mean c4.median
 1:        f 3974  9999.987  9999.989 3974  9.994220  9.974125
 2:        w 4033 10000.008  9999.991 4033 10.004261  9.986771
 3:        n 4025  9999.981 10000.000 4025 10.003686  9.998259
 4:        x 3975 10000.035 10000.019 3975 10.010448  9.995268
 5:        k 3957 10000.019 10000.017 3957  9.991886 10.007873
 6:        j 4027 10000.026 10000.023 4027 10.015663  9.998103
...

По части 2, нам нужно создать my.summary() из символьного вектора имен функций. Это может быть достигнуто с помощью "программирование на языке", то есть путем сборки выражения в виде символьной строки и, наконец, его синтаксического анализа и оценки:

my.summary <- 
  sapply(FunChoice, function(f) paste0(f, "(x)")) %>% 
  paste(collapse = ", ") %>% 
  sprintf("function(x) setNames(list(%s), FunChoice)", .) %>% 
  parse(text = .) %>% 
  eval()

my.summary

function(x) setNames(list(length(x), mean(x), sum(x)), FunChoice)
<environment: 0xe376640>

В качестве альтернативы, мы можем перебрать категории и rbind() результатов впоследствии:

library(magrittr)   # used only to improve readability
lapply(dt[, unique(category)],
       function(x) dt[category == x, 
                      c(.(category = x), unlist(lapply(.SD, my.summary))), 
                      .SDcols = ColChoice]) %>% 
  rbindlist()

Контрольный показатель

Пока что выложено 4 решения data.table и одно решение dplyr. По крайней мере, один из ответов утверждает, что он «сверхбыстрый». Итак, я хотел проверить тестом с различным количеством строк:

library(data.table)
library(magrittr)
bm <- bench::press(
  n = 10L^(2:6),
  {
    set.seed(12212018)
    dt <- data.table(
      index = 1:n,
      category = sample(letters[1:25], n, replace = T),
      c1 = rnorm(n, 10000),
      c2 = rnorm(n, 1000),
      c3 = rnorm(n, 100),
      c4 = rnorm(n, 10)
    )
    # use set() instead of <<- for appending additional columns
    for (i in 5:100) set(dt, , paste0("c", i), rnorm(n, 1000))
    tables()

    ColChoice <- c("c1", "c4")
    FunChoice <- c("length", "mean", "sum")
    my.summary <- function(x) list(length = length(x), mean = mean(x), sum = sum(x))
    
    bench::mark(
      unlist = {
        dt[, unlist(lapply(.SD, my.summary), recursive = FALSE),
           .SDcols = ColChoice, by = category]
      },
      loop_category = {
        lapply(dt[, unique(category)],
               function(x) dt[category == x, 
                              c(.(category = x), unlist(lapply(.SD, my.summary))), 
                              .SDcols = ColChoice]) %>% 
          rbindlist()
        },
      dcast = {
        dcast(dt, category ~ 1, fun = list(length, mean, sum), value.var = ColChoice)
        },
      loop_col = {
        lapply(ColChoice, function(col)
          dt[, setNames(lapply(FunChoice, function(f) get(f)(get(col))), 
                        paste0(col, "_", FunChoice)), 
             by=category]
        ) %>% 
          Reduce(function(x, y) merge(x, y, by = "category"), .)
      },
      dplyr = {
        dt %>% 
          dplyr::group_by(category) %>% 
          dplyr::summarise_at(dplyr::vars(ColChoice), .funs = setNames(FunChoice, FunChoice))
      },
      check = function(x, y) 
        all.equal(setDT(x)[order(category)], 
                  setDT(y)[order(category)] %>%  
                    setnames(stringr::str_replace(names(.), "_", ".")),
                  ignore.col.order = TRUE,
                  check.attributes = FALSE
                  )
    )  
  }
)

Результаты легче сравнить при нанесении на график:

library(ggplot2)
autoplot(bm)

Обратите внимание на логарифмическую шкалу времени.

Для этого тестового примера подход исключить из списка всегда является самым быстрым методом, за которым следует dcast. dplyr догоняет n большего размера. Оба подхода lapply / loop менее эффективны. В частности, Подход Парфе для перебора столбцов и последующего слияния подрезультатов кажется довольно чувствительным к размерам проблем n.

Обновлено: 2-й тест

Как было предложено Янгорецки, я повторил тест с гораздо большим количеством строк, а также с различным количеством групп. Из-за ограничений памяти самый большой размер проблемы составляет 10 M строк, умноженных на 102 столбца, что занимает 7,7 ГБ памяти.

Итак, первая часть кода теста изменена на

bm <- bench::press(
  n_grp = 10^(1:3),
  n_row = 10L^seq(3, 7, by = 2),
  {
    set.seed(12212018)
    dt <- data.table(
      index = 1:n_row,
      category = sample(n_grp, n_row, replace = TRUE),
      c1 = rnorm(n_row),
      c2 = rnorm(n_row),
      c3 = rnorm(n_row),
      c4 = rnorm(n_row, 10)
    )
    for (i in 5:100) set(dt, , paste0("c", i), rnorm(n_row, 1000))
    tables()
    ...

Как и ожидалось в Янгорецки, некоторые решения более чувствительны к количеству групп, чем другие. В частности, производительность loop_category ухудшается намного сильнее с увеличением количества групп, в то время как dcast, похоже, страдает меньше. Для меньшего количества групп подход исключить из списка всегда быстрее, чем dcast, в то время как для многих групп dcast быстрее. Однако для больших проблем исключить из списка, кажется, опережает dcast.

Изменить 2019-03-12: Вычисления на языке, 3-й тест

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

Выражение создано

library(magrittr)
ColChoice <- c("c1", "c4")
FunChoice <- c("length", "mean", "sum")
my.expression <- CJ(ColChoice, FunChoice, sorted = FALSE)[
  , sprintf("%s.%s = %s(%s)", V1, V2, V2, V1)] %>% 
  paste(collapse = ", ") %>% 
  sprintf("dt[, .(%s), by = category]", .) %>% 
  parse(text = .)
my.expression

expression(dt[, .(c1.length = length(c1), c1.mean = mean(c1), c1.sum = sum(c1), 
                  c4.length = length(c4), c4.mean = mean(c4), c4.sum = sum(c4)), by = category])

Затем это оценивается

eval(my.expression)

что дает

    category c1.length   c1.mean   c1.sum c4.length   c4.mean   c4.sum
 1:        f      3974  9999.987 39739947      3974  9.994220 39717.03
 2:        w      4033 10000.008 40330032      4033 10.004261 40347.19
 3:        n      4025  9999.981 40249924      4025 10.003686 40264.84
 4:        x      3975 10000.035 39750141      3975 10.010448 39791.53
 5:        k      3957 10000.019 39570074      3957  9.991886 39537.89
 6:        j      4027 10000.026 40270106      4027 10.015663 40333.07
 ...

Я изменил код 2-го теста, чтобы включить этот подход, но мне пришлось уменьшить количество дополнительных столбцов со 100 до 25, чтобы справиться с ограничениями памяти на гораздо меньшем ПК. График показывает, что подход eval почти всегда самый быстрый или второй:

Если сводные статистические данные, которые вам необходимо вычислить, представляют собой такие вещи, как mean, .N и (возможно) median, которые data.table оптимизирует в код c по ходу времени, у вас может быть более высокая производительность, если вы преобразуете таблицу в длинную форму, чтобы вы могли выполнять вычисления таким образом, чтобы таблица данных могла их оптимизировать:

> library(data.table)
> n = 100000
> dt  = data.table(index=1:100000,
                   category = sample(letters[1:25], n, replace = T),
                   c1=rnorm(n,10000),
                   c2=rnorm(n,1000),
                   c3=rnorm(n,100),
                   c4 = rnorm(n,10)
  )
> {lapply(c(paste('c', 5:100, sep ='')), function(addcol) dt[[addcol]] <<- rnorm(n,1000) ); dt}

> Colchoice <- c("c1", "c4")

> dt[, .SD
     ][, c('index', 'category', Colchoice), with=F
     ][, melt(.SD, id.vars=c('index', 'category'))
     ][, mean := mean(value), .(category, variable)
     ][, median := median(value), .(category, variable)
     ][, N := .N, .(category, variable)
     ][, value := NULL
     ][, index := NULL
     ][, unique(.SD)
     ][, dcast(.SD, category ~ variable, value.var=c('mean', 'median', 'N') 
     ]

    category mean_c1 mean_c4 median_c1 median_c4 N_c1 N_c4
 1:        a   10000  10.021     10000    10.041 4128 4128
 2:        b   10000  10.012     10000    10.003 3942 3942
 3:        c   10000  10.005     10000     9.999 3926 3926
 4:        d   10000  10.002     10000    10.007 4046 4046
 5:        e   10000   9.974     10000     9.993 4037 4037
 6:        f   10000  10.025     10000    10.015 4009 4009
 7:        g   10000   9.994     10000     9.998 4012 4012
 8:        h   10000  10.007     10000     9.986 3950 3950
...