Разделить строки даты на новый год

Question

У меня есть данные из больницы со многими переменными, а также даты и даты для каждой строки, которые сообщают нам, когда каждая строка является «действительной». Каждая строка может быть максимально допустимой в течение года.

test = data.frame(ID=c(10,10,10,12,12), Disease=c("P","P","P","D","P"), Pass=c("US","US","US","EN","EN"),
                  Payment=c(110,110,115,240,255), 
                  from_date=as.POSIXct(c("2008-01-09","2009-01-09","2010-01-09","2008-01-01","2013-12-31")),
                  to_date=as.POSIXct(c("2009-01-08","2010-01-08","2011-01-08","2008-12-31","2014-12-30"))
                  )

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

  test_desired = data.frame(ID=c(10,10,10,10,10,10,12,12,12), Disease=c("P","P","P","P","P","P","D","P","P"), Pass=c("US","US","US","US","US","US","EN","EN","EN"),
                              Payment=c(110,110,110,110,115,115,240,255,255), 
                              from_date=as.POSIXct(c("2008-01-09","2009-01-01","2009-01-09","2009-01-01","2010-01-09","2011-01-01","2008-01-01","2013-12-31","2014-01-01")),
                              to_date=as.POSIXct(c("2008-12-31","2009-01-08","2009-12-31","2010-01-08","2010-12-31","2011-01-08","2008-12-31","2013-12-31","2014-12-30"))
    )    

Покушение

library(lubridate) #for function "year" below
test_desired=test
row=c()
tmp=c()
for(i in 1:nrow(test_desired)){
  if(year(test_desired$from_date)[i]<year(test_desired$to_date)[i]){
    test_desired$to_date[i] = as.POSIXct(paste0(year(test_desired$from_date[i]),"-12-31"))
    row = test_desired[i,]
    row$from_date = as.POSIXct(paste0(year(test$to_date[i]),"-01-01"))
    row$to_date = test$to_date[i]
    tmp=rbind(tmp,row)

  } else next
}
test_desired=rbind(test_desired,tmp)
library(dplyr)
test_desired=arrange(test_desired,ID,from_date)

Есть ли более элегантный способ сделать это, например, с помощью dplyr?

Answer 1

Вот решение на основе Tidyverse.Это похоже на Ленный, но с меньшим количеством проверок условий, и нет проблем со временем добавления (они могут отображаться в таблице, но как 00:00:00).Я добавил ungroup(), потому что, похоже, у вас где-то есть группирующая переменная (комментарий под решением Ленного).Его можно удалить, если вы этого не сделаете:

library(dplyr)
library(lubridate)
library(purrr)

test %>% 
    ungroup() %>% # This isn't necessary if there are no groupings.
    split(rownames(test)) %>% 
    map_dfr(function(df){
        if (year(df$from_date) == year(df$to_date)) return(df)
        bind_rows(mutate(df, to_date = rollback(floor_date(to_date, "y"))),
                  mutate(df, from_date = floor_date(to_date, "y"))
                  )
    }
    )

#### OUTPUT ####

  ID Disease Pass Payment  from_date    to_date
1 10       P   US     110 2008-01-09 2008-12-31
2 10       P   US     110 2009-01-01 2009-01-08
3 10       P   US     110 2009-01-09 2009-12-31
4 10       P   US     110 2010-01-01 2010-01-08
5 10       P   US     115 2010-01-09 2010-12-31
6 10       P   US     115 2011-01-01 2011-01-08
7 12       D   EN     240 2008-01-01 2008-12-31
8 12       P   EN     255 2013-12-31 2013-12-31
9 12       P   EN     255 2014-01-01 2014-12-30

Для объяснения: Фрейм данных разбит на список строк.Затем я использую map_dfr для запуска функции на каждом кадре данных, где from_date и to_date содержат разные годы.map_dfr также связывает результирующие кадры данных вместе.В рамках анонимной функции я определяю to_date по годам, а затем либо возвращаю его к последнему дню предыдущего месяца для нового to_date в первой строке, либо оставляю его как для нового from_dateво втором ряду.

Answer 2

Используется только база R.

Первое замечание: используются только даты без времени, поэтому мы должны использовать класс Date, а не POSIXct. Последние могут без необходимости вносить ошибки часового пояса, если вы не будете очень осторожны, поэтому в примечании в конце, где показан используемый ввод, мы предполагаем, что мы начинаем с test2, который содержит данные класса Date. Код в примечании также показывает, как преобразовать его в класс Date, если он уже POSIXct.

Учитывая test2, мы добавляем столбцы from_year, to_year и eoy (дата в конце года), давая test3. Затем мы перебираем строки и, если годы совпадают, возвращаем строку, а если нет, возвращаем разделенные строки. Это дает список из одной и двух строк данных, которые мы rbind вместе.

test3 <- transform(test2, 
  from_year = format(from_date, "%Y"),
  to_year = format(to_date, "%Y"),
  eoy = as.Date(sub("-.*", "-12-31", from_date)))

nr <- nrow(test2)
do.call("rbind", lapply(1:nr, function(i) with(test3[i, ],
  if (from_year == to_year) test2[i, ]
  else data.frame(ID, Disease, Pass, Payment, 
      from_date = c(from_date, eoy+1),
      to_date = c(eoy, to_date)))
))

Примечание

Предполагаемый ввод в воспроизводимой форме. Как отмечено выше, он использует Date класс.

test2 <- transform(test, 
  from_date = as.Date(from_date),
  to_date = as.Date(to_date))

Answer 3

Используя from_date и to_date , мы можем создать последовательность дат, используя seq.Date, затем разделить эту последовательность по годам, наконец, выбрав min и max каждого года.Затем используйте apply, separate_rows и separate, чтобы получить окончательный результат.

cr_date <- function(d1, d2){
    #browser()
    sequence_date <- seq.Date(as.Date(d1), as.Date(d2), by='day') 
    lst_dates <- lapply(split(sequence_date, lubridate::year(sequence_date)),
                        function(x) paste0(min(x), '|', max(x)))
    result <- paste0(lst_dates, collapse = ';')
    return(result)
  }

#Test
#cr_date(as.Date('2008-01-09'),as.Date('2009-01-08'))
test$flag <- apply(test, 1, function(x) cr_date(x['from_date'], x['to_date']))

library(tidyr)
separate_rows(test, flag, sep=';') %>% 
  separate(flag, into = c('from_date_new','to_date_new'), '\\|') %>% 
  mutate_at(vars('from_date_new','to_date_new'), list(~as.Date(.)))


    ID Disease Pass Payment  from_date    to_date from_date_new to_date_new
  1 10       P   US     110 2008-01-09 2009-01-08    2008-01-09  2008-12-31
  2 10       P   US     110 2008-01-09 2009-01-08    2009-01-01  2009-01-08
  3 10       P   US     110 2009-01-09 2010-01-08    2009-01-09  2009-12-31
  4 10       P   US     110 2009-01-09 2010-01-08    2010-01-01  2010-01-08
  5 10       P   US     115 2010-01-09 2011-01-08    2010-01-09  2010-12-31
  6 10       P   US     115 2010-01-09 2011-01-08    2011-01-01  2011-01-08
  7 12       D   EN     240 2008-01-01 2008-12-31    2008-01-01  2008-12-31
  8 12       P   EN     255 2013-12-31 2014-12-30    2013-12-31  2013-12-31
  9 12       P   EN     255 2013-12-31 2014-12-30    2014-01-01  2014-12-30

Answer 4

Вы также можете попробовать что-то вроде ниже, используя dplyr и lubridate.Он работает следующим образом: 1. Дублируйте кадр данных, используя rbind.2. Расположите сначала в ID, во-вторых в from_date и в третьем порядке строк, указанных в test.3. в четных строках измените from_date на первый день нового года.4. В нечетных строках измените to_date на последний день предыдущего года.5. И, наконец, исключите строки, в которых разница между from_date и to_date составляет всего 1 секунду.

test %>% 
  rbind(test) %>% 
  arrange(ID, from_date) %>% 
  mutate(from_date = if_else(row_number() %% 2 == 0, ceiling_date(from_date, "year") + 1, from_date),
         to_date = if_else(row_number() %% 2 == 1, floor_date(to_date, "year") - 1, to_date)) %>% 
  filter(from_date - to_date != 1)

  ID Disease Pass Payment           from_date             to_date
1 10       P   US     110 2008-01-09 00:00:00 2008-12-31 23:59:59
2 10       P   US     110 2009-01-01 00:00:01 2009-01-08 00:00:00
3 10       P   US     110 2009-01-09 00:00:00 2009-12-31 23:59:59
4 10       P   US     110 2010-01-01 00:00:01 2010-01-08 00:00:00
5 10       P   US     115 2010-01-09 00:00:00 2010-12-31 23:59:59
6 10       P   US     115 2011-01-01 00:00:01 2011-01-08 00:00:00
7 12       D   EN     240 2008-01-01 00:00:01 2008-12-31 00:00:00
8 12       P   EN     255 2013-12-31 00:00:00 2013-12-31 23:59:59
9 12       P   EN     255 2014-01-01 00:00:01 2014-12-30 00:00:00

Только время может быть добавлено, если время добавлено, но вы, конечно, можете его удалить.И если период может продолжаться в третьем году, вы можете использовать ту же логику, но со вторым rbind и row_number() %% 3 == 0

Answer 5

Я просто использую data.table, который также предоставляет функцию year и игнорирует возможно медленную логику преобразования даты с as.POSIXct.

Я также предполагаю, что to_date и from_date может отличаться только на один год (не более чем на один год!).

library(data.table)  # also provides a "year" function

setDT(test)

# Create additional rows for the new year
additional_rows <- test[year(from_date) < year(to_date), ]
additional_rows[, from_date := as.POSIXct(paste0(year(to_date),"-01-01"))]

# Shorten the "from_date" of the affected original rows
test[year(from_date) < year(to_date), to_date := as.POSIXct(paste0(year(from_date),"-12-31"))]

# Create a combined data table as result
result <- rbind(test, additional_rows)
setkey(result, ID, Payment, from_date)  # just to sort the data like the "test_desired" sort order

, что приводит к

> result
   ID Disease Pass Payment  from_date    to_date
1: 10       P   US     110 2008-01-09 2008-12-31
2: 10       P   US     110 2009-01-01 2009-01-08
3: 10       P   US     110 2009-01-09 2009-12-31
4: 10       P   US     110 2010-01-01 2010-01-08
5: 10       P   US     115 2010-01-09 2010-12-31
6: 10       P   US     115 2011-01-01 2011-01-08
7: 12       D   EN     240 2008-01-01 2008-12-31
8: 12       P   EN     255 2013-12-31 2013-12-31
9: 12       P   EN     255 2014-01-01 2014-12-30