2013-06-14 3 views
4

У меня есть вектор, как следующее:R: уплотнить индексы

xx <- c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1) 

Я хочу найти индексы, которые имеют одни и объединить их вместе. В этом случае я хочу, чтобы результат выглядел как 1 6 и 11 14 в матрице 2x2. Мой вектор на самом деле очень длинный, поэтому я не могу сделать это вручную. Кто-нибудь может мне с этим помочь? Благодарю.

ответ

5

Поскольку вопрос изначально был тег «биоинформатика» Я буду упоминать о 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 

Другие операции mig ХТ начать на 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 

Можно было бы расширить этот полный вектор

, но часто лучше продолжить анализ на Rle. Класс является очень гибким, так что один из способов перехода от xx к целому вектору 1 и 0 является

> as(Rle(xx) > 0, "integer") 
[1] 1 1 1 1 1 1 0 0 0 0 1 1 1 1 

Опять же, хотя, часто имеет смысл оставаться в РЛЭ пространстве. И ответ Arun на ваш отдельный вопрос, вероятно, лучше всего.

Эксплуатационные характеристики (скорость) важна, хотя в этом случае я считаю, что класс Rle обеспечивает большую гибкость, которая вела бы против низкой производительности, а заканчивая матрицей, является маловероятной конечной точкой для типичного анализа ,Nonetheles 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 
+0

Что делать, если у меня есть xx = c (2,2,2,3,3,3,0,0,0,0,4, 4,1,1), и я хочу получить 1 3, 4 6, 11 12 и 13 14 в матрице 4x2? – user1938809

+0

@ user1938809 Я добавил это к ответу. –

+0

Могу ли я спросить, как перейти от 1 3, 4 6, 11 12 и 13 14 к векторной форме (1,1,1,1,1,1,0,0,0,0,1,1,1 , 1) без какой-либо петли, если вы знаете, что размер вектора равен 14. Это медленное использование цикла. Благодарю. – user1938809

5

Что-то вроде этого, может быть?

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).

3

Другой, короткий:

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 
1

Вот другое решение, которое встроено на идеях чужих, и немного короче и быстрее:

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 
+2

FWIW Я добавил тайминги IRanges к моему ответу. –

+0

приятно! это на самом деле довольно неожиданно – eddi

Смежные вопросы