Le sam. 12 avr. à 12:47, carlos martinez a écrit :
Looking for a simple, effective a minimum execution time solution.
For a vector as:
c(0,0,1,0,1,1,1,0,0,1,1,0,1,0,1,1,1,1,1,1)
To transform it to the following vector without using any loops:
(0,0,1,0,1,2,3,0,0,1,2,0,1,0,1,2,3,4,5,6)
Here is a fast solution using the Ra just-in-time compiler
www.milbo.users.sonic.net/ra.
jit(1)
if (length(x) > 1)
for (i in 2:length(x))
if (x[i])
x[i] <- x[i-1] + 1
The times in seconds for various solutions mailed to r-devel are listed
below. There is some variation between runs and with the contents of x. The
times shown are for
set.seed(1066); x <- as.double(runif(1e6) > .5)
This was tested on a WinXP 3 GHz Pentium D with Ra 1.0.7 (based on R 2.6.2).
The code to generate these results is attached.
vin 24
greg 11
had 3.9
dan 1.4
dan2 1.4
jit 0.25 # code is shown above, 7 secs with standard R 2.6.2>
Stephen Milborrow
www.milbo.users.sonic.net
# cm-post.R: compare solutions to the following post to
# r-devel from carlos martinez 12 apr 2008:
# Looking for a simple, effective a minimum execution time solution.
# For a vector as:
# c(0,0,1,0,1,1,1,0,0,1,1,0,1,0,1,1,1,1,1,1)
# To transform it to the following vector without using any loops:
# c(0,0,1,0,1,2,3,0,0,1,2,0,1,0,1,2,3,4,5,6)
set.seed(1066) # for reproducibility
N <- 1e6
x <- as.double(runif(N) > .5)
x[1] <- 0 # seems to be needed for fhad (and fvin?)
fvin <- function(x) {
ind <- which(x == 0)
unlist(lapply(mapply(seq, ind, c(tail(ind, -1) - 1, length(x))),
function(y) cumsum(x[y])))
}
fdan <- function(x) {
d <- diff(c(0,x,0))
starts <- which(d == 1)
ends <- which(d == -1)
x[x == 1] <- unlist(lapply(ends - starts, function(n) 1:n))
x
}
fdan2 <- function(x) {
runs <- rle(x)
runlengths <- runs$lengths[runs$values == 1]
x[x == 1] <- unlist(lapply(runlengths, function(n) 1:n))
x
}
fhad <- function(x)
unlist(lapply(split(x, cumsum(x == 0)), seq_along)) - 1
# following requires "ra" for fast times www.milbo.users.sonic.net/ra
library(jit)
fjit <- function(x) {
jit(1)
if (length(x) > 1)
for (i in 2:length(x))
if (x[i])
x[i] <- x[i-1] + 1
x
}
fgreg <- function(x)
Reduce( function(x,y) x*y + y, x, accumulate=TRUE )
fanon <- function(x)
x * unlist(lapply(rle(x)$lengths, seq))
cat("times with N =", N, "\n")
cat("dan", system.time(ydan <- fdan(x))[3], "\n")
cat("dan2", system.time(ydan2 <- fdan2(x))[3], "\n")
cat("had", system.time(yhad <- fhad(x))[3], "\n")
cat("vin", system.time(yvin <- fvin(x))[3], "\n")
cat("jit", system.time(yjit <- fjit(x))[3], "\n")
cat("greg", system.time(ygreg <- fgreg(x))[3], "\n")
# very slow cat("anon", system.time(yanon <- fanon(x))[3], "\n")
stopifnot(identical(ydan2, ydan))
stopifnot(identical(as.numeric(yhad), ydan))
stopifnot(identical(yvin, ydan))
stopifnot(identical(yjit, ydan))
stopifnot(identical(ygreg, ydan))
# stopifnot(identical(yanon, ydan))
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
