我正在尝试使用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
基本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"
答案 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)
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 :(得分: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)
}