根据频率移动日期答案

【问题标题】：Shifting dates based on frequency根据频率移动日期
【发布时间】：2021-03-29 12:58:05
【问题描述】：

我有点困惑。我想为我的数据集中的每个参与者安排特定的日期空档来预约。我的日期范围是从 14 天到流感爆发到流感爆发。因此，如果流感疫苗计划在 2021 年 4 月 29 日进行，则可以在 4 月 15 日至 2021 年 4 月 28 日期间进行预约。流感疫苗接种日期当然因参与者而异。每个日期，每个约会的参与者人数上限（假设每个日期有 8 名参与者）。我设法（在你们的帮助下）创建了一个数据框，其中包含每个参与者可以预约的所有日期：

Each row is for one participant

我需要从此数据框中检查第一个可能的日期是否出现 8 次或更少（空位尚未填充），将该日期放在新列中。然后，当该日期的 8 个插槽被填满时，继续到下一个日期，直到再次达到最大值 8，等等

结果应该是一个额外的列，其中包含每个参与者的约会日期。

我希望我尽量让这一点足够清楚，否则请告诉我。我一直在为此烦恼，因为我什至不知道这是否是最好的方法，所以非常感谢任何帮助。

非常感谢！

【问题讨论】：

标签： r date timeslots

【解决方案1】：

这是一个基于 tidyverse 和 lubridate 的可能解决方案。

首先，包含已预订的约会的小标题。一开始是空的。

library(tidyverse)
library(lubridate)

bookedAppointments <- tibble(
                        AppointmentDate=structure(NA_real_, class="Date"),
                        ParticipantID=numeric()
                      )
bookedAppointments
# A tibble: 0 x 2
# … with 2 variables: AppointmentDate <date>, ParticipantID <dbl>

现在，一个函数可以查找最后可能的约会日期之前的日期。

findAvailableSlots <- function(lastDate) {
  bookedSlots <- bookedAppointments %>%
                      filter(AppointmentDate %within% interval(lastDate - days(14), lastDate)) %>%
                      group_by(AppointmentDate) %>%
                      summarise(BookedSlots=n())
  availableSlots <- tibble(
                      AppointmentDate=lastDate - days(0:13),
                      MaximumSlots=8
                    ) %>% 
                    filter(AppointmentDate - today() > -1) %>% 
                    left_join(bookedSlots, by="AppointmentDate") %>% 
                    replace_na(list(BookedSlots=0)) %>% 
                    mutate(AvailableSlots=MaximumSlots - BookedSlots) %>% 
                    filter(AvailableSlots > 0)
  availableSlots
}

测试一下。请注意，在撰写本文时，01Apr2021 距离未来不到 14 天...

possibles <- findAvailableSlots(dmy("01Apr2021"))
possibles
# A tibble: 4 x 4
  AppointmentDate MaximumSlots BookedSlots AvailableSlots
  <date>                 <dbl>       <dbl>          <dbl>
1 2021-04-01                 8           0              8
2 2021-03-31                 8           0              8
3 2021-03-30                 8           0              8
4 2021-03-29                 8           0              8

预订一个位置。为简单起见，只需取最后一个可用日期。

bookedAppointments <- bookedAppointments %>% 
                          add_row(
                            AppointmentDate=possibles %>% 
                                              pull(AppointmentDate) %>% 
                                              head(1), 
                            ParticipantID=1
                          )
bookedAppointments
# A tibble: 1 x 2
  AppointmentDate ParticipantID
  <date>                  <dbl>
1 2021-04-01                  1

2021 年 4 月 1 日填补所有空缺

for (i in 2:8) 
  bookedAppointments <- bookedAppointments %>% 
    add_row(AppointmentDate=dmy("01Apr2021"), ParticipantID=i)

现在预约另一个约会

possibles <- findAvailableSlots(dmy("01Apr2021"))
bookedAppointments <- bookedAppointments %>% 
  add_row(
    AppointmentDate=possibles %>% pull(AppointmentDate) %>% head(1), 
    ParticipantID=99
  )
# A tibble: 9 x 2
  AppointmentDate ParticipantID
  <date>                  <dbl>
1 2021-04-01                  1
2 2021-04-01                  2
3 2021-04-01                  3
4 2021-04-01                  4
5 2021-04-01                  5
6 2021-04-01                  6
7 2021-04-01                  7
8 2021-04-01                  8
9 2021-03-31                 99

【讨论】：

要获取第一个可用日期，请在findAvalaibleSlots 中对availableSlots 进行排序，或者在更新bookedAppointments 时使用tail() 而不是head()。