R中高效的数据帧迭代

Question

Suppose I have aa 5 million row data frame, with two columns, as such (this data frame only has ten rows for simplicity):

df <- data.frame(start=c(11,21,31,41,42,54,61,63), end=c(20,30,40,50,51,63,70,72))

I want to be able to produce the following numbers in a numeric vector:

11 to 20, 21 to 30, 31 to 40, 41 to 50, 51, 54-63, 64-70, 71-72

And then take the length of the new vector (in this case, 10+10+10+10+1+10+7+2) = 60

*NOTE, I do not need the vector itself, just it's length will suffice. So if someone has a more intelligent logical approach to obtain the length, that is welcomed.

Essentially, what was done, was the for each row in the dataframe, the sequence from the start to end was taken, and all these sequences were combined, and then filtered for UNIQUE values.

So I used an approach as such:

length(unique(c(apply(df, 1, function(x) {
    return(as.numeric(x[1]):as.numeric(x[2]))
}))))

which proves incredibly slow on my five million row data frame.

Any quicker more efficient solutions? Bonus, please try to add system time.

user system elapsed 19.946 0.620 20.477

Answer 1

This should work, assuming your data is sorted.

library(dplyr)  # for the lag function

with(df, sum(end - pmax(start, lag(end, 1, default = 0)+1) + 1))
#[1] 60

library(microbenchmark)
microbenchmark(
  beginneR={with(df, sum(end - pmax(start, lag(end, 1, default = 0)+1) + 1))},
  r2evans={vec <- pmax(mm[,1], c(0,1+head(mm[,2],n=-1))); sum(mm[,2]-vec+1);},
  times = 1000
)

Unit: microseconds
     expr     min       lq  median       uq       max neval
beginneR   37.398  41.4455  42.731  44.0795    74.349  1000
r2evans    31.788  35.2470  36.827  38.3925  9298.669  1000

So matrix is still faster, but not much (and the conversion step is still not included here). And I wonder why the max duration in @r2evans's answer is so high compared to all other values (which are really fast)

Answer 2

Another method:

mm <- as.matrix(df) ## critical for performance/scalability
(vec <- pmax(mm[,1], c(0,1+head(mm[,2],n=-1))))
##  [1] 11 21 31 41 51 54 64 71
sum(mm[,2] - vec + 1)
##  [1] 60

(This should scale reasonable well, certainly better than data.frames.)

Edit : after I updated my code to use matrices and no apply calls, I did a quick benchmark of my implementation compared with the other answer (which is also correct):

library(microbenchmark)
library(dplyr)
microbenchmark(
    beginneR={
        df <- data.frame(start=c(11,21,31,41,42,54,61,63),
                         end=c(20,30,40,50,51,63,70,72))
        with(df, sum(end - pmax(start, lag(end, 1, default = 0)+1) + 1))
    },
    r2evans={
        mm <- matrix(c(11,21,31,41,42,54,61,63,
                       20,30,40,50,51,63,70,72), nc=2)
        vec <- pmax(mm[,1], c(0,1+head(mm[,2],n=-1)))
        sum(mm[,2]-vec+1)
    }
    )
##  Unit: microseconds
##       expr     min      lq   median      uq     max neval
##   beginneR 230.410 238.297 244.9015 261.228 443.574   100
##    r2evans  37.791  40.725  44.7620  47.880 147.124   100

This benefits greatly from the use of matrices instead of data.frames.

Oh, and system time is not that helpful here :-)

system.time({
    mm <- matrix(c(11,21,31,41,42,54,61,63,
                   20,30,40,50,51,63,70,72), nc=2)
    vec <- pmax(mm[,1], c(0,1+head(mm[,2],n=-1)))
    sum(mm[,2]-vec+1)
})
##     user  system elapsed 
##        0       0       0