R: Удалить интервалы по критериям с допуском перекрытия

Question

Я искал решение, чтобы создать некоторую маску, с помощью которой я могу удалить некоторые данные (например, строки в data.frame) в зависимости от некоторых критериев, например:

a <- c(0,0,0,3,5,6,3,0,0,0,4,5,8,5,0,0,0,0,0) 
mask <- a == 0 
mask 
[1] TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE TRUE 

В моей реальной проблеме этот разрез слишком суровый, я хотел бы иметь более плавный переход. Идея: я хочу включить некоторые нули перед не-нулями, а также добавить некоторые нули после ненулевых. Простой подход: если у меня есть этот вектор, я хотел бы переключить каждый TRUE, расположенный рядом с FALSE, на FALSE, что добавляет перекрывающуюся область допуска к данным. Таким образом, вместо

a[!mask] 
[1] 3 5 6 3 4 5 8 5 

Я предпочел бы иметь что-то вроде

a[!mask] 
[1] 0 3 5 6 3 0 0 4 5 8 5 0 

или (увеличение размера окна допуска)

a[!mask] 
[1] 0 0 3 5 6 3 0 0 0 4 5 8 5 0 0 

В последнем случае трех нулей в середине возникают, поскольку допуски слева и справа начинают перекрываться. Мой вопрос: есть ли у кого хороший подход, как написать функцию для создания такой маски с перекрывающимся толерантностью?

[EDIT] Это мне какое-то время я понял ошибку в моем первоначальном вопросе (спасибо @tospig) В моем первоначальном посте я полностью сделал число нулей в средней части неправильным! Извините за путаницу. Итак, для уточнения: в случае окна допуска 1, действительно должно быть два нуля в середине: один из правой группы действительных данных, один из левого пучка действительных данных. Извините за беспорядок!

Итак, несмотря на действительно классный подход от @tospig (что я должен помнить), решение от @agenis отлично решает мою проблему!

Answer 1

Я думаю, что я бы с классическим скользящей средней 3-го порядка, который просто расширяет «не-нули» один налево и один направо. Это просто. Вам просто нужно выяснить, что вы делаете с первой и последней точкой вашего вектора, которые превращены в NA (в моем примере я делаю их нулями).

И у вас есть желаемый результат (для большей маски вы принимаете заказ 5 вместо 3):

a <- c(0,0,0,3,5,6,3,0,0,0,4,5,8,5,0,0,0,0,0) 
library(forecast) 
a.ma <- ma(a, 3) 
a.ma[is.na(a.ma)] <- 0 
mask <- a.ma == 0 
a[!mask] 
#### [1] 0 3 5 6 3 0 0 4 5 8 5 0 

Тогда вы можете легко превратить этот кусок кода в функции.

[EDIT] этот метод не обеспечивает сохранение полного числа нулей (см дополнительных комментариев для уточнения OP первоначального вопроса)

Answer 2

Мы можем попробовать

library(data.table) 
lst1 <- split(a[!mask],rleid(mask)[!mask]) 

c(0,unlist(Map(`c`, lst1, 0), use.names=FALSE)) 
#[1] 0 3 5 6 3 0 4 5 8 5 0 

---

Или другой вариант

n <- 1 
i1 <- !inverse.rle(within.list(rle(mask), { 
      lengths[values] <- lengths[values]-n 
      lengths[!values] <- lengths[!values]+n})) 
c(a[i1],0) 
#[1] 0 3 5 6 3 0 4 5 8 5 0 

Answer 3

Вот решение, которое позволяет определить допуск. На данный момент он не «перекрывает» нули.

Мы можем использовать data.table структуру (или data.frame, но я люблю использовать data.table) и контролировать, сколько нулей мы хотим, чтобы между множеством положительных чисел. Мы можем указать любое значение tolerance, но если оно больше последовательности нулей, будет возвращено только максимальное количество последовательных нулей.

a <- c(0,0,0,3,5,6,3,0,0,0,4,5,8,5,0,0,0,0,0) 

library(data.table) 
tolerance <- 1 

dt <- data.table(id = seq(1, length(a), by = 1), 
        a = a) 

## subset all the 0s, with their 'ids' for joining back on 
dt_zero <- dt[a == 0] 

## get the positions where the difference between values is greater than one, 
## and create groups based on their length 
changed <- which(c(TRUE, diff(dt_zero$id) > 1)) 
dt_zero$grps <- rep(changed, diff(c(changed, nrow(dt_zero) + 1))) 

## we only need the 'tolerance' number of zeros 
## if 'tolerance' is greater than number of entries in a group, 
## it will return 'na' 
dt_zero <- dt_zero[ dt_zero[ order(id) , .I[c(1:tolerance)], by=grps ]$V1, ] 

## join back onto original data.table, 
## and subset only relevant results 
dt_zero <- dt_zero[, .(id, a)][ dt , on = "id"][(is.na(a) & i.a > 0) | a == 0] 

res <- dt_zero$i.a 
res 
# [1] 0 3 5 6 3 0 4 5 8 5 0 

## try different tolerances 
tolerance <- 2 
... 
# 0 0 3 5 6 3 0 0 4 5 8 5 0 0 

tolerance <- 6 
... 
# 0 0 0 3 5 6 3 0 0 0 4 5 8 5 0 0 0 0 0