La spedizione del metodo S4 è lenta?

Question

La mia classe S4 ha un metodo chiamato molte volte. Ho notato che il tempo di esecuzione è molto più lento di quanto sarebbe se una funzione simile fosse chiamata indipendentemente. Quindi ho aggiunto uno slot con tipo "function" alla mia classe e ho usato quella funzione al posto del metodo. L'esempio seguente mostra due modi per farlo, ed entrambi funzionano molto più velocemente del metodo corrispondente. Inoltre, l'esempio suggerisce che la velocità più bassa del metodo non è dovuta al fatto che il metodo deve recuperare i dati dalla classe, poiché le funzioni sono più veloci anche quando lo fanno.

Ovviamente, questo modo di fare le cose non è l'ideale. Mi chiedo se c'è un modo per accelerare la spedizione del metodo. Eventuali suggerimenti?

setClass(Class = "SpeedTest", 
     representation = representation(
     x = "numeric", 
     foo1 = "function", 
     foo2 = "function" 
    ) 
    ) 

    speedTest <- function(n) { 
     new("SpeedTest", 
     x = rnorm(n), 
     foo1 = function(z) sqrt(abs(z)), 
     foo2 = function() {} 
    ) 
    } 

    setGeneric(
     name = "method.foo", 
     def = function(object) {standardGeneric("method.foo")} 
    ) 
    setMethod(
     f = "method.foo", 
     signature = "SpeedTest", 
     definition = function(object) { 
     sqrt(abs(object@x)) 
     } 
    ) 

    setGeneric(
     name = "create.foo2", 
     def = function(object) {standardGeneric("create.foo2")} 
    ) 
    setMethod(
     f = "create.foo2", 
     signature = "SpeedTest", 
     definition = function(object) { 
     z <- object@x 
     object@foo2 <- function() sqrt(abs(z)) 

     object 
     } 
    ) 

    > st <- speedTest(1000) 
    > st <- create.foo2(st) 
    > 
    > iters <- 100000 
    > 
    > system.time(for (i in seq(iters)) method.foo(st)) # slowest by far 
     user system elapsed 
     3.26 0.00 3.27 

    > # much faster 
    > system.time({foo1 <- st@foo1; x <- st@x; for (i in seq(iters)) foo1(x)}) 
     user system elapsed 
     1.47 0.00 1.46 

    > # retrieving st@x instead of x does not affect speed 
    > system.time({foo1 <- st@foo1; for (i in seq(iters)) foo1(st@x)}) 
     user system elapsed 
     1.47 0.00 1.49 

    > # same speed as foo1 although no explicit argument 
    > system.time({foo2 <- st@foo2; for (i in seq(iters)) foo2()}) 
     user system elapsed 
     1.44 0.00 1.45 

    # Cannot increase speed by using a lambda to "eliminate" the argument of method.foo 
    > system.time({foo <- function() method.foo(st); for (i in seq(iters)) foo()}) 
     user system elapsed 
     3.28 0.00 3.29 

Answer 1

Il costo è nella ricerca del metodo, che inizia da zero in ogni iterazione dei tempi. Questo può essere in corto circuito per capire il metodo di spedizione una volta

METHOD <- selectMethod(method.foo, class(st)) 
for (i in seq(iters)) METHOD(st) 

Questo (metodo migliore look-up) sarebbe un progetto molto interessante e vale la pena-mentre; ci sono preziose lezioni apprese in altre lingue dinamiche, ad esempio il caching in linea menzionato sulla pagina di Wikipedia dynamic dispatch.

Mi chiedo se la ragione per cui si effettuano molte chiamate di metodo sia dovuta alla vettorizzazione incompleta della rappresentazione e dei metodi dei dati?

Answer 2

Questo non aiuta direttamente con il tuo problema, ma è molto più facile da punto di riferimento questo genere di cose con il pacchetto microbenchmark:

f <- function(x) NULL 

s3 <- function(x) UseMethod("s3") 
s3.integer <- function(x) NULL 

A <- setClass("A", representation(a = "list")) 
setGeneric("s4", function(x) standardGeneric("s4")) 
setMethod(s4, "A", function(x) NULL) 

B <- setRefClass("B") 
B$methods(r5 = function(x) NULL) 

a <- A() 
b <- B$new() 

library(microbenchmark) 
options(digits = 3) 
microbenchmark(
    bare = NULL, 
    fun = f(), 
    s3 = s3(1L), 
    s4 = s4(a), 
    r5 = b$r5() 
) 
# Unit: nanoseconds 
# expr min lq median uq max neval 
# bare 13 20  22 29 36 100 
# fun 171 236 270 310 805 100 
# s3 2025 2478 2651 2869 8603 100 
# s4 10017 11029 11528 11905 36149 100 
# r5 9080 10003 10390 10804 61864 100 

Sul mio computer, la chiamata a nudo dura circa 20 ns. Il wrapping in una funzione aggiunge circa 200 ns in più - questo è il costo della creazione dell'ambiente in cui avviene l'esecuzione della funzione. La spedizione del metodo S3 aggiunge circa 3 μs e classi S4/ref di circa 12 μs.