我有数据集
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
答案 0 :(得分：1)
该代码有几个严重的缺陷：
code和item进行的分组action == 1之前包括1行，在其后包括2行。 li>
如果我正确理解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是一个正则表达式，它寻找1的任何序列，并由所需数量的前导和尾随0包围。
实际上，正则表达式要复杂一些，因为我们必须使用 lookahead 来捕获重叠的动作模式，例如000111000中的000111000111000。前瞻正则表达式的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")