Самый быстрый способ сопоставить несколько символьных столбцов с числовыми значениями

Question

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

Таблица значений -

d1 <- data.frame(x = sample(LETTERS, N, replace = TRUE), 
                  y1=rnorm(N))
head(d1)
#   x         y1
# 1 H -0.7852538
# 2 G -0.6739159
# 3 V -1.7783771
# 4 L -0.2849846
# 5 I -0.1760284
# 6 V -0.2785826

Я могу рассчитать средние значения (несколькими способами: dplyr, data.table и tapply). У меня есть еще один data.frame, состоящий из двух столбцов с именами групп.

d2 <- data.frame('group.high' = sample(LETTERS, N * 2, replace = TRUE), 
                 'group.low' = sample(LETTERS, N * 2, replace = TRUE))
head(d2)
#   group.high group.low
# 1          U         L
# 2          K         J
# 3          C         Q
# 4          Q         A
# 5          Q         U
# 6          K         W

Я хочу добавить к столбцам mean.high и mean.better средних значений каждой группы на основе d1.

До сих пор я пробовал два варианта из dplyr и data.table. Мне пришлось использовать left_join дважды в любом из них. Они оба похожи по скорости.

microbenchmark(
  dplyr = {
  means <- tapply(d1$y1, INDEX = d1$x, FUN = mean)
  ### Solution 1 
  dplyr.d2 <- left_join(d2,data.frame('group.high' = names(means), 
                                      'mean.high' = means, stringsAsFactors = FALSE) ) %>%  
    left_join(., data.frame('group.low' = names(means), 
                            'mean.low' = means, stringsAsFactors = FALSE))},
  data.table = {
  ### Solution 2 
  d1    <- as.data.table(d1)
  d2    <- as.data.table(d2)
  means <- d1[ ,.(means = mean(y1)), by = x]
  new.d2 <- data.table::merge.data.table(x = d2, y = means, by.x = 'group.high', by.y = 'x')
  data.table.d2 <- data.table::merge.data.table(x = new.d2, y = means, by.x = 'group.low', by.y = 'x')
  }
)

Unit: milliseconds
       expr     min       lq     mean  median       uq      max neval cld
      dplyr 34.0837 36.88650 53.22239 42.9227 47.50660 231.5066   100  a 
 data.table 40.2071 47.70735 87.46804 51.2517 59.05385 258.4999   100   b

Есть ли лучший способ? Как я могу ускорить расчет?

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

N <- 10000

iterFuncDplyr <- function(d1, d2) { 
  dplyr.d2 <- left_join(d2,data.frame('group.high' = names(means), 
                                      'mean.high' = means, stringsAsFactors = FALSE) ) %>%  
    left_join(., data.frame('group.low' = names(means), 
                            'mean.low' = means, stringsAsFactors = FALSE))
  return(var(d1$y1))
}

iterFuncData <- function(d1, d2) { 
  means <- d1[ ,.(means = mean(y1)), by = x]
  new.d2 <- data.table:::merge.data.table(x = d2, y = means, by.x = 'group.high', by.y = 'x')
  data.table.d2 <- data.table:::merge.data.table(x = new.d2, y = means, by.x = 'group.low', by.y = 'x')
  return(var(d1$y1))
}


d1 <- data.frame(x = sample(LETTERS, N, replace = TRUE), 
                 y1=rnorm(N))

d2 <- data.frame('group.high' = sample(LETTERS, N * 2, replace = TRUE), 
                 'group.low' = sample(LETTERS, N * 2, replace = TRUE))

library(data.table)
library(dplyr)

microbenchmark::microbenchmark(dplyr = {
temp.val <- 0 

for (i in 1:10) {
  d1$y1 <- temp.val + rnorm(N)
  temp.val <- iterFuncDplyr(d1, d2)
}},
data.table = {
d1    <- as.data.table(d1)
d2    <- as.data.table(d2)

temp.val <- 0 

for (i in 1:10) {
  d1$y1 <- temp.val + rnorm(N)
  temp.val <- iterFuncData(d1, d2)
}
}
)

Unit: milliseconds
       expr      min       lq     mean   median       uq      max neval
      dplyr 46.22904 50.67959 52.78275 51.96358 53.34825 108.2874   100
 data.table 63.81111 67.13257 70.85537 69.85712 72.72446 127.4228   100

Answer 1

Вы можете установить подмножество именованного вектора means, чтобы создать новые столбцы и сопоставить ваши выходные данные:

means <- tapply(d1$y1, INDEX = d1$x, FUN = mean)
d2$mean.high <- means[d2$group.high]
d2$mean.low <- means[d2$group.low]

identical(as.matrix(d2), as.matrix(d3)) #factor vs character, used d3 w/ benchmark
[1] TRUE

Unit: microseconds
       expr    min      lq      mean   median       uq     max neval
      dplyr 4868.2 5316.25  5787.123  5524.15  5892.70 12187.3   100
 data.table 8254.4 9606.60 10438.424 10118.35 10771.75 20966.5   100
     subset  481.2  529.40   651.194   550.35   582.55  7849.9   100

Код теста :

d3 <- d2

microbenchmark::microbenchmark( # N = 10000
  dplyr = {
    means <- tapply(d1$y1, INDEX = d1$x, FUN = mean)
    ### Solution 1 
    dplyr.d2 <- left_join(d2,data.frame('group.high' = names(means), 
                                        'mean.high' = means, stringsAsFactors = FALSE) ) %>%  
      left_join(., data.frame('group.low' = names(means), 
                              'mean.low' = means, stringsAsFactors = FALSE))},
  data.table = {
    ### Solution 2 
    d1    <- as.data.table(d1)
    d2    <- as.data.table(d2)
    means <- d1[ ,.(means = mean(y1)), by = x]
    new.d2 <- data.table::merge.data.table(x = d2, y = means, by.x = 'group.high', by.y = 'x')
    data.table.d2 <- data.table::merge.data.table(x = new.d2, y = means, by.x = 'group.low', by.y = 'x')
  },
  subset = {
    means <- tapply(d1$y1, INDEX = d1$x, FUN = mean)
    d3$mean.high <- means[d2$group.high]
    d3$mean.low <- means[d2$group.low]

  }
)

Answer 2

Вот ответ, очень похожий на ответ Эндрю, но основанный на data.table вместо tapply() (что кажется очень быстрым для очень больших N).

library(data.table)
# Create a named vector "means"
means <- setDT(d1)[, mean(y1), by = x][, setNames(V1, x)]
setDT(d2)[, c("mean.high.means", "mean.low.means") := 
              .(means[as.character(group.high)], means[as.character(group.low)])]

Вывод:

        group.high group.low mean.high.means mean.low.means
     1:          Z         W     0.017032792   0.0091625547
     2:          A         A     0.013796137   0.0137961371
     3:          V         S    -0.011570159   0.0004560325
     4:          D         X     0.005475629   0.0200984250
     5:          U         H    -0.008249901   0.0054537833
    ---                                                    
199996:          H         K     0.005453783   0.0079905631
199997:          A         T     0.013796137  -0.0068537963
199998:          W         U     0.009162555  -0.0082499015
199999:          T         V    -0.006853796  -0.0115701585
200000:          G         J     0.014829259   0.0206598470

Воспроизводимые данные:

N = 1e5
set.seed(1) 
d1 <- data.frame(
  x  = sample(LETTERS, N, replace = TRUE), 
  y1 = rnorm(N)
) 
d2 <- data.frame(
  group.high = sample(LETTERS, N * 2, replace = TRUE), 
  group.low  = sample(LETTERS, N * 2, replace = TRUE)
)