lapply vs for loop - Производительность R

Question

Часто говорят, что следует предпочесть lapply за for петель. Есть некоторые исключения, как, например, Хэдли Уикхэм указывает в своей книге «Advance R».

(http://adv-r.had.co.nz/Functionals.html) (Изменение на месте, рекурсия и т. Д.). Ниже приведено одно из этих случаев.

Для изучения я попытался переписать алгоритм персептрона в функциональной форме для сравнения относительной производительности . источник (https://rpubs.com/FaiHas/197581).

Вот код.

# prepare input 
data(iris) 
irissubdf <- iris[1:100, c(1, 3, 5)] 
names(irissubdf) <- c("sepal", "petal", "species") 
head(irissubdf) 
irissubdf$y <- 1 
irissubdf[irissubdf[, 3] == "setosa", 4] <- -1 
x <- irissubdf[, c(1, 2)] 
y <- irissubdf[, 4] 

# perceptron function with for 
perceptron <- function(x, y, eta, niter) { 

    # initialize weight vector 
    weight <- rep(0, dim(x)[2] + 1) 
    errors <- rep(0, niter) 


    # loop over number of epochs niter 
    for (jj in 1:niter) { 

    # loop through training data set 
    for (ii in 1:length(y)) { 

     # Predict binary label using Heaviside activation 
     # function 
     z <- sum(weight[2:length(weight)] * as.numeric(x[ii, 
     ])) + weight[1] 
     if (z < 0) { 
     ypred <- -1 
     } else { 
     ypred <- 1 
     } 

     # Change weight - the formula doesn't do anything 
     # if the predicted value is correct 
     weightdiff <- eta * (y[ii] - ypred) * c(1, 
     as.numeric(x[ii, ])) 
     weight <- weight + weightdiff 

     # Update error function 
     if ((y[ii] - ypred) != 0) { 
     errors[jj] <- errors[jj] + 1 
     } 

    } 
    } 

    # weight to decide between the two species 

    return(errors) 
} 

err <- perceptron(x, y, 1, 10) 

### my rewriting in functional form auxiliary 
### function 
faux <- function(x, weight, y, eta) { 
    err <- 0 
    z <- sum(weight[2:length(weight)] * as.numeric(x)) + 
    weight[1] 
    if (z < 0) { 
    ypred <- -1 
    } else { 
    ypred <- 1 
    } 

    # Change weight - the formula doesn't do anything 
    # if the predicted value is correct 
    weightdiff <- eta * (y - ypred) * c(1, as.numeric(x)) 
    weight <<- weight + weightdiff 

    # Update error function 
    if ((y - ypred) != 0) { 
    err <- 1 
    } 
    err 
} 

weight <- rep(0, 3) 
weightdiff <- rep(0, 3) 

f <- function() { 
    t <- replicate(10, sum(unlist(lapply(seq_along(irissubdf$y), 
    function(i) { 
     faux(irissubdf[i, 1:2], weight, irissubdf$y[i], 
     1) 
    })))) 
    weight <<- rep(0, 3) 
    t 
} 

Я не ожидал никакого последовательного улучшения в связи с вышеупомянутыми вопросов. Но тем не менее я был очень удивлен, когда увидел резкое ухудшение , используя lapply и replicate.

Я получил этот результат с помощью функции microbenchmarkmicrobenchmark из библиотеки

Что может быть причины? Может ли это быть утечка памяти?

             expr  min   lq  mean  median   uq 
                 f() 48670.878 50600.7200 52767.6871 51746.2530 53541.2440 
    perceptron(as.matrix(irissubdf[1:2]), irissubdf$y, 1, 10) 4184.131 4437.2990 4686.7506 4532.6655 4751.4795 
perceptronC(as.matrix(irissubdf[1:2]), irissubdf$y, 1, 10) 95.793 104.2045 123.7735 116.6065 140.5545 
     max neval 
109715.673 100 
    6513.684 100 
    264.858 100 

Первая функция является функцией lapply/replicate

Вторая функция с for петель

В-третьих, та же функция в C++ с помощью Rcpp

Здесь Согласно Roland профилирование функции. Я не уверен, что смогу правильно интерпретировать его. Похоже мне большую часть времени тратится на Подменю Function profiling

Answer 1

Прежде всего, это уже давно развенчали миф о том, for петли медленнее, чем lapply. Петли for в R были сделаны намного более результативными и в настоящее время не менее быстрыми, чем lapply.

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

lapply - функция, которую вы должны использовать для своих побочных эффектов (или отсутствия побочных эффектов). Функция lapply автоматически объединяет результаты в список и не вмешивается в среду, в которой вы работаете, в отличие от цикла for. То же самое касается replicate. Смотрите также вопрос:

Is R's apply family more than syntactic sugar?

Причина ваше решение lapply гораздо медленнее, потому что ваш способ использования его создает гораздо больше накладных расходов.

• replicate не что иное, как sapply внутренне, так что вы на самом деле объединить sapply и lapply реализовать свой двойной цикл. sapply создает дополнительные накладные расходы, поскольку он должен проверить, можно ли упростить результат. Таким образом, цикл for будет на самом деле быстрее, чем при использовании replicate.
• в вашей анонимной функции lapply, вы должны получить доступ к кадру данных как для x, так и для каждого наблюдения. Это означает, что - в отличие от вашего for-loop - например, функция $ должна вызываться каждый раз.
• Поскольку вы используете эти высокого класса функций, ваш «lapply» решение требует 49 функций, по сравнению с вашим for решение, которое только вызовы 26. Эти дополнительные функции для lapply решения включают в себя вызовы функций, таких как match, structure, [[, names , %in%, sys.call, duplicated, ... Все функции, которые не нужны вашей петле for, так как она не выполняет ни одну из этих проверок.

Если вы хотите, чтобы увидеть, где это дополнительные накладные расходы приходит, взглянуть на внутренний код replicate, unlist, sapply и simplify2array.

Вы можете использовать следующий код, чтобы получить лучшее представление о том, где вы теряете свою производительность с помощью lapply. Запустите эту строку за строкой!

Rprof(interval = 0.0001) 
f() 
Rprof(NULL) 
fprof <- summaryRprof()$by.self 

Rprof(interval = 0.0001) 
perceptron(as.matrix(irissubdf[1:2]), irissubdf$y, 1, 10) 
Rprof(NULL) 
perprof <- summaryRprof()$by.self 

fprof$Fun <- rownames(fprof) 
perprof$Fun <- rownames(perprof) 

Selftime <- merge(fprof, perprof, 
        all = TRUE, 
        by = 'Fun', 
        suffixes = c(".lapply",".for")) 

sum(!is.na(Selftime$self.time.lapply)) 
sum(!is.na(Selftime$self.time.for)) 
Selftime[order(Selftime$self.time.lapply, decreasing = TRUE), 
     c("Fun","self.time.lapply","self.time.for")] 

Selftime[is.na(Selftime$self.time.for),]