dplyrグループ内の値の次のn個のオカレンスを抑制する

Question

最近、dplyr（）を使用してグループ内の値の最初の出現以外のすべてを抑止する方法をアドバイスしました。

解決策は本当に巧妙なものでしたが、今度はn個の次の値だけを抑制する必要がある場合に、同じように効率的なものを見つけるのに苦労しています。例えば

、I以下のコードで新たな "タグ" 欄作成：setosaグループ行で

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

：4、6、7、... "1" としてタグ付けされています。私は、 "1"が発生した後に次の2つの行で "1"を抑制しようとしています（つまり、それらを "0"に変換しようとしています）。言い換えれば、行＃5と＃6は "0"に設定されなければならないが、＃7は影響を受けないままであるべきである。この場合、7行目は「1」なので、8行目と9行目は「0」に設定する必要があります。

dplyrでこれを行う方法についてのヒントはありますか？いくつかのより多くの例このパッケージは本当に強力ですが、その理由のために、それは私がすべての機微を習得するための精神的な挑戦です...

---

： の場合：0 0 1 1、出力は0にしてください以下の場合は0 1 0 ：0 0 1 1 1 1 1、出力が0 0 1 0 0 1 0

Answer 1

私には、屈折を追跡するために累積減算を使用すると、意味的に明確になります期間。

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

例

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

Answer 2

する必要があります私はループよりも、これを行うに任意のより良い方法を考えることはできません。

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

スピードアップの可能性がある場合は、ループをif (keep[i]) keep[i+seq_len(nf)][match(w[i]+seq_len(nf), w[i+seq_len(nf)])] = FALSEに切り替えることができますmatchは、wの次のnf要素のみを検索します。もしそれが深刻な問題であれば、Rcppはもっと速くなるだろうと確信しています。

Answer 3

ちょっと不器用しかし、あなたは関係なく、

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 

ベクトルそして、あなたの例

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 

を歩いする必要があり、あなたが好きで置き換えることができますように思える

(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