2016-05-13 233 views
0

比方说,我有alpha周期在R数组变量

alpha = c(a,a,a,b,c,c,c,a,c,c) 

我如何才能找到的周期性,这样我可以构造另一个阵列beta

beta = c(3,1,3,1,2) 

不使用的alpha内容在代码中?有没有办法用铅或滞后来回答这个问题?

+4

您是否在寻找运行长编码('rle')?我不确定你的意思是“不使用alpha的内容”。你的输入和期望输出是什么?这似乎是做你所描述的:'alpha = c(a,a,a,b,c,c,c,a,c, C”); rle(alpha)$长度' – MrFlick

+0

我第二@MrFlick评论。另外,你能详细说明一下你用铅或滞后来做什么的意思吗? – zyurnaidi

+0

谢谢!我正在寻找rle! – sharp

回答

0

如果你想保持alpha值不变,你可以创建一个for循环,并使用逻辑运行一个计数器,如果这个alpha迭代等于最后一个。你将需要设置一个过去的alpha来接受当前值,并比较下一个值。

一旦两个值不一致,计数器编号将与您在循环外创建的矢量连接,并且计数器返回到一。

很简单,你应该自己做这个来学习。

您可以将文件读入变量,但不能手动键入数字或永远需要使其可见。如果数据以某种方式“保护” ......

1

下面是使用tabulaterleid

library(data.table) 
tabulate(rleid(alpha)) 
#[1] 3 1 3 1 2 
1

只是为了好玩,这里是一个复杂的解决方案的选项:

alpha <- c('a','a','a','b','c','c','c','a','c','c'); 
diff(c(0L,which(c(alpha[-1L]!=alpha[-length(alpha)],T)))); 
## [1] 3 1 3 1 2 

说明


alpha[-1L]!=alpha[-length(alpha)]; 
## [1] FALSE FALSE TRUE TRUE FALSE FALSE TRUE TRUE FALSE 

首先计算一个逻辑向量,表示哪些相邻输入元素对在值相等中构成中断,哪些不相等。逻辑向量中每个元素的索引对应于输入向量中该对的第一个元素的索引。


c(alpha[-1L]!=alpha[-length(alpha)],T); 
## [1] FALSE FALSE TRUE TRUE FALSE FALSE TRUE TRUE FALSE TRUE 

附加一个TRUE值来创建在矢量的末端的伪中断。请参阅下一步澄清。


which(c(alpha[-1L]!=alpha[-length(alpha)],T)); 
## [1] 3 4 7 8 10 

转换逻辑矢量到表示端点在输入向量中的游程长度的索引向量。现在应该清楚为什么我们必须在上一步追加TRUE;否则将省略最终运行长度的终点。


c(0L,which(c(alpha[-1L]!=alpha[-length(alpha)],T))); 
## [1] 0 3 4 7 8 10 

前加一个零。这可以概念上被认为是将索引向量转换为“边界向量”,每个元素表示输入向量运行长度的内部或外部边界。请参阅下一步澄清。


diff(c(0L,which(c(alpha[-1L]!=alpha[-length(alpha)],T)))); 
## [1] 3 1 3 1 2 

以相继边界之间的差异。这提供了所需的运行长度。


标杆

library(data.table); 
library(microbenchmark); 

bgoldst <- function(alpha) diff(c(0L,which(c(alpha[-1L]!=alpha[-length(alpha)],T)))); 
akrun <- function(alpha) tabulate(rleid(alpha)); 
bethany <- function(alpha) { if (length(alpha)==0L) return(integer()); res <- integer(); last <- alpha[1L]; cnt <- 1L; i <- 2L; while (i<=length(alpha)) { if (alpha[i]==last) cnt <- cnt+1L else { res[length(res)+1L] <- cnt; last <- alpha[i]; cnt <- 1L; }; i <- i+1L; }; res[length(res)+1L] <- cnt; res; }; 
flick <- function(alpha) rle(alpha)$lengths; 

alpha <- c('a','a','a','b','c','c','c','a','c','c'); 

expected <- c(3L,1L,3L,1L,2L); 
identical(expected,bgoldst(alpha)); 
## [1] TRUE 
identical(expected,akrun(alpha)); 
## [1] TRUE 
identical(expected,bethany(alpha)); 
## [1] TRUE 
identical(expected,flick(alpha)); 
## [1] TRUE 

microbenchmark(bgoldst(alpha),akrun(alpha),bethany(alpha),flick(alpha)); 
## Unit: microseconds 
##   expr  min  lq  mean median  uq  max neval 
## bgoldst(alpha) 8.553 11.1200 14.85308 12.8300 15.3970 70.136 100 
## akrun(alpha) 129.151 144.9745 163.64182 156.7350 171.4895 313.898 100 
## bethany(alpha) 20.101 23.9500 30.43242 26.5155 37.8475 70.136 100 
## flick(alpha) 20.100 23.9495 30.44956 28.0120 32.2890 62.866 100 

set.seed(1L); N <- 1e5L; alpha <- sample(letters[1:3],N,T); 

expected <- bgoldst(alpha); 
identical(expected,akrun(alpha)); 
## [1] TRUE 
identical(expected,bethany(alpha)); 
## [1] TRUE 
identical(expected,flick(alpha)); 
## [1] TRUE 

microbenchmark(bgoldst(alpha),akrun(alpha),bethany(alpha),flick(alpha),times=10L); 
## Unit: milliseconds 
##   expr   min   lq  mean  median   uq   max neval 
## bgoldst(alpha) 5.497899 6.469098 11.007558 6.521699 7.297460 49.891634 10 
## akrun(alpha) 1.300492 1.370199 1.547461 1.401631 1.464282 2.816091 10 
## bethany(alpha) 2865.335271 2891.594408 2941.352229 2924.165053 2997.881411 3024.234204 10 
## flick(alpha) 8.060392 9.355323 13.646002 10.055176 10.841843 48.312741 10