拆分范围

时间:2011-10-19 14:53:20

标签: r

假设我有一些由起始坐标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循环遍历列表并创建一个从开始到结束的序列序列,但是这个循环需要很长时间来执行长列表范围。

3 个答案:

答案 0 :(得分:2)

这是一种方式。在序列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-loop不仅慢了大约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) )

答案 1 :(得分:1)

您可以尝试为矢量parse - 和eval创建文本,然后使用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

答案 2 :(得分:0)

这是基于@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)
  }
})
相关问题