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

【问题标题】：Using rle to eliminate first and last sequences使用 rle 消除第一个和最后一个序列
【发布时间】：2018-04-18 06:42:14
【问题描述】：

我正在尝试使用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"

【问题讨论】：

标签： r dplyr data.table run-length-encoding

【解决方案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"

【讨论】：

【解决方案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

【讨论】：

【解决方案3】：

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

【讨论】：

【解决方案4】：

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

【讨论】：

照顾好纸箱。这不适用于baz。
谢谢，@mt1022。我没有注意到右边的滚动条，正在挠头baz和qux

【解决方案5】：

问题似乎有两个方面。修剪“第一个”和“最后一个”元素，并确定什么构成“第一个”和“最后一个”。我喜欢您的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)]）然后是

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

【讨论】：