One concern that I have with the 'tapply' approach is that it does not
create the correct results if the data it not in sorted order.  See the
example below:

> # generate an unsorted set of data
> set.seed(123)
> x <- data.frame(a=sample(1:3,12,TRUE), b=sample(0:1, 12, TRUE))
> x
   a b
1  1 1
2  3 1
3  2 0
4  3 1
5  3 0
6  1 0
7  2 0
8  3 1
9  2 1
10 2 1
11 3 1
12 2 1
> # using the tapply to sequence with grouping by 'a'; doesn't create right
results
> # because it put the data back in the 'sorted' order, but data unsorted
> x$seq<-unlist(tapply(x$a, x$a, function(x)1:length(x)))
> x
   a b seq
1  1 1   1
2  3 1   2
3  2 0   1
4  3 1   2
5  3 0   3
6  1 0   4
7  2 0   5
8  3 1   1
9  2 1   2
10 2 1   3
11 3 1   4
12 2 1   5
> # using 'by' to group and then sequence
> do.call(rbind, by(x, x$a, function(z) {z$new.seq <- 1:nrow(z); z}))
     a b seq new.seq
1.1  1 1   1       1
1.6  1 0   4       2
2.3  2 0   1       1
2.7  2 0   5       2
2.9  2 1   2       3
2.10 2 1   3       4
2.12 2 1   5       5
3.2  3 1   2       1
3.4  3 1   2       2
3.5  3 0   3       3
3.8  3 1   1       4
3.11 3 1   4       5
>



On 2/14/07, Tim Churches <tchur@optushome.com.au> wrote:
>
> jim holtman wrote:
> > On 2/14/07, Tim Churches <tchur@optushome.com.au> wrote:
> >> Any advice, tips, clues or pointers to resources on how best to speed
> up
> >> or, better still, avoid the loops in the following example code much
> >> appreciated. My actual dataset has several tens of thousands of rows
> and
> >> lots of columns, and these loops take a rather long time to run.
> >> Everything else which I need to do is done using vectors and those
> parts
> >> all run very quickly indeed. I spent quite a while doing searches on
> >> r-help and re-reading the various manuals, but couldn't find any
> >> existing relevant advice. I am sure the solution is obvious, but it
> >> escapes me.
> >>
> >> Tim C
> >>
> >> # create an example data frame, multiple events per subject
> >>
> >> year <- c(1980,1982,1996,1985,1987,1990,1991,1992,1999,1972,1983)
> >> event.of.interest <- c(F,T,T,F,F,F,T,F,T,T,F)
> >> subject <- c(1,1,1,2,2,3,3,3,3,4,4)
> >> df <- data.frame(cbind(subject,year,event.of.interest))
> >>
> >> # add a per-subject sequence number
> >>
> >> df$subject.seq <- 1
> >> for (i in 2:nrow(df)) {
> >> if (df$subject[i-1] == df$subject[i]) df$subject.seq[i] <-
> >> df$subject.seq[i-1] + 1
> >> }
> >> df
> >
> > # add an event sequence number which is zero until the first
> >> # event of interest for that subject happens, and then increments
> >> # thereafter
> >>
> >> df$event.seq <- 0
> >> for (i in 1:nrow(df)) {
> >> if (df$subject.seq[i] == 1 ) {
> >>    current.event.seq <- 0
> >> }
> >> if (event.of.interest[i] == 1 | current.event.seq > 0)
> >> current.event.seq <- current.event.seq + 1
> >> df$event.seq[i] <- current.event.seq
> >> }
> >> df
> >
> >
> >
> > try:
> >
> >> df <- data.frame(cbind(subject,year,event.of.interest))
> >> df <- do.call(rbind,by(df, df$subject, function(z){z$subject.seq <-
> > seq(nrow(z)); z}))
> >> df
> >      subject year event.of.interest subject.seq
> > 1.1        1 1980                 0           1
> > 1.2        1 1982                 1           2
> > 1.3        1 1996                 1           3
> > 2.4        2 1985                 0           1
> > 2.5        2 1987                 0           2
> > 3.6        3 1990                 0           1
> > 3.7        3 1991                 1           2
> > 3.8        3 1992                 0           3
> > 3.9        3 1999                 1           4
> > 4.10       4 1972                 1           1
> > 4.11       4 1983                 0           2
> >> # determine first event
> >> df <- do.call(rbind, by(df, df$subject, function(x){
> > +     # determine first event
> > +     .first <- cumsum(x$event.of.interest)
> > +     # create sequence after first non-zero
> > +     .first <- cumsum(.first > 0)
> > +     x$event.seq <- .first
> > +     x
> > + }))
> >> df
> >        subject year event.of.interest subject.seq event.seq
> > 1.1.1        1 1980                 0           1         0
> > 1.1.2        1 1982                 1           2         1
> > 1.1.3        1 1996                 1           3         2
> > 2.2.4        2 1985                 0           1         0
> > 2.2.5        2 1987                 0           2         0
> > 3.3.6        3 1990                 0           1         0
> > 3.3.7        3 1991                 1           2         1
> > 3.3.8        3 1992                 0           3         2
> > 3.3.9        3 1999                 1           4         3
> > 4.4.10       4 1972                 1           1         1
> > 4.4.11       4 1983                 0           2         2
>
> Thanks Jim, that works a treat, over an order of magnitude faster than
> the for-loops.
>
> Anders Nielsen also provided this solution:
>
> df$subject.seq<-unlist(tapply(df$subject,
>                                  df$subject,
>                                  function(x)1:length(x)
>                               )
>                        )
>
> Doing it that way is about 5 times faster than using rbind(). But Jim's
> use of cumsum on the logical vector is very nifty.
>
> I have now combined Jim's function with Anders' column-oriented approach
> and the result is that my code now runs about two orders of magnitude
> faster.
>
> Many thanks,
>
> Tim C
>
>


-- 
Jim Holtman
Cincinnati, OH
+1 513 646 9390

What is the problem you are trying to solve?

	[[alternative HTML version deleted]]

