替换中位数时不正确的 Rscript 工作
incorrect Rscript work when replacing medians
我有数据集
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
代码有几个严重的缺陷：
- 它完全忽略了
code 和 item 的分组
- 它只选择 两个 值进行中值计算，而不是整个范围的零操作行，而 OP 要求在每个 [=20 之前包括 1 行和之后 2 行=].
如果我正确理解了 OP 的要求，
- OP 希望通过计算每个销售行为前后一段时间内的销售额中位数（不包括行为期间的销售额）并将其与实际销售额进行比较来衡量销售行为的效果
- 分别针对
code 和 item 标识的每个产品。
- 每个销售行为的长度可能不同（
action == 1 的连续性）
- 以及每次操作前后的天数。
- 预期输出是零操作日的销售数字。在行动日，这个数字将被周围零行动日的销售额中位数所取代，但前提是它小于实际销售额。
下面的函数采用三个参数，日期范围和销售操作之前和之后的零天数。它 returns 一个 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 是一个正则表达式，它正在寻找由所需数量的前导和尾随 0 包围的任何 1 序列，resp.
事实上，正则表达式有点复杂，因为我们必须使用 lookahead 来捕获重叠的动作模式，例如 000111000 in 000111000111000.前瞻正则表达式的 end 位置指向每个序列中的最后一个 1 而不是最后一个 0，因此稍后将调整 end。
最后，开始和结束位置被转换为 DF 中的行位置，而不是相对于组的位置，并在 tmp 中返回。
现在，我们进行非等值连接，它使用一个额外的 med 列聚合和更新 DF，该列包含属于每个 [=49= 的零操作行的中位数销售额], 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")
我有数据集
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
代码有几个严重的缺陷：
- 它完全忽略了
code和item 的分组
- 它只选择 两个 值进行中值计算，而不是整个范围的零操作行，而 OP 要求在每个 [=20 之前包括 1 行和之后 2 行=].
如果我正确理解了 OP 的要求，
- OP 希望通过计算每个销售行为前后一段时间内的销售额中位数（不包括行为期间的销售额）并将其与实际销售额进行比较来衡量销售行为的效果
- 分别针对
code和item标识的每个产品。 - 每个销售行为的长度可能不同（
action == 1的连续性） - 以及每次操作前后的天数。
- 预期输出是零操作日的销售数字。在行动日，这个数字将被周围零行动日的销售额中位数所取代，但前提是它小于实际销售额。
下面的函数采用三个参数，日期范围和销售操作之前和之后的零天数。它 returns 一个 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 是一个正则表达式，它正在寻找由所需数量的前导和尾随 0 包围的任何 1 序列，resp.
事实上，正则表达式有点复杂，因为我们必须使用 lookahead 来捕获重叠的动作模式，例如 000111000 in 000111000111000.前瞻正则表达式的 end 位置指向每个序列中的最后一个 1 而不是最后一个 0，因此稍后将调整 end。
最后，开始和结束位置被转换为 DF 中的行位置，而不是相对于组的位置，并在 tmp 中返回。
现在，我们进行非等值连接，它使用一个额外的 med 列聚合和更新 DF，该列包含属于每个 [=49= 的零操作行的中位数销售额], 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")