按具有重置值的仓库位置数为动态排序的项目分配日期

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 和 Date，但辅助列也可以）：

 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

编辑：使用adagio 包在底部添加了理想的解决方案：哇！

这是一个快速而肮脏的尝试，可能已经足够好了。我假设最佳的每日总位置是 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：Shift 向下移动一个

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

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 Capacities 部分中设置组数。当我最初使用 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)))
}