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

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

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

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

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

Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
2
0
96
3
Перейти к ответу Данный вопрос помечен как решенный

Ответы 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
Ответ принят как подходящий

data.table решение

Мое любимое оружие для такого рода проблем - очень-очень быстрый 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

ориентиры

По сравнению с решением @AntoniosK tidyverse (которое работает так же хорошо и более читабельно ;-)), 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

Спасибо, но на первый взгляд результат не соответствует ожидаемому?

arg0naut91 12.09.2018 22:15

@ arg0naut упс .... промах ... исправил. см. обновленный ответ

Wimpel 13.09.2018 07:07

Вот еще один возможный подход 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

Другие вопросы по теме