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))
   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.

Reply via email to