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

时间:2018-04-18 06:42:14

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

我正在尝试使用rle()(或其他相关功能)来解决R的问题,但我不知道从哪里开始。问题如下 - foobarbazqux可以位于以下三个位置之一 - AB,或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

基本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"

5 个答案:

答案 0 :(得分:3)

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

答案 1 :(得分:1)

以下是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

答案 2 :(得分:0)

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

答案 3 :(得分:0)

方法可以是,

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 :(得分:0)

问题似乎是双重的。调整'第一'和'最后'元素,并确定什么构成'第一'和'最后'。我喜欢你的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)
}