使用rle消除第一个和最后一个序列

我试图使用

rle（）

（或其他相关函数）解决R的问题，但不确定从何处开始。问题如下-

foo

、

bar

和

baz

和

qux

可以位于三个位置之一-

A

、

B

或

C

它们的第一个位置总是

A

，最后一个位置总是

C

，但它们之间的位置是随机的

我的目标是消除第一个A或A的第一个序列，以及最后一个C或C的最后一个序列。例如：

> foo
   position
1         A
2         A
3         A
4         B
5         B
6         A
7         B
8         A
9         C
10        C

> output(foo)
   position

4         B
5         B
6         A
7         B
8         A


> bar
   position
1         A
2         B
3         A
4         B
5         A
6         C
7         C
8         C
9         C
10        C

> output(bar)
   position

2         B
3         A
4         B
5         A

> baz
   position
1         A
2         A
3         A
4         A
5         A
6         C
7         C
8         C
9         C
10        C

> output(baz)
NULL

> qux
  position
1        A
2        C
3        A
4        C
5        A
6        C

> output(qux)
  position
2        C
3        A
4        C
5        A

Basic

rle（）

将告诉我序列及其长度，但它不会保留行索引。如何着手解决这个问题

> rle(foo$position)
Run Length Encoding
  lengths: int [1:6] 3 2 1 1 1 2
  values : chr [1:6] "A" "B" "A" "B" "A" "C"

---

我将使用

cumsum

编写一个函数，其中检查有多少第一个连续值以

first_position

开头，以及有多少最后一个连续值以

last_position

开头，并将其删除

get_reduced_data <- function(dat, first_position, last_position) {
    dat[cumsum(dat != first_position) != 0 &
   rev(cumsum(rev(dat) != last_position) != 0)]
 }

get_reduced_data(foo, first_position, last_position)
#[1] "B" "B" "A" "B" "A"

get_reduced_data(bar, first_position, last_position)
#[1] "B" "A" "B" "A"

get_reduced_data(baz, first_position, last_position)
#character(0)

get_reduced_data(qux, first_position, last_position)
#[1] "C" "A" "C" "A"

---

get\u reduced\u data这里有一个带有
rle
的选项。想法是将第一个和最后一个
值子集，检查它是否等于'A'，'C'，将其分配给
NA
，并将其转换为逻辑
向量
，用于子集

i1 <- !is.na(inverse.rle(within.list(rle(foo$position), 
     values[c(1, length(values))][values[c(1, length(values))] == c("A", "C")] <- NA)))
foo[i1, , drop = FALSE]
#    position
#4        B
#5        B
#6        A
#7        B
#8        A

i1不使用
rle
的另一种可能的解决方案，通过在非A和非C的第一次出现和最后一次出现之间创建索引和子集行：

library(data.table)
output <- function(DT) {
    DT[, rn:=.I][,{
            mn <- min(which(position!="A"))
            mx <- max(which(position!="C"))
            if (mn > mx) return(NULL)
            .SD[mn:mx]
        }]
}

output(setDT(foo))
#   position rn
#1:        B  4
#2:        B  5
#3:        A  6
#4:        B  7
#5:        A  8

output(setDT(baz))
#NULL

库（data.table）
输出一种方法可以是

library(data.table)

setDT(df)[, grp := rleid(position)][
  !(grp == 1 & position == 'A' | grp == max(grp) & position == 'C'), ][
    , grp := NULL][]

这就给了,

这个问题似乎是双重的。修剪“第一个”和“最后一个”元素，并确定“第一个”和“最后一个”的组成部分。我喜欢您的
rle（）
方法，因为它将许多可能性映射到一个公共结构中。因此，任务是编写一个函数来屏蔽任意长度向量的第一个和最后一个元素

mask_end = function(x) {
    n = length(x)
    mask = !logical(n)
    mask[c(min(1, n), max(0, n))] = FALSE  # allow for 0-length x
    mask
}

这很容易进行全面测试

> mask_end(integer(0))
logical(0)
> mask_end(integer(1))
[1] FALSE
> mask_end(integer(2))
[1] FALSE FALSE
> mask_end(integer(3))
[1] FALSE  TRUE FALSE
> mask_end(integer(4))
[1] FALSE  TRUE  TRUE FALSE

解决方案（返回掩码；易于修改以返回实际值，
x[inverse.rle（r）]
）如下所示

处理好康纳的案子。这不适用于
baz
。谢谢，@mt1022。我没有注意到右边的滚动条，在
baz
和
qux
   position
1:        B
2:        B
3:        A
4:        B
5:        A

mask_end = function(x) {
    n = length(x)
    mask = !logical(n)
    mask[c(min(1, n), max(0, n))] = FALSE  # allow for 0-length x
    mask
}

> mask_end(integer(0))
logical(0)
> mask_end(integer(1))
[1] FALSE
> mask_end(integer(2))
[1] FALSE FALSE
> mask_end(integer(3))
[1] FALSE  TRUE FALSE
> mask_end(integer(4))
[1] FALSE  TRUE  TRUE FALSE

mask_end_runs = function(x) {
    r = rle(x)
    r$values = mask_end(r$values)
    inverse.rle(r)
}