且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

R:如何根据日期和时间将时间段的一行分成多行

更新时间:2023-02-05 09:59:07

所以,我重新设计了整个答案。请检查代码。我很确定这就是您想要的。

So, I reworked the entire answer. Please, review the code. I am pretty sure this is what you want.

简短摘要

问题是您需要拆分在不同日期开始和结束的行。您需要递归执行此操作。因此,我将数据帧拆分为1行数据帧的列表。对于每个我都检查开始和结束是否在同一天。如果没有,我将其设置为2行数据帧,并调整开始和结束时间。然后将其再次拆分为1行数据帧的列表,依此类推。
最后有一个嵌套的1行数据框列表,其中开始和结束在同一天。然后将此列表再次递归绑定在一起。

The problem is that you need to split rows which start and end on different dates. And you need to do this recursively. So, I split the dataframe into a list of 1-row dataframes. For each I check whether start and end is on the same day. If not, I make it a 2-row dataframe with the adjusted start and end times. This is then split up again into a list of 1-row dataframes and so on so forth. In the end there is a nested list of 1-row dataframes where start and end is on the same day. And this list is then recursively bound together again.

# Load Packages ---------------------------------------------------------------------------------------------------

library(tidyverse)
library(lubridate)

df <- tribble(
    ~ID,         ~WearStart,              ~WearEnd    
    , 01, "2018-05-14 09:00:00", "2018-05-14 20:00:00"
    , 01, "2018-05-14 21:30:00", "2018-05-15 02:00:00"
    , 01, "2018-05-15 07:00:00", "2018-05-16 22:30:00"
    , 01, "2018-05-16 23:00:00", "2018-05-16 23:40:00"
    , 01, "2018-05-17 01:00:00", "2018-05-19 15:00:00"
)
df <- df %>% mutate_at(vars(starts_with("Wear")), ymd_hms)


# Helper Functions ------------------------------------------------------------------------------------------------

endsOnOtherDay <- function(df){
    as_date(df$WearStart) != as_date(df$WearEnd)
}

split1rowInto2Days <- function(df){
    df1 <- df
    df2 <- df
    df1$WearEnd <- as_date(df1$WearStart) + days(1) - milliseconds(1)
    df2$WearStart <- as_date(df2$WearStart) + days(1)
    rbind(df1, df2)
}


splitDates <- function(df){
    if (nrow(df) > 1){
        return(df %>%
                   split(f = 1:nrow(df)) %>%
                   lapply(splitDates) %>%
                   reduce(rbind))
    }

    if (df %>% endsOnOtherDay()){
        return(df %>%
                   split1rowInto2Days() %>%
                   splitDates())
    }

    df
}

# The actual Calculation ------------------------------------------------------------------------------------------

df %>% 
    splitDates() %>%
    mutate(wearDuration = difftime(WearEnd, WearStart, units = "hours")
           , wearDay = as_date(WearStart)) %>%
    group_by(ID, wearDay) %>%
    summarise(wearDuration_perDay = sum(wearDuration))

     ID wearDay    wearDuration_perDay
  <dbl> <date>     <drtn>             
1     1 2018-05-14 13.50000 hours     
2     1 2018-05-15 19.00000 hours     
3     1 2018-05-16 23.16667 hours     
4     1 2018-05-17 23.00000 hours     
5     1 2018-05-18 24.00000 hours     
6     1 2018-05-19 15.00000 hours