r - 组合场景以在 R 中按组替换中位数
问题描述
我有数据集
mydat <-
structure(list(code = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("52382MCK",
"52499MCK"), class = "factor"), item = c(11709L, 11709L, 11709L,
11709L, 11708L, 11708L, 11708L, 11710L, 11710L, 11710L, 11710L,
11710L, 11710L, 11710L, 11710L, 11710L, 11710L, 11710L, 11710L,
11710L, 11710L, 11710L, 11710L, 11710L, 11710L, 11710L, 11710L,
11710L, 11202L, 11203L, 11203L, 11204L, 11204L, 11205L, 11205L
), sales = c(30L, 10L, 20L, 15L, 2L, 10L, 3L, 30L, 10L, 20L,
15L, 2L, 10L, 3L, 30L, 10L, 20L, 15L, 2L, 10L, 3L, 30L, 10L,
20L, 15L, 2L, 10L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), action = c(0L,
1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L,
1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L,
1L, 1L)), row.names = c(NA, -35L), class = "data.frame")
# coerce to data.table
setDT(mydat)
使用这个数据集，执行了几个操作。
1. selecting scenario by groups.
所以有行动栏。它只能有两个值零（0）或一（1）。
场景是第一类动作之前的零类动作的数量和一个动作类别之后的零类的数量。
For example
52382МСК 11709
这是我们有 1 个零类别的动作 col 的情况。在第一类动作 col 之前，在第一类动作 col 之后有两个零。注意：当我们有 2 个零类别的动作 col 时可能会出现这种情况。在第一类动作 col 之前，在第一类动作 col 之后 1 个零。
mydat1
code item sales action
52382МСК 11709 30 0
52382МСК 11709 10 1
52382МСК 11709 20 0
52382МСК 11709 15 0
为了检测这种情况，我使用了这个脚本/这个脚本非常有效，感谢@Uwe
library(data.table)
library(magrittr)
max_zeros <- 3
zeros <- sapply(0:max_zeros, stringr::str_dup, string = "0")
names(zeros) <- as.character(nchar(zeros))
sc <- CJ(zeros.before = zeros, zeros.after = zeros)[
, scenario.name := paste(nchar(zeros.before), nchar(zeros.after), sep = "-")][
, action.pattern := sprintf("%s1+(?=%s)", zeros.before, zeros.after)][]
# special case: all zero
sc0 <- data.table(
zeros.before = NA,
zeros.after = NA,
scenario.name = "no1",
action.pattern = "^0+$")
sc <- rbind(sc0, sc)
进而
setDT(mydat)
class <- mydat[, .(scenario.name = sc$scenario.name[
paste(action, collapse = "") %>%
stringr::str_count(sc$action.pattern) %>%
is_greater_than(0) %>%
which() %>%
max()
]),
by = .(code, item)][]
class
mydat[class, on = .(code, item)]
所以我得到了场景类的数据。
2.operation it is replace median.
对于每个场景，按零类别计算中位数。
我需要按动作列计算1个前面的零类别的中位数，即在一类动作列之前，以及在一个类别之后的动作列中计算2个零。仅针对销售列的第一类操作列执行中值替换。如果中位数大于销售额，则不要替换它。
为此，我使用脚本
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][]
}
进而
sales_action(mydat, 1L, 2L)
所以我得到了结果。
该问题基于以下内容
每次我必须手动输入场景以替换中位数
sales_action(mydat, 1L, 2L)
sales_action(mydat, 3L, 1L)
sales_action(mydat, 2L, 2L)
等等。
如何替换中位数会自动针对所有可能的场景执行，这样我就不会每次都写 sales_action(mydat, .L, .L)
所以输出的例子
code i tem sales action output pattern
52382MCK 11709 30 0 30 01+00
52382MCK 11709 10 1 10 01+00
52382MCK 11709 20 0 20 01+00
52382MCK 11709 15 0 15 01+00
52382MCK 1170 8 0 8 01+00
52382MCK 1170 10 1 8 01+00
52382MCK 1170 2 0 2 01+00
52382MCK 1170 15 0 15 01+00
解决方案
如果我理解正确sales，则 OP 希望通过将操作期间的数据与销售操作前后的销售中位数进行比较来分析销售操作的成功与否。
有一些挑战：
code每个,item组可能有多个销售操作。- 可用数据可能涵盖少于要求的 3 天，在销售行动之前和之后各三天。
恕我直言，场景的引入是处理问题 2 的弯路。
下面的方法
- 标识每个组内的销售行为
code，item - 在每个销售操作之前和之后最多选择三个零操作行，
- 计算这些行的中位数销售额，以及
output如果销售操作中的销售数字超过周围零操作行的中位数，则更新。
OP 创造了术语类别来区分销售活动期间（的连续条纹action == 1L）和之前和之后的零操作期。
library(data.table)
# coerce to data.table and create categories
setDT(mydat)[, cat := rleid(action), by = .(code, item)][]
# extract action categories, identify preceeding & succeeding zero action categories
mycat <- mydat[, .(action = first(action)), by = .(code, item, cat = cat)][
, `:=`(before = cat - 1L, after = cat + 1L)][action == 1L]
mycat
code item cat action before after
1: 52382MCK 11709 2 1 1 3
2: 52382MCK 11708 2 1 1 3
3: 52382MCK 11710 2 1 1 3
4: 52382MCK 11710 4 1 3 5
5: 52382MCK 11710 6 1 5 7
6: 52499MCK 11203 2 1 1 3
7: 52499MCK 11205 1 1 0 2
请注意，该组52382MCK, 11710包括三个单独的销售操作。before并且after可能指向不存在cat，但这将在后续连接期间自动纠正。
# compute median of surrouding zero action categories
action_cat_median <-
rbind(
# get sales from up to 3 zero action rows before action category
mydat[mycat, on = .(code, item, cat = before),
.(sales = tail(sales, 3), i.cat), by =.EACHI],
# get sales from up to 3 zero action rows after action category
mydat[mycat, on = .(code, item, cat = after),
.(sales = head(sales, 3), i.cat), by =.EACHI]
)[
# remove empty groups
!is.na(sales)][
# compute median for each action category
, .(med = as.double(median(sales))), by = .(code, item, cat = i.cat)]
action_cat_median
code item cat med 1: 52382MCK 11709 2 20.0 2: 52382MCK 11708 2 2.5 3: 52382MCK 11710 2 10.0 4: 52382MCK 11710 4 10.0 5: 52382MCK 11710 6 10.0 6: 52499MCK 11203 2 2.0
# prepare result
mydat[, output := as.double(sales)][
# update join
action_cat_median, on = .(code, item, cat), output := pmin(sales, med)]
编辑：或者，pmin()可以将调用替换为非 equi 联接，该联接仅更新销售额超过中位数的行：
# prepare result, alternative approach
mydat[, output := as.double(sales)][
# non-equi update join
action_cat_median, on = .(code, item, cat, output > med), output := med]
mydat
code item sales action cat output 1: 52382MCK 11709 30 0 1 30.0 2: 52382MCK 11709 10 1 2 10.0 3: 52382MCK 11709 20 0 3 20.0 4: 52382MCK 11709 15 0 3 15.0 5: 52382MCK 11708 2 0 1 2.0 6: 52382MCK 11708 10 1 2 2.5 7: 52382MCK 11708 3 0 3 3.0 8: 52382MCK 11710 30 0 1 30.0 9: 52382MCK 11710 10 0 1 10.0 10: 52382MCK 11710 20 0 1 20.0 11: 52382MCK 11710 15 1 2 10.0 12: 52382MCK 11710 2 0 3 2.0 13: 52382MCK 11710 10 0 3 10.0 14: 52382MCK 11710 3 0 3 3.0 15: 52382MCK 11710 30 0 3 30.0 16: 52382MCK 11710 10 0 3 10.0 17: 52382MCK 11710 20 0 3 20.0 18: 52382MCK 11710 15 1 4 10.0 19: 52382MCK 11710 2 0 5 2.0 20: 52382MCK 11710 10 0 5 10.0 21: 52382MCK 11710 3 0 5 3.0 22: 52382MCK 11710 30 0 5 30.0 23: 52382MCK 11710 10 0 5 10.0 24: 52382MCK 11710 20 0 5 20.0 25: 52382MCK 11710 15 1 6 10.0 26: 52382MCK 11710 2 0 7 2.0 27: 52382MCK 11710 10 0 7 10.0 28: 52382MCK 11710 3 0 7 3.0 29: 52499MCK 11202 2 0 1 2.0 30: 52499MCK 11203 2 0 1 2.0 31: 52499MCK 11203 2 1 2 2.0 32: 52499MCK 11204 2 0 1 2.0 33: 52499MCK 11204 2 0 1 2.0 34: 52499MCK 11205 2 1 1 2.0 35: 52499MCK 11205 2 1 1 2.0 code item sales action cat output
以下行已更新：
mydat[output != sales]
code item sales action cat output 1: 52382MCK 11708 10 1 2 2.5 2: 52382MCK 11710 15 1 2 10.0 3: 52382MCK 11710 15 1 4 10.0 4: 52382MCK 11710 15 1 6 10.0
推荐阅读
- powershell - 使用 Powershell 从列表中安装软件
- python - Perfplot bench() 引发“TypeError：输入类型和输入类型不支持 ufunc 'isfinite'”
- python - 如何在特定标签之前/之前获取 n 个索引号？
- r - R ifelse 基于满足两个标准的观察
- mongodb - 如何使用 URI 导出数据库中的所有集合？
- python - 为什么我的类的变量对于每个对象都不是唯一的？
- laravel - 自定义电子邮件验证通知
- latex - tikz png 输出不输出 png
- c# - 将对象类型从 IEnumerable 更改为 IQueryable 后，开始接收 LINQ 上下文错误
- algorithm - 找到最接近给定 3D 线集的点的算法