使用重置值按仓库位置数分配动态分类项目的日期

Question

简而言之，我正在为我们的仓库团队分配项目，以便每天循环计数，但每个项目可能具有不同数量的位置。我需要总的位置数量接近特定的数字，比如每天43个地点。

我有一个列表，列出了我需要在四分之一的位置计算的所有项目。我想为每个项目分配一个日期，将它们分组为每天接近43个地点。我希望这些项目尽可能随机计算，而不仅仅是在随后几天计算出大量地点的项目。只有一个位置的项目可以很好地保存以填补空白。

我也只能使用工作日，节假日除外。

作为奖励，如果一个项目有超过43个位置，我想将其分成多天，并尽可能使用其余项目与其他项目连接。

为了方便起见，假设我们希望每天15个位置的数量（可以使用变量动态更改该数量的代码会很棒。）

这是一个示例：

 Item       Loc
 43127      2
 15065      5
 43689      1
 99100      5
 9681352    1
 9680537    1
 10013      1
 55600      3
 43629      1
 PAL001     2
 9950056    1
 467L86     4
 17028      2
 10324      2
 99235REV   12
 LIT003     2

结果是这样的（真的只需要项目和日期，但辅助列也可以）：

 Item      Loc  Cum Date
                Sum 
 43127      2   2   3/1/2019
 15065      5   7   3/1/2019
 PAL001     2   9   3/1/2019
 467L86     4   13  3/1/2019
 10324      2   15  3/1/2019
 99235REV   12  12  3/4/2019
 55600      3   15  3/4/2019
 99100      5   5   3/5/2019
 43629      1   6   3/5/2019
 LIT003     2   8   3/5/2019
 17028      2   10  3/5/2019
 43689      1   11  3/5/2019
 9680537    1   12  3/5/2019
 10013      1   13  3/5/2019
 9950056    1   14  3/5/2019
 9681352    1   15  3/5/2019

我开始使用R循环，但无法弄清楚如何让日期移动并标记我已经计算了一个项目。

数据

test.df <- data.frame(Item=c('43127', '15065', '43689', '99100', 
                               '9681352', '9680537', '10013', '55600', 
                               '43629', 'PAL001', '9950056', '467L86', 
                               '17028', '10324', '99235REV', 'LIT003'), 
                      Loc=c(2, 5, 1, 5, 1, 1, 1, 3, 1, 2, 1, 4, 2, 2, 12, 2))

功能

spreadDates <- function(df, loc_day) {
  # SPREAD DATES BASED ON LOCATION VALUE
  # Args: 
  #   df: Data Frame with Items and number of locations
  #   loc_day: Number of locations to count per day
  # Returns:
  #   Data Frame with key on new date
  df$Date_Switch <- 0
  df$Cum_Sum     <- 0
  for (i in 1:nrow(df)) {
    if (i==1) {                                       
      # First day 
      df[i, 4] <- df[i, 2]                              
      # Cum Sum is no of item locations
    } else {
      if ((df[i - 1, 4] + df[i, 2]) < loc_day) {         
        # If previous cumsum plus today's locations is less than max count
        df[i, 4] <- (df[i - 1, 4] + df[i, 2])            
        # Then add previous cumsum to today's locations
      } else if ((df[i - 1, 4] + df[i, 2]) > loc_day) {  
        # This is where I don't know how to look for next item to count and then 
        # mark it as already counted 
      } else {                                    
        # Previous cumsum plus today=max count
        df[i, 4] <- (df[i - 1, 4] + df[i, 2])          
        # Add previous cumsum to today
        df[i, 3] <- 1                              
        # Make Date_Switch=1 to later change date 
      }
    }
  }
  return(df)
}

test.func <- spreadDates(test.df, 15)

如果有一个矢量方式来做这个或一个包，我会好的...但我真的需要一种方法来自动化，因为我有成千上万的项目，并且必须每季度执行一次。

Answer 1

Edit: added ideal solution at bottom using adagio package: wow!

这是一个快速而肮脏的尝试，可能足够好。我假设每日最佳总位置是15，但是14或16都可以。对于这个第一次，我不会太喜欢洗牌。

顺便说一下，这似乎是“多背包问题”的一个变种（我刚刚在5分钟前就知道了这一点），其中有专门的优化软件包可以通过更多的马力来实现这一点。 （例如：https://rdrr.io/cran/adagio/man/mknapsack.html）

首先，我制作一些更大的测试数据来帮助评估方法。

library(tidyverse)
n = 1000
set.seed(42)
test.df2 <- tibble(
  Item = sample(10000:99999, n, replace = FALSE),
  Loc = sample(c(rep(1:4, 8), 1:12), n, replace = TRUE)  # Most small, some up to 15
)

daily_loc_tgt <- 15   # Here's my daily total target per location

尝试1：天真的任务

没有求助，只需对累积和使用整数除法。每当累计总数超过15的倍数时，启动一个新组。

baseline <- test.df2 %>%
  mutate(cuml = cumsum(Loc),
         naive_grp  = 1 + cuml %/% daily_loc_tgt) %>%
  group_by(naive_grp) %>%
  mutate(grp_sum = cumsum(Loc)) %>%
  ungroup()

这是如何表现的？对于假数据，看起来大约一半的时间，分组在15之中。

eval_soln(baseline)   # Function defined at bottom

尝试2：向下移动超出一个

这不会消除超支，但通常会通过将它们分配给下一组来减少它们。

shuffle <- test.df2 %>%
  mutate(cuml = cumsum(Loc),
         grp  = 1 + cuml %/% tgt) %>%
  arrange(grp, -Loc) %>%
  group_by(grp) %>%
  mutate(grp_sum = cumsum(Loc)) %>%
  ungroup() %>%

  # Shift down overruns
  mutate(grp = if_else(grp_sum > tgt + 1,
                       grp + 1,
                       grp)) %>%
  group_by(grp ) %>%
  mutate(grp_sum = cumsum(Loc)) %>%
  ungroup()

eval_soln(shuffle)

这是一个适度的改进。现在，大约60％的群体接近15个。但是仍有相当数量远远超过15个......

尝试3：依靠几十年前解决这个问题的聪明人

在谷歌搜索中，我了解到这可能被称为“多背包问题”，并且可以使用像adagio这样的专用软件包更有效地解决。 https://rdrr.io/cran/adagio/man/mknapsack.html

唯一的技巧是设置k容量部分中的组数。当我最初使用240（sum(test.df2$Loc) / 15的输出）设置它时，它使R挂起的时间比我想要等待的时间长。通过降低这一点，它在大约10秒内找到了一个精确的解决方案，所有240个组都有15个位置。

library(adagio)

# p is the "profit" per item; I'll use `Loc`
p <- test.df2$Loc

# w is the "weights", which cannot exceed the capacities. Also `Loc`
w <- test.df2$Loc

# Capacities:  all tgt
k <- rep(tgt, 239)

adagio_soln_assignments <- mknapsack(p, w, k)
adagio_soln <- test.df2 %>%
  mutate(grp = adagio_soln_assignments[["ksack"]]) %>%
  arrange(grp) %>%
  group_by(grp) %>%
  mutate(grp_sum = cumsum(Loc)) %>%
  ungroup()

eval_soln(adagio_soln)

瞧！

---

这是我用于绘制结果图表的代码：

eval_soln <- function(df, tgt = 15, ok_var = 1) {
  stats <- df %>%
    group_by(grp) %>%
    summarize(sum_check = max(grp_sum),
              sum = sum(Loc))

  df_name <- substitute(df)

  ok_share <- mean(stats$sum >= tgt - ok_var & stats$sum <= tgt + ok_var)

  ggplot(stats, aes(sum, 
           fill = sum >= tgt - ok_var  &  sum <= tgt + ok_var)) +
    geom_histogram(binwidth = 1, color = "white") +
    scale_fill_manual(values = c("gray70", "gray20")) +
    coord_cartesian(xlim = c(0, 30)) +
    guides(fill = FALSE) +
    labs(title = df_name,
         subtitle = paste0("Share of groupings within ", ok_var,
                        " of ", tgt, ": ", 
                        scales::percent(ok_share, accuracy = 0.1)))
}