r - 根据发生天数生成给定频率的日期序列

Question

尝试在具有给定开始日期和频率的日期的 R 编程(使用 lubridate)中生成日期序列不是数字值，而是日期可以出现的天数。
下表给出了组、开始日期、日期和发生标志的定义

+-------+------------+-----+-----+
| Group | start_date | Day | Y/N |
+-------+------------+-----+-----+
| foo   | 02-06-2021 | Mon |   0 |
| foo   | 02-06-2021 | Tue |   1 |
| foo   | 02-06-2021 | Wed |   0 |
| foo   | 02-06-2021 | Thu |   1 |
| foo   | 02-06-2021 | Fri |   1 |
| foo   | 02-06-2021 | Sat |   1 |
| foo   | 02-06-2021 | Sun |   0 |
| bar   | 02-06-2021 | Mon |   1 |
| bar   | 02-06-2021 | Tue |   0 |
| bar   | 02-06-2021 | Wed |   0 |
| bar   | 02-06-2021 | Thu |   1 |
| bar   | 02-06-2021 | Fri |   1 |
| bar   | 02-06-2021 | Sat |   0 |
| bar   | 02-06-2021 | Sun |   0 |
+-------+------------+-----+-----+

所需的输出如下。

+-------+------------+---------------------+
| Group | given_date | next_available_date |
+-------+------------+---------------------+
| foo   | 02-06-2021 | 03-06-2021          |
| foo   | 04-06-2021 | 04-06-2021          |
| foo   | 06-06-2021 | 08-06-2021          |
| bar   | 02-06-2021 | 03-06-2021          |
| bar   | 05-06-2021 | 07-06-2021          |
+-------+------------+---------------------+

关于 while 循环的一些想法，我认为可能会很累。

for each given_date{
inputdate = given_date
while(true){
 {
 if(group =="Foo" & day(inputdate) in ('Tue','Thu','Fri','Sat')
 next_available_date=inputdate
 break
 }
 else
 {
  inputdate = inputdate+(1 day) (repeat the loop until if condition is satisfied)
 } 
}
}

如果不同组的条件可能不同。
无法弄清楚如何利用不均匀的频率来获得下一个可用日期。

Answer 1

处理更大的样本，正如前面评论中所讨论的。策略如下——

作为您的 day列总是从 Mon 开始不等于 start_date所以列匹配 weekday是必须的。

如此创建 day要订购的字段 factor type 以便可以将其处理为整数。

以这样的方式排列数据框，即您的每个组仅从那天开始。使用模除法 %%为此

安排好任务后就轻松多了。我为每个工作日结束、每个组和每个 start_date 创建了七个日期。

用 Y/N 过滤掉行作为 0 任何地方。

现在你只需要顶行所以使用 slice_head()

df <- data.frame(
  stringsAsFactors = FALSE,
                   Group = c("foo","foo","foo",
                             "foo","foo","foo","foo","foo","foo","foo",
                             "foo","foo","foo","foo","foo","foo","foo",
                             "foo","foo","foo","foo","bar","bar","bar",
                             "bar","bar","bar","bar","bar","bar","bar","bar",
                             "bar","bar","bar"),
              start_date = c("02-06-2021",
                             "02-06-2021","02-06-2021","02-06-2021","02-06-2021",
                             "02-06-2021","02-06-2021","04-06-2021",
                             "04-06-2021","04-06-2021","04-06-2021","04-06-2021",
                             "04-06-2021","04-06-2021","06-06-2021","06-06-2021",
                             "06-06-2021","06-06-2021","06-06-2021",
                             "06-06-2021","06-06-2021","02-06-2021","02-06-2021",
                             "02-06-2021","02-06-2021","02-06-2021","02-06-2021",
                             "02-06-2021","05-06-2021","05-06-2021",
                             "05-06-2021","05-06-2021","05-06-2021","05-06-2021",
                             "05-06-2021"),
                     Day = c("Mon","Tue","Wed",
                             "Thu","Fri","Sat","Sun","Mon","Tue","Wed",
                             "Thu","Fri","Sat","Sun","Mon","Tue","Wed",
                             "Thu","Fri","Sat","Sun","Mon","Tue","Wed",
                             "Thu","Fri","Sat","Sun","Mon","Tue","Wed","Thu",
                             "Fri","Sat","Sun"),
                     y_n = c(0L,1L,0L,1L,1L,
                             1L,0L,0L,1L,0L,1L,1L,1L,0L,0L,1L,0L,1L,
                             1L,1L,0L,1L,0L,0L,1L,1L,0L,0L,1L,0L,
                             0L,1L,1L,0L,0L)
      )

library(lubridate)
library(tidyverse)

df %>% group_by(Group, start_date) %>%
  mutate(Day = factor(Day, levels = Day, ordered = T)) %>%
  arrange(Group, (as.numeric(Day) + 7 - wday(dmy(start_date), week_start = 1)) %% 7, .by_group = T) %>%
  mutate(next_available_date = dmy(start_date) + 0:6) %>%
  filter(y_n !=0) %>%
  slice_head()
#> # A tibble: 5 x 5
#> # Groups:   Group, start_date [5]
#>   Group start_date Day     y_n next_available_date
#>   <chr> <chr>      <ord> <int> <date>             
#> 1 bar   02-06-2021 Thu       1 2021-06-03         
#> 2 bar   05-06-2021 Mon       1 2021-06-07         
#> 3 foo   02-06-2021 Thu       1 2021-06-03         
#> 4 foo   04-06-2021 Fri       1 2021-06-04         
#> 5 foo   06-06-2021 Tue       1 2021-06-08

关于提供的数据

df <- data.frame(
  stringsAsFactors = FALSE,
                   Group = c("foo","foo","foo",
                             "foo","foo","foo","foo","bar","bar","bar",
                             "bar","bar","bar","bar"),
              start_date = c("02-06-2021",
                             "02-06-2021","02-06-2021","02-06-2021","02-06-2021",
                             "02-06-2021","02-06-2021","02-06-2021",
                             "02-06-2021","02-06-2021","02-06-2021","02-06-2021",
                             "02-06-2021","02-06-2021"),
                     Day = c("Mon","Tue","Wed",
                             "Thu","Fri","Sat","Sun","Mon","Tue","Wed",
                             "Thu","Fri","Sat","Sun"),
                     y_n = c(0L,1L,0L,1L,1L,
                             1L,0L,1L,0L,0L,1L,1L,0L,0L)
      )

library(lubridate)
library(tidyverse)



df %>% group_by(Group, start_date) %>%
  mutate(Day = factor(Day, levels = Day, ordered = T)) %>%
  arrange(Group, (as.numeric(Day) + 7 - wday(dmy(start_date), week_start = 1)) %% 7, .by_group = T) %>%
  mutate(next_available_date = dmy(start_date) + 0:6) %>%
  filter(y_n !=0) %>%
  slice_head()

#> # A tibble: 2 x 5
#> # Groups:   Group, start_date [2]
#>   Group start_date Day     y_n next_available_date
#>   <chr> <chr>      <ord> <int> <date>             
#> 1 bar   02-06-2021 Thu       1 2021-06-03         
#> 2 foo   02-06-2021 Thu       1 2021-06-03

创建于 2021-06-02 由 reprex package (v2.0.0)