使用 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

Answer 3

你可以用这个作为开始（上面给你s）：

s2<-c(0, diff(s))
s3<-ifelse((c(s2[-1], 0)==1) & (s2!=1), 1, s2)
rle(ifelse(s3==1, -1, seq_along(s3)))

它还没有返回值，可能有足够简单的方法来调整代码。至少您有序列长度，因此您可以轻松检索序列的起始值。

Answer 4

怎么样：

sle <- function(s)
{
    diffs <- which(diff(s)!=1)
    lengths <- c(diffs[1],diff(diffs),length(s)-diffs[length(diffs)])
    value1 <- s[c(1,diffs+1)]
    cat("", "Sequence Length Encoding\n", " lengths:")
    str(lengths)
    cat("  value1:")
    str(value1)
}


sle(s)
 Sequence Length Encoding
  lengths: int [1:4] 5 1 1 5
  value1: num [1:4] 1 5 5 5

sle(c(2,4,1:4,rep(5,4),6:9,4,4,4))
 Sequence Length Encoding
  lengths: int [1:9] 1 1 5 1 1 5 1 1 1
  value1: num [1:9] 2 4 1 5 5 5 4 4 4

Answer 5

这是对 Joris Meys 解决方案的增强。考虑这是对未来问题的解决方案:-)。

卡尔

seqle <- function(x,incr=1) {
    if(!is.numeric(x)) x <- as.numeric(x)
    n <- length(x)
    #y <- x[-1L] != x[-n] + 1L
    y <- x[-1L] != x[-n] + incr
    i <- c(which(y|is.na(y)),n)
    list( lengths = diff(c(0L,i)),  values = x[head(c(0L,i)+1L,-1L)])
}

Answer 6

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

当我从 Confirmit、DASH、SPSS、SAS、MySQL 或其他任何东西中提取数据时，我通常会这样做，这取决于它总是被放入 data.frame() 的来源：

surv.pull <- function(dat, pattern) {
  dat <- data.frame(dat[,grep(pattern,colnames(dat))],check.names=F)
return(dat)
}

如果你像[q][_][9][9] 一样使用pattern，你可以通过添加“.”来决定是否拉取其他数据空间的data.frame。到最后[q][_][9][9].，以便它拉q_99whatever

我的大部分数据列都是这样的 q8a.1, .3, .4, .5, .6, .7, .8, ... 所以surv.pull(dat, "[q][8][a].") 会将它们全部提取出来，包括其他，如果有指定。显然，使用正则表达式你可以决定是否拉另一个。

另外，一般惯例是将其他指定问题推到数据空间的末尾，因此快速df <- df[-ncol(df)] 将删除它或other_list <- df[ncol(df)] 将保存它。