Разделить последовательность дат на один блок (содержащий дату начала и окончания) для каждого месяца

Question

Допустим, у меня есть кадр данных, подобный приведенному ниже:

df <- data.frame(group = c("a", "a", "b"),
                 start = as.Date(c("2018-01-01", "2018-09-01", "2018-02-01")),
                 end = as.Date(c("2018-02-15", "2018-12-31", "2018-03-30")))

group      start        end
     a 2018-01-01 2018-02-15
     a 2018-09-01 2018-12-31
     b 2018-02-01 2018-03-30

И я хотел бы получить следующий ожидаемый результат:

output <- data.frame(group = c("a", "a", "a", "a", "a", "a", "b", "b"),
                  start = as.Date(c("2018-01-01", "2018-02-01", "2018-09-01",
                                    "2018-10-01", "2018-11-01", "2018-12-01",
                                    "2018-02-01", "2018-03-01")),
                  end = as.Date(c("2018-01-31", "2018-02-15", "2018-09-30",
                                  "2018-10-31", "2018-11-30", "2018-12-31",
                                  "2018-02-28", "2018-03-30")))

 group      start        end
     a 2018-01-01 2018-01-31
     a 2018-02-01 2018-02-15
     a 2018-09-01 2018-09-30
     a 2018-10-01 2018-10-31
     a 2018-11-01 2018-11-30
     a 2018-12-01 2018-12-31
     b 2018-02-01 2018-02-28
     b 2018-03-01 2018-03-30

Для каждого месяца в последовательности Iхотел бы получить отдельную строку, которая будет ограничена 1) начальной датой последовательности, если последняя>, чем начало месяца или начало месяца, и 2) конечной датой месяца, если последняя> конечная датапоследовательность или дата окончания последовательности.

Есть идеи, как это сделать?

Answer 1

data.table solution

Мое любимое оружие для решения подобных задач - data.table очень-очень быстрое foverlaps

df <- data.frame(group = c("a", "a", "b"),
                 start = as.Date(c("2018-01-01", "2018-09-01", "2018-02-01")),
                 end = as.Date(c("2018-02-15", "2018-12-31", "2018-03-30")))

#create data-frame with from-to by month
df2 <- data.frame( start = seq( as.Date("2018-01-01"), length = 12, by = "1 month" ),
                   end = seq( as.Date( "2018-02-01"), length = 12, by= "1 month" ) - 1,
                   stringsAsFactors = FALSE )

library(data.table)

#setDT on both data.frames... df2 needs to be keyed in order for foverlaps to work.
dt <- foverlaps( setDT( df ), setDT( df2, key = c("start", "end") ), type = "any", mult = "all" )[]
#choose keep the right columns (start/end)
dt[ start < i.start, start := i.start ]
dt[ end > i.end, end := i.end ]
#cleaning
dt[, `:=`(i.start = NULL, i.end = NULL)][]

 #         start        end group
# 1: 2018-01-01 2018-01-31     a
# 2: 2018-02-01 2018-02-15     a
# 3: 2018-09-01 2018-09-30     a
# 4: 2018-10-01 2018-10-31     a
# 5: 2018-11-01 2018-11-30     a
# 6: 2018-12-01 2018-12-31     a
# 7: 2018-02-01 2018-02-28     b
# 8: 2018-03-01 2018-03-30     b

отметки

По сравнению с решением Tidyverse от @ AntoniosK (которое работает так же хорошо и более читабельно ;-)), foverlaps выполняет работу в 50% случаев

# Unit: milliseconds
# expr       min       lq      mean    median        uq       max neval
# tidyverse 10.418585 10.79064 12.531207 11.080309 11.753030 93.110804   100
# foverlaps  5.320911  5.59506  5.861865  5.846766  6.009146  9.606981   100

Answer 2

Вот еще один возможный data.table подход:

library(data.table)
setDT(df)

#to create a data.table of monthly periods
earliest <- as.POSIXlt(df[,min(start)]) 
earliest$mday <- 1L
earliest <- as.Date(earliest)

latest <- as.POSIXlt(df[,max(end)])
latest$mday <- 1L
latest <- seq(as.Date(latest), by="1 month", length.out=2L)[2L]

startOfMonths <- seq(earliest, latest, by="1 month")
monthsDT <- data.table(
    som=startOfMonths[-length(startOfMonths)],
    eom=startOfMonths[-1L] - 1L)

#perform non-equi join where som falls within start and end
ans <- monthsDT[df, .(group, start, som=x.som, end, eom=x.eom), 
    by=.EACHI, on=.(som>=start, som<=end)][, -(1L:2L)]

#get desired output according to OP's requirement
ans[, .(group, start=max(start, som), end=min(end, eom)), by=seq_len(ans[,.N])][, -1L]

вывод:

   group      start        end
1:     a 2018-01-01 2018-01-31
2:     a 2018-02-01 2018-02-15
3:     a 2018-09-01 2018-09-30
4:     a 2018-10-01 2018-10-31
5:     a 2018-11-01 2018-11-30
6:     a 2018-12-01 2018-12-31
7:     b 2018-02-01 2018-02-28
8:     b 2018-03-01 2018-03-30

Answer 3

df <- data.frame(group = c("a", "a", "b"),
                 start = as.Date(c("2018-01-01", "2018-09-01", "2018-02-01")),
                 end = as.Date(c("2018-02-15", "2018-12-31", "2018-03-30")))

library(tidyverse)
library(lubridate)

df %>%
  group_by(id = row_number()) %>%             # for each row
  mutate(seq = list(seq(start, end, "day")),  # create a sequence of dates with 1 day step
         month = map(seq, month)) %>%         # get the month for each one of those dates in sequence
  unnest() %>%                                # unnest data
  group_by(group, id, month) %>%              # for each group, row and month
  summarise(start = min(seq),                 # get minimum date as start
            end = max(seq)) %>%               # get maximum date as end
  ungroup() %>%                               # ungroup
  select(-id, - month)                        # remove unecessary columns

# # A tibble: 8 x 3
#   group start      end       
#  <fct> <date>     <date>    
# 1 a     2018-01-01 2018-01-31
# 2 a     2018-02-01 2018-02-15
# 3 a     2018-09-01 2018-09-30
# 4 a     2018-10-01 2018-10-31
# 5 a     2018-11-01 2018-11-30
# 6 a     2018-12-01 2018-12-31
# 7 b     2018-02-01 2018-02-28
# 8 b     2018-03-01 2018-03-30