Как я могу написать эффективный код, который создает календарь на R?

Question

Моя цель - написать более эффективный код, который создает календарь, который распределяет клиентов дилера по разным дням так, чтобы:

1. Все дни имеют не менее min клиентов в день и (min зависит от дилера)
2. Все дни имеют не более max клиентов в день и (max зависит от дилера)
3. Всякий раз, когда клиента переводят в другой день, его следует перемещать к ближайшему возможному (не беспокойтесь о связях - если расстояние одинаково, то за 1 день до или через 1 день то же самое)

Пример:

dealer_id  <- rep(c("ABC123","DEF234","GHJ456"), each = 4)
date       <- as.Date(rep(c("2018-01-01", "2018-01-02", "2018-01-03", "2018-01-04"), times = 3))
cust_pos_1 <- c("MCA1", "MCA2", "MCA3", "MCA4", "MCA5", "MCA6", NA, NA, "MCA9", "MCA10", "MCA11", "MCA12")
cust_pos_2 <- c("MCB1", "MCB2", NA, NA, "MCB5", NA, NA, NA, "MCB9", NA, "MCB11", NA)
cust_pos_3 <- c("MCC1", "MCC2", NA, NA, NA, NA, NA, NA, "MCC9", NA, NA, NA)

df         <- data.frame(dealer_id, date, cust_pos_1, cust_pos_2, cust_pos_3)

settings   <- data.frame(dealer_id = c("ABC123","DEF234","GHJ456"), min_daily = c(2, 0, 1), max_daily = c(3, 1, 2))

Предоставляет нам входные данные и настройки дилера:

dealer_id date       cust_pos_1 cust_pos_2 cust_pos_3
ABC123    2018-01-01 MCA1       MCB1       MCC1
ABC123    2018-01-02 MCA2       MCB2       MCC2
ABC123    2018-01-03 MCA3       NA         NA
ABC123    2018-01-04 MCA4       NA         NA
DEF234    2018-01-01 MCA5       MCB5       NA
DEF234    2018-01-02 MCA6       NA         NA
DEF234    2018-01-03 NA         NA         NA
DEF234    2018-01-04 NA         NA         NA
GHJ456    2018-01-01 MCA9       MCB9       MCC9
GHJ456    2018-01-02 MCA10      NA         NA
GHJ456    2018-01-03 MCA11      MCB11      NA
GHJ456    2018-01-04 MCA12      NA         NA

dealer_id min_daily max_daily
ABC123    2         3
DEF234    0         1
GHJ456    1         2

и выходные данные после выполнения кода должны выглядеть следующим образом:

dealer_id date       cust_pos_1 cust_pos_2 cust_pos_3
ABC123    2018-01-01 MCA1       MCB1       NA
ABC123    2018-01-02 MCA2       MCB2       NA
ABC123    2018-01-03 MCA3       MCC1       NA
ABC123    2018-01-04 MCA4       MCC2       NA
DEF234    2018-01-01 MCA5       NA         NA
DEF234    2018-01-02 MCA6       NA         NA
DEF234    2018-01-03 MCB5       NA         NA
DEF234    2018-01-04 NA         NA         NA
GHJ456    2018-01-01 MCA9       MCB9       NA
GHJ456    2018-01-02 MCA10      MCC9       NA
GHJ456    2018-01-03 MCA11      MCB11      NA
GHJ456    2018-01-04 MCA12      NA         NA

Из-за настроек - клиенты должны были быть перераспределены в соответствии с вышеуказанными правилами.

Существует также правило для таблицы настроек! Разница между min и max всегда будет равна 1.

Общеизвестно, что существует более 1 способа решения этой проблемы, поскольку тот факт, что нам все равно, будет ли клиент перемещен за x дней до x дней после, означает, что мы можем стать другими (и даже лучше! ) решения.

Теперь. Тем не менее, я решил эту проблему с помощью цикла, который требует возрастов (мои фреймы данных огромны - мне нужно создать этот календарь за 5 лет и для 150 дилеров с сотнями клиентов).

Мой вопрос: есть ли способ сделать это, используя dplyr или data.table или что-то еще, чтобы он работал быстрее?

Спасибо.

Answer 1

Код ниже заполнит пустое пространство внутри допустимых ячеек от клиентов, которые находятся за пределами диапазона настройки max_daily. Однако одна потенциальная проблема может заключаться в том, что код перемещает клиентов далеко от их первоначальной даты. Предоставленный код совместим с оператором dplyr pipe и действительно быстр.

calendar_sort <- function(df){ 


    df <- as.data.frame(df)
    # 
    nr <- nrow(df)
    nc <- ncol(df)
    nc_p <- nc - 2 #if you have more than 2 col for DealerID and Date, change this 

    ttl_cn <- sum(!is.na(df[,3:nc])) # total count of non_NAs 
    mx <- ceiling(ttl_cn / nr)
    rng_nnac <- sum(!is.na(df[,3:(2+mx)])) # count of non-NAs within the range

    left_overs <- df[,(mx+3):nc]
    left_overs <- left_overs[!is.na(left_overs)]

    lo_c <- length(left_overs) # leftover non-NA count
    ttl_s <-  (nr*nc_p) # total number of cells (total space)

    df[,(mx+3):nc] <- NA
    A <- c(left_overs, rep(NA, ttl_s - rng_nnac -lo_c))
    df[is.na(df)] <- A

    B <- df[,3:nc]
    B <- B[!is.na(B)] 
    B <- c(B, rep(NA, ttl_s - length(B)))
    df[,3:nc] <- B

    return(df)
}

result <- df %>% dplyr::group_by(Dealer) %>% do(calendar_sort(.))