Ускорить применение с пользовательской функцией, преобразовать в lapply? - PullRequest
1 голос
/ 25 января 2020

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

Сейчас я использую apply () с пользовательской функцией. Насколько я понимаю, что lapply () или sapply () будут быстрее (и, в конечном счете, разрешат распараллеливание, хотя я бы предпочел ускорение, не зависящее от параллельной обработки), но я не могу понять, что такое lapply () или sapply ( ) синтаксис, который я должен использовать с моей пользовательской функцией. Если есть еще более простой способ векторизации пользовательской функции и вообще избегать * apply (), это было бы предпочтительным.

Количество строк в моем случае использования будет 1 миллион или больше, а количество столбцов будет около 15, но вот MWE, который иллюстрирует проблему скорости:

# Two data frames that will be used in the calculation. d2 can be a matrix, but d1 must be a data frame.
d1 <- data.frame(V1 = runif(1000), V2 = runif(1000), V3 = runif(1000), V4 = runif(1000))
d2 <- data.frame(Va = runif(3), V1 = runif(3), V2 = runif(3), V3 = runif(3), V4 = runif(3))

# Custom function that is applied to each row in d1
manualprob <- function(x){

    xb1 <- as.numeric(rowSums(d2[1,2:ncol(d2)] * x) + d2[1,1])
    xb2 <- as.numeric(rowSums(d2[2,2:ncol(d2)] * x) + d2[2,1])
    xb3 <- as.numeric(rowSums(d2[3,2:ncol(d2)] * x) + d2[3,1])

    denom <- 1 + exp(xb1) + exp(xb2) + exp(xb3)
    prob <- exp(xb1)/denom

    return(prob)
    }

# apply() used below, but it is too slow
start_time <- proc.time()

d1$prob <- as.vector(apply(d1, 1, manualprob))

proc.time() - start_time
   user  system elapsed 
  1.081   0.007   1.088 

1 Ответ

3 голосов
/ 25 января 2020

Лучше всего конвертировать в матрицы и использовать очень быстрые матричные операции R ...

Вы можете создать все цифры xb за одну go с помощью

xb <- as.matrix(d2[, -1]) %*% t(as.matrix(d1)) + d2[, 1]

Это дает матрицу 3 * 1000.

И затем вы можете получить вероятности с помощью

prob <- exp(xb[1, ]) / (1 + colSums(exp(xb)))

Это все занимает почти нулевое время на моей машине!

...