dplyr tłumi kolejne n wystąpień wartości w grupie

Question

Niedawno szukałem porady, jak tłumić wszystkie, oprócz pierwszych wystąpień wartości w grupie, używając dplyr (dplyr override all but the first occurrences of a value within a group).

Rozwiązanie było naprawdę sprytne, a teraz walczę ze znalezieniem czegoś równie skutecznego na wypadek, gdy muszę znieść tylko kolejne wartości.

na przykład w kodzie poniżej utworzyć nowy "tag" kolumna:

library('dplyr') 
data(iris) 
set.seed(1) 
iris$tag <- sample(c(0,1), 150, replace=TRUE, prob = c(0.7, 0.3)) 
giris <- iris %>% group_by(Species) 

# Source: local data frame [150 x 6] 
# Groups: Species [3] 
# 
# Sepal.Length Sepal.Width Petal.Length Petal.Width Species tag 
#   (dbl)  (dbl)  (dbl)  (dbl) (fctr) (dbl) 
# 1   5.1   3.5   1.4   0.2 setosa  0 
# 2   4.9   3.0   1.4   0.2 setosa  0 
# 3   4.7   3.2   1.3   0.2 setosa  0 
# 4   4.6   3.1   1.5   0.2 setosa  1 
# 5   5.0   3.6   1.4   0.2 setosa  0 
# 6   5.4   3.9   1.7   0.4 setosa  1 
# 7   4.6   3.4   1.4   0.3 setosa  1 
# 8   5.0   3.4   1.5   0.2 setosa  0 
# 9   4.4   2.9   1.4   0.2 setosa  0 
# 10   4.9   3.1   1.5   0.1 setosa  0 
# ..   ...   ...   ...   ...  ... ... 

W rzędach grupy setosa: 4, 6, 7, ... są oznaczone jako "1" s. Próbuję pomijać "1" (tj. Przekształcać je do "0") w następnych dwóch wierszach po wystąpieniu "1". Innymi słowy, wiersze # 5 i # 6 powinny być ustawione na "0", ale # 7 powinno pozostać nienaruszone. W tym przypadku wiersz # 7 ma wartość "1", więc wiersze # 8 i # 9 powinny być ustawione na "0" i tak dalej ...

Jakąkolwiek wskazówkę, jak to zrobić w dplyr? Pakiet ten jest naprawdę mocny, ale z jakiegoś powodu jest to wyzwanie umysłowe mi opanować wszystkie subtelności ...

---

Więcej przykładów: w przypadku: 0 0 1 1, wyjście powinno być 0 0 1 0 w przypadku: 0 0 1 1 1 1 1, wyjście powinno być 0 0 1 0 0 1 0

Answer 1

Dla mnie jest to semantycznie bardziej przejrzyste, jeśli użyjesz reduktora akumulującego do śledzenia refrakcji Kropka.

suppress <- function(x, w) { 
    r <- Reduce(function(d,i) if(i&!d) w else max(0,d-1), x, init=0, acc=TRUE)[-1] 
    x * (r==w) 
} 

Przykład

suppress(c(0,0,1,1,1,1,1), 2) 
#>  [1] 0 0 1 0 0 1 0 

Answer 2

nie mogę myśleć o jakiejkolwiek lepszy sposób to zrobić to niż pętli:

flip_followers = function(tag, nf = 2L){ 
    w = which(tag==1L) 
    keep = rep(TRUE, length(w)) 
    for (i in seq_along(w)) if (keep[i]) keep[match(w[i]+seq_len(nf), w)] = FALSE 
    tag[w[!keep]] = 0L 
    tag 
} 

giris %>% mutate(tag = flip_followers(tag)) 



Source: local data frame [150 x 6] 
Groups: Species [3] 

    Sepal.Length Sepal.Width Petal.Length Petal.Width Species tag 
      (dbl)  (dbl)  (dbl)  (dbl) (fctr) (dbl) 
1   5.1   3.5   1.4   0.2 setosa  0 
2   4.9   3.0   1.4   0.2 setosa  0 
3   4.7   3.2   1.3   0.2 setosa  0 
4   4.6   3.1   1.5   0.2 setosa  1 
5   5.0   3.6   1.4   0.2 setosa  0 
6   5.4   3.9   1.7   0.4 setosa  0 
7   4.6   3.4   1.4   0.3 setosa  1 
8   5.0   3.4   1.5   0.2 setosa  0 
9   4.4   2.9   1.4   0.2 setosa  0 
10   4.9   3.1   1.5   0.1 setosa  0 
..   ...   ...   ...   ...  ... ... 

Aby uzyskać możliwość przyspieszenia, można przełączyć pętlę na if (keep[i]) keep[i+seq_len(nf)][match(w[i]+seq_len(nf), w[i+seq_len(nf)])] = FALSE, aby pod numerem match wyszukuje tylko następne elementy nf z w. Jestem pewien, że Rcpp byłby jeszcze szybszy, jeśli to poważna sprawa.

Answer 3

Kinda niezdarny, ale wydaje się, że trzeba iść w dół wektor niezależnie

f <- function(x, repl = c(1,0,0)) { 
    sx <- seq(x) 
    for (ii in seq_along(x)) 
    if (x[ii] == repl[1L]) ## thanks to @Frank for catching 
     x[ii:(ii + length(repl) - 1)] <- repl 
    x[sx] 
} 

(x <- c(0,0,1,1,1,1,1)); f(x) 
# [1] 0 0 1 1 1 1 1 
# [1] 0 0 1 0 0 1 0 

(x <- c(0,0,1,0,1,0,1,1)); f(x) 
# [1] 0 0 1 0 1 0 1 1 
# [1] 0 0 1 0 0 0 1 0 

a twój przykład

set.seed(1) 
head(n = 10, 
    cbind(tag <- sample(c(0,1), 150, replace=TRUE, prob = c(0.7, 0.3)), 
     tag2 = f(tag))) 

# [1,] 0 0 
# [2,] 0 0 
# [3,] 0 0 
# [4,] 1 1 
# [5,] 0 0 
# [6,] 1 0 
# [7,] 1 1 
# [8,] 0 0 
# [9,] 0 0 
# [10,] 0 0 

I można wymienić na cokolwiek chcesz

(x <- c(0,0,1,1,1,1,1)); f(x, c(1,0,0,0)) 
# [1] 0 0 1 1 1 1 1 
# [1] 0 0 1 0 0 0 1 

(x <- c(0,0,1,1,1,1,1)); f(x, 1:3) 
# [1] 0 0 1 1 1 1 1 
# [1] 0 0 1 2 3 1 2 


## courtesy of @Frank this would also work 
(x <- c(0,0,1,1,0,0,1)); f(x, 0:2) 
# [1] 0 0 1 1 0 0 1 
# [1] 0 1 2 1 0 1 2