首页 文章

dplyr抑制组中下一个n次出现的值

提问于
浏览 次
7

我最近在寻找有关如何使用dplyr（dplyr override all but the first occurrences of a value within a group）抑制组中第一次出现的值的建议 .

解决方案是一个非常聪明的解决方案，现在我正努力找到一些同样有效的东西，以防我需要仅抑制n个下一个值 .

例如，在下面的代码中，我创建了一个新的“标记”列：

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

在setosa组行中：4,6,7，...被标记为“1” . 在任何出现“1”之后，我试图在接下来的两行中抑制“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

r dplyr

3 回答

  • 4

    对我来说，如果你使用累积缩小来跟踪折射周期，这在语义上更清晰 .

    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
    回复于
  • 3

    我想不出比循环更好的方法：

    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 元素 . 我是一个严重的问题 .

    回复于
  • 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
    回复于

相关问题