dplyr ngăn chặn lần xuất hiện tiếp theo của một giá trị trong một nhóm

Question

Gần đây tôi đã tìm kiếm lời khuyên về cách ngăn chặn tất cả trừ lần xuất hiện đầu tiên của một giá trị trong nhóm sử dụng dplyr (dplyr override all but the first occurrences of a value within a group).

Giải pháp thực sự là một giải pháp thông minh và bây giờ tôi đang gặp khó khăn trong việc tìm kiếm điều gì đó hiệu quả như nhau trong trường hợp tôi chỉ cần chặn n giá trị tiếp theo.

Ví dụ, trong đoạn code dưới đây, tôi tạo ra một mới "tag" cột:

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 
# ..   ...   ...   ...   ...  ... ... 

Trong hàng nhóm setosa: 4, 6, 7, ... được đánh dấu là "1" s. Tôi đang cố gắng ngăn chặn "1" s (tức là chuyển đổi chúng thành "0") trong hai hàng tiếp theo sau khi xảy ra bất kỳ "1" nào. Nói cách khác, các hàng # 5 và # 6 nên được đặt thành "0" nhưng # 7 sẽ không bị ảnh hưởng. Trong trường hợp này, hàng số 7 xảy ra là "1", vì vậy các hàng # 8 và # 9 phải được đặt thành "0" và cứ thế ...

Bất kỳ gợi ý nào về cách thực hiện điều này trong dplyr? Gói này là thực sự mạnh mẽ nhưng vì một lý do nó là một thách thức tinh thần cho tôi để làm chủ tất cả sự tinh tế ...

---

Một số ví dụ khác: trong trường hợp: 0 0 1 1, sản lượng nên được 0 0 1 0 trong trường hợp: 0 0 1 1 1 1 1, sản lượng nên được 0 0 1 0 0 1 0

Answer 1

Đối với tôi điều này rõ ràng về mặt ngữ nghĩa nếu bạn sử dụng giảm tích lũy để theo dõi khúc xạ giai đoạn.

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) 
} 

Ví dụ

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

Answer 2

tôi không thể nghĩ ra cách nào tốt hơn để làm điều này hơn một vòng lặp:

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 
..   ...   ...   ...   ...  ... ... 

Để có thể tăng tốc, bạn có thể chuyển vòng lặp thành if (keep[i]) keep[i+seq_len(nf)][match(w[i]+seq_len(nf), w[i+seq_len(nf)])] = FALSE để tại match chỉ tìm kiếm nf yếu tố tiếp theo của w. Tôi chắc rằng Rcpp sẽ nhanh hơn, nếu đó là một mối quan tâm nghiêm túc.

Answer 3

Kinda vụng về nhưng nó có vẻ như bạn phải đi bộ xuống các vector bất

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 

Và ví dụ

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 

của bạn Và bạn có thể thay thế với bất cứ điều gì bạn muốn

(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