我有数据集
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个0操作列中的一个类别后走了。 如果中位数低于销量,那么就不要更换。
该解决方案的优秀作品,如果我有行动列前三个零类,即之前的行动列的一个类别,它去,并通过三个零的操作列中的一个类别后走了。 但是,如果我有1个前述零点由操作列类别,即,前动作列中的一个类别,它去,并通过2个0通过动作列中的一个类别之后去。 它不工作正确
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曾要求包括前1行和每一后2排它选择只有两个中值计算,而不是全方位的归零动作的行值
action == 1
。
如果我理解正确OP的要求,
- 在OP想通过环绕各销售行为(不包括行动期间销售)一个周期计算的平均销量,并将其与实际销售相比较来衡量一个销售行为的影响
- 单独为每个产品,鉴定由
code
和item
。 - 每个销售动作的长度可以变化(条纹
action == 1
) - 以及天前的数量和每个动作之后。
- 预期的输出是零点行动天的销售数字。 在操作天,这个数字是由平均销售周边零点行动日内进行更换,但只有当它小于实际销售数字。
下面的函数有三个参数,dateframe和零天前和销售后的行动的数量。 它返回与一个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][]
}
对于mydat
通过我们得到的OP给出
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: ab 2 0 2 2: ab 4 0 4 3: ab 3 0 3 4: ab 10 1 3 5: ab 4 1 3 6: ab 2 0 2 7: ab 4 0 4 8: ab 3 0 3 9: ab 10 1 6 10: ab 4 1 4 11: ab 10 0 10 12: ab 6 0 6 13: ab 6 0 6 14: cd 2 0 2 15: cd 4 0 4 16: cd 3 0 3 17: cd 10 1 6 18: cd 10 0 10 19: cd 6 0 6 20: cd 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: ab 2 0 2 2: ab 4 0 4 3: ab 3 0 3 4: ab 10 1 3 5: ab 4 1 3 6: ab 2 0 2 7: ab 4 0 4 8: ab 3 0 3 9: ab 10 1 5 10: ab 4 1 4 11: ab 10 0 10 12: ab 6 0 6 13: ab 6 0 6 14: cd 2 0 2 15: cd 4 0 4 16: cd 3 0 3 17: cd 10 1 5 18: cd 10 0 10 19: cd 6 0 6 20: cd 6 0 6
说明
关键的一点是确定哪些行属于各地的行动天各纹路的时期。 作为action
仅由0
和1
,我们可以使用在字符串模式匹配与正则表达式。
为此, action
列已折叠成字符串(分别为每个code
, item
组)。 然后, stringr::str_locate_all()
是用来寻找的开始和结束位置action pattern
。 action pattern
是在寻找的任何序列的正则表达式1
S按所需数量的前缘和后包围0
S,RESP。
事实上,正则表达式是稍微复杂一些,因为我们不得不使用前瞻为了捕捉重叠的行动模式,比如000111000
在000111000111000
。 的end
的正则表达式先行点的位置到最后1
的每个序列,而不是最后在0
,所以end
将在稍后进行调节。
最后,在开始和结束位置转换成行位置DF
,而不是位置relativ到组,并返回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")