替换中位数时不正确的 Rscript 工作

Question

我有数据集

mydat=structure(list(code = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L), .Label = "52382МСК", class = "factor"), item = c(11709L, 
11709L, 11709L, 11709L, 1170L, 1170L, 1170L, 1170L), sales = c(30L, 
10L, 20L, 15L, 8L, 10L, 2L, 15L), action = c(0L, 1L, 0L, 0L, 
0L, 1L, 0L, 0L)), .Names = c("code", "item", "sales", "action"
), class = "data.frame", row.names = c(NA, -8L))

按代码和项目分为两组

code    item
52382МСК    11709
52382МСК    1170

我还有行动专栏。它只能有两个值零（0）或一（1）。我需要按动作列通过 1 个前面的零类别计算中位数，即在一类动作列之前，并通过在一个类别之后的动作列计算 2 个零。 如果中位数大于销售额，则不要替换它。

如果我按动作列有三个前面的零类别，即在一个动作列类别之前，并且在一个类别之后的动作列有三个零，则此解决方案很好。 但是，如果我按动作列有 1 个前面的零类别，即在一个类别的动作列之前，并且在一个类别之后的动作列有 2 个零。它不正确

replacements <- 
  data_frame(
    action1      = which(mydat$action == 1L),
    group        = rep(1:length(action1), each = 2, length.out = length(action1)),
    sales1       = mydat$sales[action1],
    sales_before = mydat$sales[action1 -1L],
    sales_after  = mydat$sales[action1 +2L]
  ) %>%
  group_by(group) %>%
  mutate(
    med   = median(c(sales_before, sales_after)),
    output = pmin(sales1, med)
  )

mydat$output <- mydat$sales
mydat$output[replacements$action1] <- replacements$output

我得到输出

   code  item sales action output
1 52382МСК 11709    30      0     30
2 52382МСК 11709    10      1     10
3 52382МСК 11709    20      0     20
4 52382МСК 11709    15      0     15
5 52382МСК  1170     8      0      8
6 52382МСК  1170    10      1     10
7 52382МСК  1170     2      0      2
8 52382МСК  1170    15      0     15

但输出应该是

   code  item sales action output
1 52382МСК 11709    30      0     30
2 52382МСК 11709    10      1     10
3 52382МСК 11709    20      0     20
4 52382МСК 11709    15      0     15
5 52382МСК  1170     8      0      8
6 52382МСК  1170    10      1     **8**
7 52382МСК  1170     2      0      2
8 52382МСК  1170    15      0     15

我怎样才能得到正确的输出？

编辑

   code item sales action
1     a    b     2      0
2     a    b     4      0
3     a    b     3      0
4     a    b    10      1
5     a    b     4      1
6     a    b    10      0
7     a    b     6      0
8     a    b     6      0
9     c    d     2      0
10    c    d     4      0
11    c    d     3      0
12    c    d    10      1
13    c    d    10      0
14    c    d     6      0
15    c    d     6      0

Answer 1

代码有几个严重的缺陷：

• 完全忽略code 和item 的分组
• 它只选择 两个 值进行中值计算，而不是整个范围的零操作行，而 OP 要求在每个 action == 1 之前包括 1 行和之后 2 行。

如果我正确理解了 OP 的要求，

• OP 希望通过计算每个销售操作前后一段时间内的销售额中位数（不包括操作期间的销售额）并将其与实际销售额进行比较来衡量销售操作的效果
• 分别针对code 和item 标识的每个产品。
• 每个销售操作的长度可能会有所不同（action == 1 的条纹）
• 以及每次操作前后的天数。
• 预期输出是零操作日的销售数据。在行动日，该数字将替换为周围零行动日的中位数销售额但前提是低于实际销售额。

下面的函数接受三个参数，即日期帧和销售操作之前和之后的零天数。它返回一个 data.table，其中附加了上述规则所定义的 output 列。

sales_action <- function(DF, zeros_before, zeros_after) {
  library(data.table)
  library(magrittr)
  action_pattern <- 
    do.call(sprintf, 
            c(fmt = "%s1+(?=%s)", 
              stringr::str_dup("0", c(zeros_before, zeros_after)) %>% as.list()
            ))
  message("Action pattern used: ", action_pattern)
  setDT(DF)[, rn := .I]
  tmp <- DF[, paste(action, collapse = "") %>% 
              stringr::str_locate_all(action_pattern) %>% 
              as.data.table() %>% 
              lapply(function(x) rn[x]),
            by = .(code, item)][
              , end := end + zeros_after]
  DF[tmp, on = .(code, item, rn >= start, rn <= end), 
     med := as.double(median(sales[action == 0])), by = .EACHI][
       , output := as.double(sales)][action == 1, output := pmin(sales, med)][
         , c("rn", "med") := NULL][]
}

对于我们得到的 OP 给出的mydat

sales_action(mydat, 1L, 2L)

Action pattern used: 01+00
       code  item sales action output
1: 52382MCK 11709    30      0     30
2: 52382MCK 11709    10      1     10
3: 52382MCK 11709    20      0     20
4: 52382MCK 11709    15      0     15
5: 52382MCK  1170     8      0      8
6: 52382MCK  1170    10      1      8
7: 52382MCK  1170     2      0      2
8: 52382MCK  1170    15      0     15

这符合OP的预期结果。

作为第二个测试用例，我修改了 OP 编辑​​的数据，以在其中一个组中包含第二个操作：

sales_action(mydat2, 1L, 2L)

Action pattern used: 01+00
    code item sales action output
 1:    a    b     2      0      2
 2:    a    b     4      0      4
 3:    a    b     3      0      3
 4:    a    b    10      1      3
 5:    a    b     4      1      3
 6:    a    b     2      0      2
 7:    a    b     4      0      4
 8:    a    b     3      0      3
 9:    a    b    10      1      6
10:    a    b     4      1      4
11:    a    b    10      0     10
12:    a    b     6      0      6
13:    a    b     6      0      6
14:    c    d     2      0      2
15:    c    d     4      0      4
16:    c    d     3      0      3
17:    c    d    10      1      6
18:    c    d    10      0     10
19:    c    d     6      0      6
20:    c    d     6      0      6

该示例包括针对第一个产品的两个操作，两个操作都具有 2 天的持续时间和一个针对第二个产品的持续 1 天的操作。

对于第 4、5 行，取周围零操作行的中位数，即median(c(3, 2, 4)) = 3。

对于第 9、10 行，c(3, 10, 6) 的中位数为 6，小于第 9 行的实际销售额。因此，只有第 9 行被中值替换。

对于第 17 行，c(3, 10, 6) 的中位数是 6，它取代了 output 中的实际销售额。

如果在我们得到之前和之后的 3 个零行动日被要求

sales_action(mydat2, 3L, 3L)

Action pattern used: 0001+(?=000)
    code item sales action output
 1:    a    b     2      0      2
 2:    a    b     4      0      4
 3:    a    b     3      0      3
 4:    a    b    10      1      3
 5:    a    b     4      1      3
 6:    a    b     2      0      2
 7:    a    b     4      0      4
 8:    a    b     3      0      3
 9:    a    b    10      1      5
10:    a    b     4      1      4
11:    a    b    10      0     10
12:    a    b     6      0      6
13:    a    b     6      0      6
14:    c    d     2      0      2
15:    c    d     4      0      4
16:    c    d     3      0      3
17:    c    d    10      1      5
18:    c    d    10      0     10
19:    c    d     6      0      6
20:    c    d     6      0      6

说明

关键是要确定哪些行属于每个连续行动日前后的时期。由于action 仅由0 和1 组成，我们可以使用正则表达式在字符串中使用模式匹配。

为此，action 列被折叠成一个字符串（分别为每个 code、item 组）。然后，stringr::str_locate_all() 用于查找action pattern 的开始和结束位置。 action pattern 是一个正则表达式，它正在寻找由所需数量的前导和尾随 0s 分别包围的 1s 的任何序列。

事实上，正则表达式稍微复杂一些，因为我们必须使用 lookahead 来捕获重叠的操作模式，例如 000111000111000 中的 000111000。前瞻正则表达式的end 位置指向每个序列中的最后一个1，而不是最后一个0，因此稍后将调整end。

最后，开始和结束位置转换为DF 中的行位置，而不是相对于组的位置，并在tmp 中返回。

现在，我们做一个非等值连接，它聚合和更新DF 以及一个额外的med 列，其中包含属于每个start、end 范围的零操作行的中位数销售额。

剩下的步骤是准备output 列并删除辅助列。

数据

mydat2 <-
structure(list(code = c("a", "a", "a", "a", "a", "a", "a", "a", 
"a", "a", "a", "a", "a", "c", "c", "c", "c", "c", "c", "c"), 
    item = c("b", "b", "b", "b", "b", "b", "b", "b", "b", "b", 
    "b", "b", "b", "d", "d", "d", "d", "d", "d", "d"), sales = c(2L, 
    4L, 3L, 10L, 4L, 2L, 4L, 3L, 10L, 4L, 10L, 6L, 6L, 2L, 4L, 
    3L, 10L, 10L, 6L, 6L), action = c(0L, 0L, 0L, 1L, 1L, 0L, 
    0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L)), row.names = c(NA, 
-20L), class = "data.frame")