On 18.08.2013 01:05, Xiao He wrote:
Hi dear R-users,

I encountered an interesting pattern. Take for example the function
combn(), I copied and pasted the function definition and saved it as a new
function named combn2() (see the end of this email). As it turned out,
combn2() seems to be substantially slower than the original function
combn() (see benchmark below),

system.time(combn(30, 5)); system.time(combn2(30, 5))

combn is bytecode compiled, combn2 not:

try

library("compiler")
combn2 <- cmpfun(combn2)

and you won't see such a difference anymore.

Best,
Uwe Ligges




    user  system elapsed
   0.304   0.003   0.308
    user  system elapsed
   1.591   0.007   1.602


I wonder if there is any reason for this difference and if there is any way
to reduce the performance difference. Thanks!

combn2 <- function (x, m, FUN = NULL, simplify = TRUE, ...)
{
     stopifnot(length(m) == 1L)
     if (m < 0)
         stop("m < 0", domain = NA)
     if (is.numeric(x) && length(x) == 1L && x > 0 && trunc(x) ==
         x)
         x <- seq_len(x)
     n <- length(x)
     if (n < m)
         stop("n < m", domain = NA)
     m <- as.integer(m)
     e <- 0
     h <- m
     a <- seq_len(m)
     nofun <- is.null(FUN)
     if (!nofun && !is.function(FUN))
         stop("'FUN' must be a function or NULL")
     len.r <- length(r <- if (nofun) x[a] else FUN(x[a], ...))
     count <- as.integer(round(choose(n, m)))
     if (simplify) {
         dim.use <- if (nofun)
             c(m, count)
         else {
             d <- dim(r)
             if (length(d) > 1L)
                 c(d, count)
             else if (len.r > 1L)
                 c(len.r, count)
             else c(d, count)
         }
     }
     if (simplify) {
         out <- matrix(r, nrow = len.r, ncol = count)
     }
     else {
         out <- vector("list", count)
         out[[1L]] <- r
     }
     if (m > 0) {
         i <- 2L
         nmmp1 <- n - m + 1L
         while (a[1L] != nmmp1) {
             if (e < n - h) {
                 h <- 1L
                 e <- a[m]
                 j <- 1L
             }
             else {
                 e <- a[m - h]
                 h <- h + 1L
                 j <- 1L:h
             }
             a[m - h + j] <- e + j
             r <- if (nofun)
                 x[a]
             else FUN(x[a], ...)
             if (simplify)
                 out[, i] <- r
             else out[[i]] <- r
             i <- i + 1L
         }
     }
     if (simplify)
         array(out, dim.use)
     else out
}

        [[alternative HTML version deleted]]

______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.


______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.

Reply via email to