разделение диапазонов

Question

Скажем, у меня есть несколько диапазонов, представленных начальными координатами start<-c(1,2,3) и конечными координатами end<-c(4,5,4) ;ranges<-data.frame(start,end) Как я могу разделить это на интервалы одной длины? т.е. я хочу

это

   starts ends
1      1    4
2      2    5
3      3    4  

должен быть преобразован в это:

   starts ends
1      1    2      |
2      3    4     <-end of original first interval
3      2    3      |
4      4    5     <-end of original second interval
5      3    4     <-end of original third interval

прямо сейчас у меня есть цикл for, повторяющий список и создающий последовательность последовательности, которая идет от начала до конца, но этот цикл занимает очень много времени для выполнения для длинных списков диапазонов.

Answer 1

Вот один из способов. Это «прославленный цикл» в маскировке lapply в последовательности.

# Your sample data
ranges<-data.frame(start=c(1,2,3),end=c(4,5,4))

# Extract the start/end columns         
start <- ranges$start
end <- ranges$end
# Calculate result data
res <- lapply(seq_along(start), function(i) start[i]+seq(0, end[i]-start[i]))
# Make it into a data.frame by way of a matrix (which has a byrow argument)
newRanges <- as.data.frame( matrix(unlist(res), ncol=2, byrow=TRUE, dimnames=list(NULL, names(ranges))) )

Что дает правильный результат:

> newRanges
  start end
1     1   2
2     3   4
3     2   3
4     4   5
5     3   4

А потом рассмотрим более серьезную проблему:

n <- 1e5
start <- sample(10, n, replace=TRUE)
end <- start + sample( 3, n, replace=TRUE)*2-1
system.time( newRanges <- as.data.frame( matrix(unlist(lapply(seq_along(start), function(i) start[i]+seq(0, end[i]-start[i]))), ncol=2, byrow=TRUE) ) )

Это займет около 1,6 секунд на моей машине. Достаточно хорошо?

... Хитрость заключается в том, чтобы работать с векторами напрямую, а не с data.frame. А затем создайте data.frame в конце.

Обновление @Ellipsis ... отметил, что lapply не лучше, чем цикл for. Посмотрим:

system.time( a <- unlist(lapply(seq_along(start), function(i) start[i]+seq(0, end[i]-start[i]))) ) # 1.6 secs

system.time( b <- {
  res <- vector('list', length(start))
  for (i in seq_along(start)) {   
    res[[i]] <- start[i]+seq(0, end[i]-start[i])
  }
  unlist(res) 
}) # 1.8 secs

Таким образом, цикл for не только примерно на 12% медленнее в этом случае, но и намного более многословен ...

ОБНОВЛЕНИЕ СНОВА!

@ Мартин Морган предложил использовать Map, и это действительно самое быстрое решение - быстрее, чем do.call в моем другом ответе. Кроме того, с помощью seq.int мое первое решение также намного быстрее:

# do.call solution: 0.46 secs 
system.time( matrix(do.call('c', lapply(seq_along(start), function(i) call(':', start[i], end[i]))), ncol=2, byrow=TRUE) )

# lapply solution: 0.42 secs   
system.time( matrix(unlist(lapply(seq_along(start), function(i) start[[i]]+seq.int(0L, end[[i]]-start[[i]]))), ncol=2, byrow=TRUE) )

# Map solution: 0.26 secs   
system.time( matrix(unlist(Map(seq.int, start, end)), ncol=2, byrow=TRUE) )

Answer 2

Вы можете попробовать создать текст для векторов, parse -ing и eval -uating, а затем использовать matrix для создания data.frame:

txt <- paste("c(",paste(ranges$start,ranges$end,sep=":",collapse=","),")",sep="")

> txt
[1] "c(1:4,2:5,3:4)"

vec <- eval(parse(text=txt))
> vec
 [1] 1 2 3 4 2 3 4 5 3 4

mat <- matrix(vec,ncol=2,byrow=T)
> data.frame(mat)
  X1 X2
1  1  2
2  3  4
3  2  3
4  4  5
5  3  4

Answer 3

Вот еще один ответ, основанный на отличном решении @James. Он избегает вставки и анализа и немного быстрее:

vec <- do.call('c', lapply(seq_along(start), function(i) call(':', start[i], end[i])))
mat <- matrix(vec,ncol=2,byrow=T)

Сроки:

set.seed(42)
n <- 1e5
start <- sample(10, n, replace=TRUE)
end <- start + sample( 3, n, replace=TRUE)*2-1

# @James code: 6,64 secs
system.time({
  for(i in 1:10) {
    txt <- paste("c(",paste(start,end,sep=":",collapse=","),")",sep="")
    vec <- eval(parse(text=txt))
    mat <- matrix(vec,ncol=2,byrow=T)
  }
})

# My variant: 5.17 secs
system.time({
  for(i in 1:10) {
    vec <- do.call('c', lapply(seq_along(start), function(i) call(':', start[i], end[i])))
    mat <- matrix(vec,ncol=2,byrow=T)
  }
})