Czy rodzina R jest czymś więcej niż cukrem składniowym?

Czasami przyspieszenie może być znaczne, jak wtedy, gdy trzeba zagnieżdżać pętle for, aby uzyskać średnią opartą na grupowaniu więcej niż jednego czynnika. Tutaj masz dwa podejścia, które dają dokładnie ten sam wynik:

set.seed(1)  #for reproducability of the results

# The data
X <- rnorm(100000)
Y <- as.factor(sample(letters[1:5],100000,replace=T))
Z <- as.factor(sample(letters[1:10],100000,replace=T))

# the function forloop that averages X over every combination of Y and Z
forloop <- function(x,y,z){
# These ones are for optimization, so the functions 
#levels() and length() don't have to be called more than once.
  ylev <- levels(y)
  zlev <- levels(z)
  n <- length(ylev)
  p <- length(zlev)

  out <- matrix(NA,ncol=p,nrow=n)
  for(i in 1:n){
      for(j in 1:p){
          out[i,j] <- (mean(x[y==ylev[i] & z==zlev[j]]))
      }
  }
  rownames(out) <- ylev
  colnames(out) <- zlev
  return(out)
}

# Used on the generated data
forloop(X,Y,Z)

# The same using tapply
tapply(X,list(Y,Z),mean)

Oba dają dokładnie ten sam wynik, będąc macierzą 5 x 10 ze średnimi i nazwanymi wierszami i kolumnami. Ale:

> system.time(forloop(X,Y,Z))
   user  system elapsed 
   0.94    0.02    0.95 

> system.time(tapply(X,list(Y,Z),mean))
   user  system elapsed 
   0.06    0.00    0.06 

...i jak pisałem gdzie indziej, vapply jest twoim przyjacielem! ... to jest jak sapply, ale również określić typ zwracanej wartości, co sprawia, że znacznie szybciej.

foo <- function(x) x+1
y <- numeric(1e6)

system.time({z <- numeric(1e6); for(i in y) z[i] <- foo(i)})
#   user  system elapsed 
#   3.54    0.00    3.53 
system.time(z <- lapply(y, foo))
#   user  system elapsed 
#   2.89    0.00    2.91 
system.time(z <- vapply(y, foo, numeric(1)))
#   user  system elapsed 
#   1.35    0.00    1.36 

system.time({z1 <- numeric(1e6); for(i in seq_along(y)) z1[i] <- foo(y[i])})
#   user  system elapsed 
#   0.52    0.00    0.53 
system.time(z <- lapply(y, foo))
#   user  system elapsed 
#   0.72    0.00    0.72 
system.time(z3 <- vapply(y, foo, numeric(1)))
#   user  system elapsed 
#    0.7     0.0     0.7 
identical(z1, z3)
# [1] TRUE

Pisałem gdzie indziej, że przykład taki jak Shane ' a nie podkreśla różnicy w wydajności pomiędzy różnymi rodzajami składni pętli, ponieważ czas spędzany jest w funkcji, a nie w rzeczywistości podkreślając pętlę. Ponadto kod niesłusznie porównuje pętlę for bez pamięci z funkcjami rodziny apply, które zwracają wartość. Oto nieco inny przykład, który podkreśla punkt.

foo <- function(x) {
   x <- x+1
 }
y <- numeric(1e6)
system.time({z <- numeric(1e6); for(i in y) z[i] <- foo(i)})
#   user  system elapsed 
#  4.967   0.049   7.293 
system.time(z <- sapply(y, foo))
#   user  system elapsed 
#  5.256   0.134   7.965 
system.time(z <- lapply(y, foo))
#   user  system elapsed 
#  2.179   0.126   3.301 

Jeśli planujesz zapisać wynik, zastosuj rodzinę funkcje mogą być znacznie więcej niż cukrem składniowym.

(prosta unlist z wynosi tylko 0,2 s, Więc lapply jest znacznie szybszy. Inicjalizacja z w pętli for jest dość szybka, ponieważ daję średnią z ostatnich 5 z 6 uruchomień tak poruszających się poza systemem.czas nie wpłynie na rzeczy)

Jeszcze jedną rzeczą do zauważenia jest to, że istnieje inny powód, aby używać funkcji apply family niezależnie od ich wydajności, jasności lub braku efektów ubocznych. A for pętla zazwyczaj Promuje umieszczenie jak najwięcej w pętli. Dzieje się tak, ponieważ każda pętla wymaga ustawienia zmiennych do przechowywania informacji (wśród innych możliwych operacji). Wyrażenia Apply są tendencyjne w drugą stronę. Często chcesz wykonać wiele operacji na swoich danych, z których kilka można wektoryzować, ale niektóre mogą nie być w stanie. W R, W przeciwieństwie do innych języków, najlepiej jest oddzielić te operacje i uruchomić te, które nie są wektoryzowane w instrukcji apply (lub wektoryzowana wersja funkcji) i te, które są wektoryzowane jako prawdziwe operacje wektorowe. To często znacznie przyspiesza wydajność.

Biorąc przykład Jorisa Meysa, gdzie zastępuje on tradycyjną pętlę for poręczną funkcją R, możemy użyć jej, aby pokazać efektywność pisania kodu w bardziej przyjazny dla R sposób dla podobnego przyspieszenia bez wyspecjalizowanej funkcji.

set.seed(1)  #for reproducability of the results

# The data - copied from Joris Meys answer
X <- rnorm(100000)
Y <- as.factor(sample(letters[1:5],100000,replace=T))
Z <- as.factor(sample(letters[1:10],100000,replace=T))

# an R way to generate tapply functionality that is fast and 
# shows more general principles about fast R coding
YZ <- interaction(Y, Z)
XS <- split(X, YZ)
m <- vapply(XS, mean, numeric(1))
m <- matrix(m, nrow = length(levels(Y)))
rownames(m) <- levels(Y)
colnames(m) <- levels(Z)
m

To kończy się znacznie szybciej niż for pętli i tylko trochę wolniej niż zbudowany w zoptymalizowanej funkcji tapply. Nie dlatego, że vapply jest o wiele szybszy niż for, ale dlatego, że wykonuje tylko jedną operację w każdej iteracji pętli. W tym kodzie Wszystko inne jest wektoryzowane. In Joris Meys traditional for loop many (7?) operacje występują w każdej iteracji i jest sporo konfiguracji tylko do jej wykonania. Zauważ również, jak bardzo jest to bardziej kompaktowe niż wersja for.

Podczas stosowania funkcji nad podzbiorami wektora, tapply może być dość szybsza niż pętla for. Przykład:

df <- data.frame(id = rep(letters[1:10], 100000),
                 value = rnorm(1000000))

f1 <- function(x)
  tapply(x$value, x$id, sum)

f2 <- function(x){
  res <- 0
  for(i in seq_along(l <- unique(x$id)))
    res[i] <- sum(x$value[x$id == l[i]])
  names(res) <- l
  res
}            

library(microbenchmark)

> microbenchmark(f1(df), f2(df), times=100)
Unit: milliseconds
   expr      min       lq   median       uq      max neval
 f1(df) 28.02612 28.28589 28.46822 29.20458 32.54656   100
 f2(df) 38.02241 41.42277 41.80008 42.05954 45.94273   100

apply, jednak w większości sytuacji nie zapewnia wzrostu prędkości, a w niektórych przypadkach może być nawet dużo wolniej: {]}

mat <- matrix(rnorm(1000000), nrow=1000)

f3 <- function(x)
  apply(x, 2, sum)

f4 <- function(x){
  res <- 0
  for(i in 1:ncol(x))
    res[i] <- sum(x[,i])
  res
}

> microbenchmark(f3(mat), f4(mat), times=100)
Unit: milliseconds
    expr      min       lq   median       uq      max neval
 f3(mat) 14.87594 15.44183 15.87897 17.93040 19.14975   100
 f4(mat) 12.01614 12.19718 12.40003 15.00919 40.59100   100

Ale w takich sytuacjach mamy colSums i rowSums:

f5 <- function(x)
  colSums(x) 

> microbenchmark(f5(mat), times=100)
Unit: milliseconds
    expr      min       lq   median       uq      max neval
 f5(mat) 1.362388 1.405203 1.413702 1.434388 1.992909   100