拆分範圍

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 

現在我有一個循環通過列表迭代，並創建一個從開始進入到一個序列序列結束，但是此循環需要很長時間才能執行長列表的範圍。

Answer 1

你可以嘗試創建文本爲載體，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 2

這是一種方法。這是一個「榮耀的for-loop」，僞裝成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-loop好。讓我們來看看：

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％，這也是更詳細的...

再次更新！

@Martin Morgan建議使用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 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) 
    } 
})