使用R编码序列长度

Question

有没有办法在R中编码增加的整数序列,类似于使用行程编码(rle)编码运行长度？

我将举例说明:

类比:行程编码

r <- c(rep(1, 4), 2, 3, 4, rep(5, 5))
rle(r)
Run Length Encoding
  lengths: int [1:5] 4 1 1 1 5
  values : num [1:5] 1 2 3 4 5

期望:序列长度编码

s <- c(1:4, rep(5, 4), 6:9)
s
[1] 1 2 3 4 5 5 5 5 6 7 8 9

somefunction(s)
Sequence lengths
  lengths: int [1:4] 5 1 1 5
  value1 : num [1:4] 1 5 5 5

编辑1

因此,somefunction(1:10)将给出结果:

Sequence lengths
  lengths: int [1:1] 10
  value1 : num [1:1] 1 

该结果意味着存在长度为10的整数序列,其起始值为1,即 seq(1, 10)

请注意,我的示例结果中没有错误.实际上,载体以序列5:9结束,而不是6:9,用于构建它.

我的用例是我正在使用SPSS导出文件中的调查数据.问题网格中的每个子问题都将具有模式的名称paste("q", 1:5),但有时会有一个"其他"类别将被标记q_99,q_other或者其他.我希望找到一种识别序列的方法.

编辑2

在某种程度上,我所需的函数是基函数的反函数sequence,value1在我的例子中添加了起始值.

lengths <- c(5, 1, 1, 5)
value1 <- c(1, 5, 5, 5)

s
[1] 1 2 3 4 5 5 5 5 6 7 8 9
sequence(lengths) + rep(value1-1, lengths) 
[1] 1 2 3 4 5 5 5 5 6 7 8 9

编辑3

我应该说,我的目的,一个序列定义为递增的整数序列,而不是单调递增序列,如c(4,5,6,7)但不能c(2,4,6,8)也不c(5,4,3,2,1).但是,序列之间可能出现任何其他整数.

这意味着解决方案应该能够应对这个测试用例:

somefunction(c(2, 4, 1:4, 5, 5))
    Sequence lengths
      lengths: int [1:4] 1 1 5 1
      value1 : num [1:4] 2 4 1 5 

在理想情况下,解决方案还可以处理最初建议的用例,其包括向量中的字符,例如

somefunction(c(2, 4, 1:4, 5, "other"))
    Sequence lengths
      lengths: int [1:5] 1 1 5 1 1
      value1 : num [1:5] 2 4 1 5 "other"

Answer 1

编辑:添加控件以执行角色向量.

基于rle,我来看下面的解决方案:

somefunction <- function(x){

    if(!is.numeric(x)) x <- as.numeric(x)
    n <- length(x)
    y <- x[-1L] != x[-n] + 1L
    i <- c(which(y|is.na(y)),n)

    list(
      lengths = diff(c(0L,i)),
      values = x[head(c(0L,i)+1L,-1L)]
    )

}

> s <- c(2,4,1:4, rep(5, 4), 6:9,4,4,4)

    > somefunction(s)
    $lengths
    [1] 1 1 5 1 1 5 1 1 1

    $values
    [1] 2 4 1 5 5 5 4 4 4

这个适用于我尝试的每个测试用例,并使用没有ifelse子句的矢量化值.应该跑得更快.它将字符串转换为NA,因此您保持数字输出.

> S <- c(4,2,1:5,5, "other" , "other",4:6,2)

> somefunction(S)
$lengths
[1] 1 1 5 1 1 1 3 1

$values
[1]  4  2  1  5 NA NA  4  2

Warning message:
In somefunction(S) : NAs introduced by coercion

Answer 2

这是我的解决方案

diff_s = which(diff(s) != 1)
lengths = diff(c(0, diff_s, length(s)))
values  = s[c(1, diff_s + 1)]

编辑:功能,以照顾字符串

sle2 = function(s){
  s2 = as.numeric(s)
  s2[is.na(s2)] = 100 + as.numeric(factor(s[is.na(s2)]))
  diff_s2 = which(diff(s2) != 1)
  lengths = diff(c(0, diff_s2, length(s)))
  values  = s[c(1, diff_s2 + 1)]
  return(list(lengths = lengths, values = values))
}

sle2(c(4,2,1:5,5, "other" , "other",4:6,2, "someother", "someother"))

lengths
 [1] 1 1 5 1 1 1 3 1 1 1

$values
 [1] "4"   "2"  "1"   "5"  "other" "other"  "4"   "2"  "someother" "someother"

Warning message:
In sle2(c(4, 2, 1:5, 5, "other", "other", 4:6, 2, "someother", "someother")) :
  NAs introduced by coercion