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

Question

我正在尝试使用 rle()（或其他相关函数）解决 R 的问题，但我不确定从哪里开始。问题如下 - foo、bar、baz 和 qux 可以位于三个位置之一 - A、B、或 C。

他们的第一个位置永远是 A，最后一个位置永远是 C，但他们之间的位置是随机的。

我的objective是消除A的第一个Aor第一个序列，最后一个Cor最后一个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"

Answer 1

我会使用 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"

数据

foo <- c("A", "A","A", "B", "B", "A", "B", "A", "C")
bar <- c("A", "B","A", "B", "A", "C", "C", "C", "C", "C")
baz <- c(rep("A", 5), rep("C", 5))
qux <- c("A", "C", "A", "C", "A", "C")
first_position <- "A"
last_position <- "C"

Answer 2

这是 rle 的一个选项。这个想法是对第一个和最后一个 values 进行子集化，检查它是否等于 'A'、'C'，将其分配给 NA 并将其转换为逻辑 vector 用于子集

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

Answer 3

没有 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

数据：

foo <- fread("position
A
A
A
B
B
A
B
A
C
C")

baz <- fread("position
A
A
A
A
A
C
C
C
C
C")

Answer 4

一个data.table方法可以是，

library(data.table)

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

这给出了，

   position
1:        B
2:        B
3:        A
4:        B
5:        A

Answer 5

问题似乎有两个方面。修剪 'first' 和 'last' 元素，并识别什么构成 'first' 和 'last'。我喜欢您的 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

解决方案（return掩码；很容易修改为return实际值，x[inverse.rle(r)]）然后

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

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

Using rle to eliminate first and last sequences

r

run-length-encoding

dplyr

data.table