我有一个如下的向量:
xx <- c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1)
我想找到有索引的索引并将它们组合在一起。在这种情况下,我希望输出在 2x2 矩阵中看起来像 1 6 和 11 14。我的向量实际上很长,所以我不能手动完成。谁能帮我这个?谢谢。
我有一个如下的向量:
xx <- c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1)
我想找到有索引的索引并将它们组合在一起。在这种情况下,我希望输出在 2x2 矩阵中看起来像 1 6 和 11 14。我的向量实际上很长,所以我不能手动完成。谁能帮我这个?谢谢。
像这样的东西,也许?
if (xx[1] == 1) {
rr <- cumsum(c(0, rle(xx)$lengths))
} else {
rr <- cumsum(rle(xx)$lengths)
}
if (length(rr) %% 2 == 1) {
rr <- head(rr, -1)
}
oo <- matrix(rr, ncol=2, byrow=TRUE)
oo[, 1] <- oo[, 1] + 1
[,1] [,2]
[1,] 1 6
[2,] 11 14
此编辑处理以下情况:1) 向量以“0”而不是“1”和 2) 连续出现的 1 的数量为奇数/偶数。例如:xx <- c(1,1,1,1,1,1,0,0,0,0)
.
由于问题最初有一个标签“生物信息学”,我会提到Bioconductor包IRanges(它是基因组范围的伴侣GenomicRanges)
> library(IRanges)
> xx <- c(1,1,1,1,1,1,0,0,0,0,1,1,1,1)
> sl = slice(Rle(xx), 1)
> sl
Views on a 14-length Rle subject
views:
start end width
[1] 1 6 6 [1 1 1 1 1 1]
[2] 11 14 4 [1 1 1 1]
可以强制转换为矩阵,但这通常不方便下一步
> matrix(c(start(sl), end(sl)), ncol=2)
[,1] [,2]
[1,] 1 6
[2,] 11 14
其他操作可能会在 上开始Rle
,例如,
> xx = c(2,2,2,3,3,3,0,0,0,0,4,4,1,1)
> r = Rle(xx)
> m = cbind(start(r), end(r))[runValue(r) != 0,,drop=FALSE]
> m
[,1] [,2]
[1,] 1 3
[2,] 4 6
[3,] 11 12
[4,] 13 14
?Rle
有关课程的全部灵活性,请参阅帮助页面Rle
;要从像上面这样的矩阵转到下面评论中要求的新 Rle,可以创建一个适当长度的新 Rle,然后使用 IRanges 作为索引进行子集分配
> r = Rle(0L, max(m))
> r[IRanges(m[,1], m[,2])] = 1L
> r
integer-Rle of length 14 with 3 runs
Lengths: 6 4 4
Values : 1 0 1
可以将其扩展为完整的向量
> as(r, "integer")
[1] 1 1 1 1 1 1 0 0 0 0 1 1 1 1
但通常最好继续对 Rle 进行分析。该类非常灵活,因此从xx
1 和 0 到整数向量的一种方法是
> as(Rle(xx) > 0, "integer")
[1] 1 1 1 1 1 1 0 0 0 0 1 1 1 1
不过,再一次,留在 Rle 空间中通常是有意义的。Arun对您的单独问题的回答可能是最好的。
性能(速度)很重要,尽管在这种情况下,我认为 Rle 类提供了很大的灵活性,可以权衡性能不佳的情况,并且以矩阵结尾对于典型分析来说不太可能是终点。尽管如此,IRanges 基础设施是高性能的
eddi <- function(xx)
matrix(which(diff(c(0,xx,0)) != 0) - c(0,1),
ncol = 2, byrow = TRUE)
iranges = function(xx) {
sl = slice(Rle(xx), 1)
matrix(c(start(sl), end(sl)), ncol=2)
}
iranges.1 = function(xx) {
r = Rle(xx)
cbind(start(r), end(r))[runValue(r) != 0, , drop=FALSE]
}
和
> xx = sample(c(0, 1), 1e5, TRUE)
> microbenchmark(eddi(xx), iranges(xx), iranges.1(xx), times=10)
Unit: milliseconds
expr min lq median uq max neval
eddi(xx) 45.88009 46.69360 47.67374 226.15084 234.8138 10
iranges(xx) 112.09530 114.36889 229.90911 292.84153 294.7348 10
iranges.1(xx) 31.64954 31.72658 33.26242 35.52092 226.7817 10
另一个,简短的:
cbind(start = which(diff(c(0, xx)) == +1),
end = which(diff(c(xx, 0)) == -1))
# start end
# [1,] 1 6
# [2,] 11 14
我在一个很长的向量上进行了测试,它比使用rle
. 但更具可读性恕我直言。如果速度真的是一个问题,你也可以这样做:
xx.diff <- diff(c(0, xx, 0))
cbind(start = which(head(xx.diff, -1) == +1),
end = which(tail(xx.diff, -1) == -1))
# start end
# [1,] 1 6
# [2,] 11 14
这是基于其他人想法的另一个解决方案,并且更短更快:
matrix(which(diff(c(0,xx,0)) != 0) - c(0,1), ncol = 2, byrow = T)
# [,1] [,2]
#[1,] 1 6
#[2,] 11 14
我没有测试非基础解决方案,但这里是基础解决方案的比较:
xx = sample(c(0,1), 1e5, T)
microbenchmark(arun(xx), flodel(xx), flodel.fast(xx), eddi(xx))
#Unit: milliseconds
# expr min lq median uq max neval
# arun(xx) 14.021134 14.181134 14.246415 14.332655 15.220496 100
# flodel(xx) 12.885134 13.186254 13.248334 13.432974 14.367695 100
# flodel.fast(xx) 9.704010 9.952810 10.063691 10.211371 11.108171 100
# eddi(xx) 7.029448 7.276008 7.328968 7.439528 8.361609 100