R Tidy：动态顺序阈值

Question

我正在尝试找到一种简洁的方法来动态调整阈值，因为我 "move" 使用 library(tidyverse) 通过小标题。例如，想象一个包含顺序观察的小标题：

example <- 
  tibble(observed = c(2,1,1,2,2,4,10,4,2,2,3))
example
# A tibble: 11 x 1
   observed
      <dbl>
 1        2
 2        1
 3        1
 4        2
 5        2
 6        4
 7       10
 8        4
 9        2
10        2
11        3

我正在尝试计算一个阈值，该阈值从初始值 (2) 开始并按预先指定的数量（在本例中为 1）递增，除非当前观察值大于该阈值，在这种情况下 当前观察成为参考阈值，进一步的阈值从中增加。这是最终的 tibble 的样子：

answer <- 
  example %>%
  mutate(threshold = c(2,3,4,5,6,7,10,11,12,13,14))
answer
# A tibble: 11 x 2
   observed threshold
      <dbl>     <dbl>
 1        2         2
 2        1         3
 3        1         4
 4        2         5
 5        2         6
 6        4         7
 7       10        10
 8        4        11
 9        2        12
10        2        13
11        3        14

我正在寻找使用 dplyr/tidy 执行此操作的最佳方法。感谢所有帮助！

编辑：

到目前为止的答案非常接近，但在观察值下降并再次增加的情况下会错过。例如，考虑与上面的 example 相同的小标题，但在最终观察中使用 4 而不是 3：

example <- 
  tibble(observed = c(2,1,1,2,2,4,10,4,2,2,4))
example
# A tibble: 11 x 1
   observed
      <dbl>
 1        2
 2        1
 3        1
 4        2
 5        2
 6        4
 7       10
 8        4
 9        2
10        2
11        4

diff & cumsum 方法给出：

example %>%
  group_by(gr = cumsum(c(TRUE, diff(observed) > thresh))) %>%
  mutate(thresold = first(observed) + row_number() - 1) %>%
  ungroup %>%
  select(-gr)

A tibble: 11 x 2
   observed thresold
      <dbl>    <dbl>
 1        2        2
 2        1        3
 3        1        4
 4        2        5
 5        2        6
 6        4        4
 7       10       10
 8        4       11
 9        2       12
10        2       13
11        4        4

最终阈值不正确的地方。

Answer 1

您可以使用 diff 创建组并将组中的行号添加到 first 值。

library(dplyr)
thresh <- 1

example %>%
   group_by(gr = cumsum(c(TRUE, diff(observed) > thresh))) %>%
   mutate(thresold = first(observed) + row_number() - 1) %>%
   ungroup %>%
   select(-gr)

# A tibble: 11 x 2
#   observed thresold
#      <dbl>    <dbl>
# 1        2        2
# 2        1        3
# 3        1        4
# 4        2        5
# 5        2        6
# 6        4        4
# 7       10       10
# 8        4       11
# 9        2       12
#10        2       13
#11        3       14

要了解如何在此处创建群组，请查看详细步骤：

我们先计算连续值之间的差值

diff(example$observed) 
#[1] -1  0  1  0  2  6 -6 -2  0  1

请注意，diff 给出的输出长度比实际长度少 1。

我们将其与 thresh 进行比较，每次我们的值大于阈值

时都会给出 TRUE

diff(example$observed) > thresh
 #[1] FALSE FALSE FALSE FALSE  TRUE  TRUE FALSE FALSE FALSE FALSE

现在因为 diff 的输出值少一，所以我们加一值作为 TRUE

c(TRUE, diff(example$observed) > thresh)
# [1]  TRUE FALSE FALSE FALSE FALSE  TRUE  TRUE FALSE FALSE FALSE FALSE

然后最后使用 cumsum 创建用于 group_by 的组。

cumsum(c(TRUE, diff(example$observed) > thresh))
# [1] 1 1 1 1 1 2 3 3 3 3 3

编辑

对于更新后的问题，我们可以添加另一个条件来检查先前的值是否大于当前计数并相应地更新值。

example %>%
  group_by(gr = cumsum(c(TRUE, diff(observed) > thresh) & 
                observed > first(observed) + row_number())) %>%
  mutate(thresold = first(observed) + row_number() - 1) %>%
  ungroup() %>%
  select(-gr)

# A tibble: 11 x 2
#   observed thresold
#      <dbl>    <dbl>
# 1        2        2
# 2        1        3
# 3        1        4
# 4        2        5
# 5        2        6
# 6        4        7
# 7       10       10
# 8        4       11
# 9        2       12
#10        2       13
#11        4       14

Answer 2

我们可以创建具有列差异lag的分组变量

library(dplyr)
thresh <- 1
example %>%
   group_by(grp = cumsum((observed - lag(observed, default = first(observed)) >
             thresh))) %>%
   mutate(threshold = observed[1] + row_number()  - 1) %>%
   ungroup %>%
          mutate(new = row_number() + 1, 
    threshold = pmax(threshold, new)) %>%     
   select(-grp, -new)
# A tibble: 11 x 2
#   observed threshold
#      <dbl>     <dbl>
# 1        2         2
# 2        1         3
# 3        1         4
# 4        2         5
# 5        2         6
# 6        4         7
# 7       10        10
# 8        4        11
# 9        2        12
#10        2        13
#11        3        14

Answer 3

我想我已经想出了一个方法来做到这一点，利用 zoo::locf（虽然我不确定这部分是否真的有必要）。

首先创建我在描述中列出的两个示例中较难的一个：

example2 <- 
  tibble(observed = c(2,1,1,2,2,4,10,4,2,2,4))

example2 %>%
  mutate(def = first(observed) + row_number() - 1) %>%
  mutate(t1 = pmax(observed,def)) %>%
  mutate(local_maxima = ifelse(observed == t1,t1,NA)) %>%
  mutate(groupings = zoo::na.locf(local_maxima)) %>%
  group_by(groupings) %>%
  mutate(threshold = groupings + row_number() - 1) %>%
  ungroup() %>%
  select(-def,-t1,-local_maxima,-groupings)

结果：

# A tibble: 11 x 2
   observed threshold
      <dbl>     <dbl>
 1        2         2
 2        1         3
 3        1         4
 4        2         5
 5        2         6
 6        4         7
 7       10        10
 8        4        11
 9        2        12
10        2        13
11        4        14

如果有人找到更优雅的解决方案，我肯定会更喜欢。

R Tidy：动态顺序阈值

R Tidy : Dynamic Sequential Threshold

r

dplyr

tidy