Re: [Rd] HOW TO AVOID LOOPS

From: Dan Davison <davison_at_stats.ox.ac.uk>
Date: Sat, 12 Apr 2008 21:32:49 +0100

On Sat, Apr 12, 2008 at 06:45:00PM +0100, Dan Davison wrote:
> On Sat, Apr 12, 2008 at 01:30:13PM -0400, Vincent Goulet wrote:
> > 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)
> > >>
> > > Appreciate any suggetions.

> >
> > This does it -- but it is admittedly ugly:
> >
> > > x <- c(0,0,1,0,1,1,1,0,0,1,1,0,1,0,1,1,1,1,1,1)
> > > ind <- which(x == 0)
> > > unlist(lapply(mapply(seq, ind, c(tail(ind, -1) - 1, length(x))),
> > function(y) cumsum(x[y])))
> > [1] 0 0 1 0 1 2 3 0 0 1 2 0 1 0 1 2 3 4 5 6
> >
> > (The mapply() part is used to create the indexes of each sequence in x
> > starting with a 0. The rest is then straightforward.)
>
>
> Here's my effort. Maybe a bit easier to digest? Only one *apply so probably more efficient.
>
> function(x=c(0,0,1,0,1,1,1,0,0,1,1,0,1,0,1,1,1,1,1,1)) {
> 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
> }
>

Come to think of it, I suggest using the existing R function rle(), rather than my dodgy substitute.

e.g.

g <- function(x=c(0,0,1,0,1,1,1,0,0,1,1,0,1,0,1,1,1,1,1,1)) {

    runs <- rle(x)
    runlengths <- runs$lengths[runs$values == 1]     x[x == 1] <- unlist(lapply(runlengths, function(n) 1:n))     x
}

Dan

p.s. R-help would perhaps have been more appropriate than R-devel

> Dan
>
>
> >
> > HTH
> >
> > ---
> > Vincent Goulet, Associate Professor
> > École d'actuariat
> > Université Laval, Québec
> > Vincent.Goulet@act.ulaval.ca http://vgoulet.act.ulaval.ca
> >
> > ______________________________________________
> > R-devel_at_r-project.org mailing list
> > https://stat.ethz.ch/mailman/listinfo/r-devel



R-devel_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel Received on Sat 12 Apr 2008 - 20:35:20 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Sat 12 Apr 2008 - 23:31:07 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-devel. Please read the posting guide before posting to the list.

list of date sections of archive