Dans le cadre d'une formation je souhaite montrer que pour résoudre un même problème différentes possibilités s'offrent à nous, avec plus ou moins d'efficacité. Pour ça je pars d'un data.frame 1000 * 1000, avec pour but de calculer la moyenne de chacune des colonnes.
Les objectifs sont de montrer :
1. quelques possibilités avec des fonctions de bases et des fonctions importées de différentes librairies
2. que bien programmer ou bien choisir sa fonction à un impact sur le temps de calcul.
3. que la nature de l'objet sur lequel on travaille est importante
J'ai commencé à recenser plusieurs façons de faire, avec des boucles, des fonctions de bases de type lapply et des fonctions faisant appel à des librairies souvent réputées pour être efficaces (plyr, dplyr). Après il y a surement des tas de librairie que je ne connais pas qui propose ce genre de calculs.
Est-ce que vous verriez d'autres possibilités ? Des plus efficaces ? Ou des exemples de ce qui ne faut vraiment pas faire (summarise_each et apply sont de mauvais élèves ;-))
Code : Tout sélectionner
require(microbenchmark)
require(plyr)
require(dplyr)
require(data.table)
require(matrixStats)
require(iterators)
set.seed(100)
tab <- as.data.frame(matrix(rnorm(1e6), 1e3))
tab2 <- as.matrix(tab)
tab3 <- as.data.table(tab)
nr <- nrow(tab)
nc <- ncol(tab)
f <- function(x) .Internal(mean(x))
f2 <- function(x) sum(x)/length(x)
auxi <- names(tab)
auxi <- sprintf("%s = sum(%s)", auxi, auxi)
auxi <- paste(auxi, collapse=",")
auxi <- paste("summarise(tab,", auxi, ")", sep="")
auxi <- parse(text=auxi)
res <- microbenchmark(
Lapply = res <- unlist(lapply(tab, mean)),
Lapply2 = res <- unlist(lapply(tab, f)),
Lapply3 = res <- unlist(lapply(tab, f2)),
Lapply4 = res <- unlist(lapply(tab, sum))/nr,
Lapply5 = res <- unlist(lapply(tab, sum))/nrow(tab),
Sapply = res <- sapply(tab, mean),
Sapply2 = res <- sapply(tab, f),
Sapply3 = res <- sapply(tab, f2),
Sapply4 = res <- sapply(tab, sum)/nr,
Sapply5 = res <- sapply(tab, sum)/nrow(tab),
Apply = res <- apply(tab, 2, mean),
Apply2 = res <- apply(tab, 2, f),
Apply3 = res <- apply(tab, 2, f2),
Apply4 = res <- apply(tab, 2, sum)/nr,
Apply5 = res <- apply(tab, 2, sum)/nrow(tab),
Apply.2 = res <- apply(tab, 2, mean),
Apply2.2 = res <- apply(tab2, 2, f),
Apply3.2 = res <- apply(tab2, 2, f2),
Apply4.2 = res <- apply(tab2, 2, sum)/nr,
Apply5.2 = res <- apply(tab2, 2, sum)/nrow(tab2),
Vapply = {res <- vapply(seq_along(tab),
function(x) mean(tab[[x]]), numeric(1))},
Vapply2 = {res <- vapply(seq_along(tab),
function(x) f(tab[[x]]), numeric(1))},
Vapply3 = {res <- vapply(seq_along(tab),
function(x) f2(tab[[x]]), numeric(1))},
Vapply4 = {res <- vapply(seq_along(tab),
function(x) sum(tab[[x]]), numeric(1))/nr},
Vapply5 = {res <- vapply(seq_along(tab),
function(x) sum(tab[[x]]), numeric(1))/nrow(tab)},
Rowsums = res <- rowsum(tab, group = gl(1, nrow(tab)))/nrow(tab),
ColMeans = res <- colMeans(tab),
colMeans2 = res <- colMeans(tab2),
colMeans3 = res <- .colMeans(tab2, nr, nc),
For = {
res <- vector("numeric", ncol(tab))
for (i in seq_along(res)) {
res[i] <- mean(tab[[i]])
}
},
For2 = {
res <- vector("numeric", ncol(tab))
for (i in seq_along(res)) {
res[i] <- f(tab[[i]])
}
},
For3 = {
res <- vector("numeric", ncol(tab))
for (i in seq_along(res)) {
res[i] <- f2(tab[[i]])
}
},
For4 = {
res <- vector("numeric", ncol(tab))
for (i in seq_along(res)) {
res[i] <- sum(tab[[i]])/length(tab[[i]])
}
},
For5 = {
res <- vector("numeric", ncol(tab))
for (i in seq_along(res)) {
res[i] <- sum(tab[[i]])
}
res <- res/nr
},
For6 = {
res <- vector("numeric", ncol(tab))
for (i in seq_along(res)) {
res[i] <- sum(tab[[i]])
}
res <- res/nrow(tab)
},
weightedMeans = {
ws <- vector("numeric", nr)+1
ws <- ws/nr
res <- colWeightedMeans(tab, ws)
},
weightedMeans2 = {
ws <- vector("numeric", nr)+1
ws <- ws/nr
res <- colWeightedMeans(tab2, ws)
},
Diag = res <- diag(t(tab2) %*% matrix(1, nr, nc))/nr,
Diag2 = res <- diag(crossprod(tab2, matrix(1, nr, nc))),
Dplyr = res <- summarise_each(tab, funs(mean)),
Dplyr2 = res <- summarise_each(tab, funs(f)),
Dplyr3 = res <- summarise_each(tab, funs(f2)),
Dplyr4 = res <- summarise_each(tab, funs(sum))/nr,
Dplyr5 = res <- summarise_each(tab, funs(sum))/nrow(tab),
Dplyr6 = res <- eval(auxi),
Dplyr7 = {
auxi <- names(tab)
auxi <- sprintf("%s = sum(%s)", auxi, auxi)
auxi <- paste(auxi, sep=",")
auxi <- paste("summarise(tab,", auxi, ")", sep="")
auxi <- parse(text=auxi)
res <- eval(auxi)
},
Plyr = res <- colwise(mean)(tab),
Plyr2 = res <- colwise(f)(tab),
Plyr3 = res <- colwise(f2)(tab),
Plyr4 = res <- colwise(sum)(tab)/nr,
Plyr5 = res <- colwise(sum)(tab)/nrow(tab),
Data.table = res <- tab3[, lapply(.SD, mean)],
Data.table2 = res <- tab3[, lapply(.SD, f)],
Data.table3 = res <- tab3[, lapply(.SD, f2)],
Data.table4 = res <- tab3[, lapply(.SD, sum)]/nr,
Data.table5 = res <- tab3[, lapply(.SD, sum)]/nrow(tab)
)
Cordialement,
Maxime