On 13-08-17 7:05 PM, 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),
Besides the difference Uwe pointed out, those functions likely have
different environments, so searching for symbols will take a different
amount of time. Usually this will be longer from globalenv() than from
the namespace of the package, but sometimes the reverse could be true.
Duncan Murdoch
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.
______________________________________________
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.
