更换位数不正确时,工作RSCRIPT(incorrect Rscript work when rep

2019-10-29 02:53发布

我有数据集

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

Answer 1:

该代码中有几个严重的缺陷:

  • 通过它完全忽略了分组codeitem
  • 而OP曾要求包括前1行和每一后2排它选择只有两个中值计算,而不是全方位的归零动作的行值action == 1

如果我理解正确OP的要求,

  • 在OP想通过环绕各销售行为(不包括行动期间销售)一个周期计算的平均销量,并将其与实际销售相比较来衡量一个销售行为的影响
  • 单独为每个产品,鉴定由codeitem
  • 每个销售动作的长度可以变化(条纹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仅由01 ,我们可以使用在字符串模式匹配与正则表达式。

为此, action列已折叠成字符串(分别为每个codeitem组)。 然后, stringr::str_locate_all()是用来寻找的开始和结束位置action patternaction pattern是在寻找的任何序列的正则表达式1 S按所需数量的前缘和后包围0 S,RESP。

事实上,正则表达式是稍微复杂一些,因为我们不得不使用前瞻为了捕捉重叠的行动模式,比如000111000000111000111000 。 的end的正则表达式先行点的位置到最后1的每个序列,而不是最后在0 ,所以end将在稍后进行调节。

最后,在开始和结束位置转换成行位置DF ,而不是位置relativ到组,并返回tmp

现在,我们做了非等距加入的聚集和更新DF与附加med包含平均销售属于每个零点行动行的列startend范围。

剩余的步骤是准备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")


文章来源: incorrect Rscript work when replacing medians