отдельный ряд, содержащий две отдельные даты до и после полуночи

Question

У меня есть фрейм данных, содержащий данные сна, с несколькими приращениями сна, с колонкой для начала и колонкой для конца сна.Для некоторых строк время начала - в предыдущий день, а время окончания - на следующий день.Я хотел бы разделить такие строки на две строки, где первая строка содержит время начала до 23:59:59, а вторая строка 00:00:00 до времени окончания.

Например:

# A tibble: 6 x 3
  sleepdatestarttime  sleepdateendtime    sleepstage 
  <dttm>              <dttm>              <chr>              
1 2018-03-02 23:31:00 2018-03-02 23:54:00 rem                
2 2018-03-02 23:54:00 2018-03-02 23:55:00 light              
3 2018-03-02 23:55:00 2018-03-03 00:02:00 wake               
4 2018-03-03 00:02:00 2018-03-03 00:03:30 light              
5 2018-03-03 00:03:30 2018-03-03 00:23:30 deep               
6 2018-03-03 00:23:30 2018-03-03 02:58:00 light               

и желаемый результат:

# A tibble: 6 x 3
  sleepdatestarttime  sleepdateendtime    sleepstage 
  <dttm>              <dttm>              <chr>      
1 2018-03-02 23:31:00 2018-03-02 23:54:00 rem         
2 2018-03-02 23:54:00 2018-03-02 23:55:00 light       
**3 2018-03-02 23:55:00 2018-03-02 23:59:59 wake 
4 2018-03-03 00:00:00 2018-03-03 00:01:59 wake** 
5 2018-03-03 00:02:00 2018-03-03 00:03:30 light       
6 2018-03-03 00:03:30 2018-03-03 00:23:30 deep        
7 2018-03-03 00:23:30 2018-03-03 02:58:00 light 

A dplyr решение будет очень полезным.

Answer 1

Это распространенная проблема в геномике.Пакет IRanges на BioConductor имеет функцию findOverlaps() для этой цели.foverlaps() - это data.table версия, которая используется здесь.AFAIK, нет эквивалента dplyr .

Сначала нам нужно создать вектор времени начала и окончания дня.Вызов foverlaps() возвращает все возможные типы перекрытий.Наконец, время начала и окончания корректируется в соответствии с ожидаемым результатом.

library(data.table)
library(lubridate)
day_seq <- setDT(df)[, .(day_start = seq(
  floor_date(min(sleepdatestarttime), "day"), 
  ceiling_date(max(sleepdateendtime), "day"), "day"))][
    , day_end := day_start + days(1)]
setkey(day_seq, day_start, day_end)

foverlaps(
  df, day_seq, by.x = c("sleepdatestarttime", "sleepdateendtime"), nomatch = 0L)[
    , `:=`(sleepdatestarttime = pmax(sleepdatestarttime, day_start),
           sleepdateendtime   = pmin(sleepdateendtime, day_end - seconds(1)))][
             , c("day_start", "day_end") := NULL][]

   i  sleepdatestarttime    sleepdateendtime sleepstage
1: 1 2018-03-02 23:31:00 2018-03-02 23:54:00        rem
2: 2 2018-03-02 23:54:00 2018-03-02 23:55:00      light
3: 3 2018-03-02 23:55:00 2018-03-02 23:59:59       wake
4: 3 2018-03-03 00:00:00 2018-03-03 00:02:00       wake
5: 4 2018-03-03 00:02:00 2018-03-03 00:03:30      light
6: 5 2018-03-03 00:03:30 2018-03-03 00:23:30       deep
7: 6 2018-03-03 00:23:30 2018-03-03 02:58:00      light

Данные

df <- readr::read_table("i  sleepdatestarttime  sleepdateendtime    sleepstage 
1 2018-03-02 23:31:00 2018-03-02 23:54:00 rem                
2 2018-03-02 23:54:00 2018-03-02 23:55:00 light              
3 2018-03-02 23:55:00 2018-03-03 00:02:00 wake               
4 2018-03-03 00:02:00 2018-03-03 00:03:30 light              
5 2018-03-03 00:03:30 2018-03-03 00:23:30 deep               
6 2018-03-03 00:23:30 2018-03-03 02:58:00 light")

Answer 2

Вот возможное решение, но с использованием только базы R, а не dplyr.Я конвертировал все время в UTC, чтобы избежать проблем с конвертацией времени.(См. Связанный ответ изменение часового пояса в R без возврата к исходному часовому поясу )

Обратите внимание, что это решение восстанавливает весь фрейм данных до sleepdatestarttime, поэтому, если в один и тот же день несколько человек,тогда функция заказа в последней строке нуждается в модификации.

df<-read.table(header=TRUE, text="sleepdatestarttime  sleepdateendtime    sleepstage 
'2018-03-02 23:31:00' '2018-03-02 23:54:00' rem                
'2018-03-02 23:54:00' '2018-03-02 23:55:00' light              
'2018-03-02 23:55:00' '2018-03-03 00:02:00' wake               
'2018-03-03 00:02:00' '2018-03-03 00:03:30' light              
'2018-03-03 00:03:30' '2018-03-03 00:23:30' deep               
'2018-03-03 00:23:30' '2018-03-03 02:58:00' light")

df$sleepdatestarttime<-as.POSIXct(as.character(df$sleepdatestarttime), tz="UTC")
df$sleepdateendtime<-as.POSIXct(as.character(df$sleepdateendtime), tz="UTC")

    #find rows across days
rows<-which(as.Date(df$sleepdatestarttime) !=as.Date(df$sleepdateendtime))

#create the new rows
nstart<-data.frame(sleepdatestarttime= df$sleepdatestarttime[rows], 
                   sleepdateendtime= as.POSIXct(paste(as.Date(df$sleepdatestarttime[rows]), "23:59:59"), tz="UTC"),
                   sleepstage=df$sleepstage[rows])

nend<-data.frame(sleepdatestarttime= as.POSIXct(paste(as.Date(df$sleepdateendtime[rows]), "00:00:00"), tz="UTC"), 
                 sleepdateendtime= df$sleepdateendtime[rows],
                 sleepstage=df$sleepstage[rows])

#substitute in the new start rows
df[rows,]<-nstart
#tack on the new ending rows
df<-rbind(df, nend)
#resort the dataframe
df<-df[order(df$sleepdatestarttime ),]