web-dev-qa-db-fra.com

lapply vs for loop - Performance R

On dit souvent qu'il faut préférer lapply à for boucles . Il y a quelques exceptions, comme par exemple Hadley Wickham dans son livre Advance R.

( http://adv-r.had.co.nz/Functionals.html ) (modification sur place, récursivité, etc.) . Voici un exemple de ce cas.

Juste pour apprendre, j’ai essayé de réécrire un algorithme de perceptron sous une forme fonctionnelle afin de comparer les performances Relatives ..__ source ( https://rpubs.com/FaiHas/197581 ).

Voici le code.

# 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
}

Je ne m'attendais pas à une amélioration constante en raison des problèmes susmentionnés Mais néanmoins, j’ai été vraiment surpris quand j’ai vu la forte aggravation Utiliser lapply et replicate.

J'ai obtenu ces résultats en utilisant la fonction microbenchmark de la bibliothèque microbenchmark

Quelles pourraient être les raisons? Pourrait-il s'agir d'une fuite de mémoire?

                                                      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

La première fonction est la fonction lapplyreplicate

La seconde est la fonction avec for boucles 

La troisième est la même fonction dans C++ en utilisant Rcpp

Voici, selon Roland, le profilage de la fonction . Je ne suis pas sûr de pouvoir l’interpréter de la bonne façon . Il me semble que la plupart du temps est consacré au sous-ensemble _/Profilage de la fonction

14
Federico Manigrasso

Tout d’abord, le mythe selon lequel les boucles for sont plus lentes que lapply est déjà très ancien. Les boucles for dans R ont été rendues beaucoup plus performantes et sont actuellement au moins aussi rapides que lapply.

Cela dit, vous devez repenser votre utilisation de lapply ici. Votre implémentation nécessite une affectation à l'environnement global, car votre code vous demande de mettre à jour le poids pendant la boucle. Et c’est une raison valable pour ne pas considérer lapply.

lapply est une fonction à utiliser pour ses effets secondaires (ou son absence d'effets secondaires). La fonction lapply combine automatiquement les résultats dans une liste et ne modifie pas l'environnement dans lequel vous travaillez, contrairement à une boucle for. Il en va de même pour replicate. Voir aussi cette question: 

Est-ce que la famille de R s'applique plus au sucre syntaxique?

Si votre solution lapply est beaucoup plus lente, c'est parce que votre façon de l'utiliser crée beaucoup plus de temps système.

  • replicate n'est rien d'autre que sapply en interne, vous combinez donc sapply et lapply pour implémenter votre double boucle. sapply crée une surcharge supplémentaire car il doit vérifier si le résultat peut être simplifié ou non. Ainsi, une boucle for sera en réalité plus rapide que d'utiliser replicate.
  • dans votre fonction anonyme lapply, vous devez accéder au cadre de données à la fois pour x et y pour chaque observation. Cela signifie que, contrairement à votre boucle for, la fonction $ doit être appelée à chaque fois.
  • Comme vous utilisez ces fonctions haut de gamme, votre solution "lapply" appelle 49 fonctions, par rapport à votre solution for qui n'appelle que 26. Ces fonctions supplémentaires pour la solution lapply comprennent des appels à des fonctions telles que match, structure, [[, names, %in%sys.call, duplicated, ... Toutes les fonctions non nécessaires à votre boucle for car celle-ci ne fait aucune de ces vérifications.

Si vous voulez voir d'où provient cette surcharge supplémentaire, examinez les codes internes replicate, unlist, sapply et simplify2array

Vous pouvez utiliser le code suivant pour avoir une meilleure idée de l'endroit où vous perdez votre performance avec la variable lapply. Exécutez cette ligne par ligne!

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),]
31
Joris Meys

Réellement,

J'ai testé la différence avec un problème qui a été résolu récemment.

Essayez vous-même.

En conclusion, je n’ai aucune différence, si ce n’est la dernière fois que mon cas était plus rapide que lapply.

Ps: J'essaie surtout de garder la même logique en cours d'utilisation.

ds <- data.frame(matrix(rnorm(1000000), ncol = 8))  
n <- c('a','b','c','d','e','f','g','h')  
func <- function(ds, target_col, query_col, value){
  return (unique(as.vector(ds[ds[query_col] == value, target_col])))  
}  

f1 <- function(x, y){
  named_list <- list()
  for (i in y){
    named_list[[i]] <- func(x, 'a', 'b', i)
  }
  return (named_list)
}

f2 <- function(x, y){
  list2 <- lapply(setNames(nm = y), func, ds = x, target_col = "a", query_col = "b")
  return(list2)
}

benchmark(f1(ds2, n ))
benchmark(f2(ds2, n ))

Comme vous avez pu le constater, j’ai réalisé une routine simple pour créer une liste de noms (named_list) basée sur un cadre de données. La fonction func utilise les valeurs de colonne extraites, la boucle f1 utilise une boucle for pour parcourir le cadre de données et la fonction f2 utilise une fonction lapply.

Dans mon ordinateur, j'obtiens ces résultats: 

test replications elapsed relative user.self sys.self user.child
1 f1(ds2, n)          100  110.24        1   110.112        0          0
  sys.child
1         0

&&

        test replications elapsed relative user.self sys.self user.child
1 f1(ds2, n)          100  110.24        1   110.112        0          0
  sys.child
1         0
0
Aureliano Guedes