R：如何根据日期和时间将时间段的一行拆分为多行答案

【问题标题】：R: how can I split one row of a time period into multiple rows based on day and timeR：如何根据日期和时间将时间段的一行拆分为多行
【发布时间】：2020-02-14 18:56:04
【问题描述】：

我正在尝试根据日期和时间拆分 Excel 文件中的行。数据来自一项研究，参与者需要佩戴跟踪手表。数据集的每一行都以参与者戴上手表开始（变量：“佩戴时间开始”），并以他们脱下设备结束（变量：“佩戴时间结束”）。

我需要计算每个参与者每天佩戴设备的小时数（不是每一行的每个时间段）。

拆分前的数据集：

   ID          WearStart                WearEnd
1  01           2018-05-14 09:00:00      2018-05-14 20:00:00
2  01           2018-05-14 21:30:00      2018-05-15 02:00:00
3  01           2018-05-15 07:00:00      2018-05-16 22:30:00
4  01           2018-05-16 23:00:00      2018-05-16 23:40:00
5  01           2018-05-17 01:00:00      2018-05-19 15:00:00
6  02           ...

关于拆分前的数据集的一些解释：'WearStart'和'WearEnd'的数据类型是POSIXlt。

拆分后的期望输出：

  ID         WearStart                WearEnd                Interval
1 01         2018-05-14 09:00:00      2018-05-14 20:00:00    11
2 01         2018-05-14 21:30:00      2018-05-15 00:00:00    2.5
3 01         2018-05-15 00:00:00      2018-05-15 02:00:00    2                
4 01         2018-05-15 07:00:00      2018-05-16 00:00:00    17
5 01         2018-05-16 00:00:00      2018-05-16 22:30:00    22.5
4 01         2018-05-16 23:00:00      2018-05-16 23:40:00    0.4
5 01         2018-05-17 01:00:00      2018-05-18 00:00:00    23
6 01         2018-05-18 00:00:00      2018-05-19 00:00:00    24
7 01         2018-05-19 00:00:00      2018-05-19 15:00:00    15

然后我需要根据天累积小时数：

  ID         Wear_Day        Total_Hours
1 01         2018-05-14      13.5
2 01         2018-05-15      19
3 01         2018-05-16      22.9                
4 01         2018-05-17      23
5 01         2018-05-18      24
4 01         2018-05-19      15

【问题讨论】：

你是按天分割的吗

标签： r date datetime

【解决方案1】：

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

简短摘要

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

# 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

【讨论】：

@huluwa 你能检查一下吗？
嗨@Georgery，很抱歉我没有在假期查看网站。非常感谢你的工作！！你为我节省了几天的工作时间。我在我的一小部分数据上尝试了你的代码，它运行得很好。但是我遇到了一个导致 R 关闭的错误。我试图找出原因，我会在这里更新。
我解决了这个问题！虽然仍然不确定到底发生了什么，但我对数据类型做了一些修改，你的代码很适合我的所有数据。再次感谢！
关于错误：如果您的数据集真的很大（数百万行）并且磨损持续时间通常是多天，您可能会遇到内存问题。关键是这是一个递归函数，即它一次又一次地调用自身，这可能导致函数调用的深度嵌套结构，从而导致内存使用。这里的这个版本非常优雅，但对于非常大的数据集，带有forloop 的函数可能会更好。
感谢您的解释。我从你的代码中学到了很多东西。当然！但对 Stackoverflow 上的功能来说是新的。如何标记答案？

【解决方案2】：

这是我对您问题的解决方案，仅使用 R 中的基本功能：

#step 1: read data from file
d <- read.csv("dt.csv", header = TRUE)
d
   ID           WearStart             WearEnd
1  1 2018-05-14 09:00:00 2018-05-14 20:00:00
2  1 2018-05-14 21:30:00 2018-05-15 02:00:00
3  1 2018-05-15 07:00:00 2018-05-16 22:30:00
4  1 2018-05-16 23:00:00 2018-05-16 23:40:00
5  1 2018-05-17 01:00:00 2018-05-19 15:00:00
6  2 2018-05-16 11:30:00 2018-05-16 11:40:00
7  2 2018-05-16 22:05:00 2018-05-22 22:42:00

#step 2: change class of WearStart and WearEnd to POSIlct
d$WearStart <- as.POSIXlt(d$WearStart, tryFormats = "%Y-%m-%d %H:%M")
d$WearEnd   <- as.POSIXlt(d$WearEnd, tryFormats = "%Y-%m-%d %H:%M")

#step 3: calculate time interval (days and hours) for each record
timeInt <- function(d) {
        WearStartDay  <- as.Date(d$WearStart, "%Y/%m/%d")
        Interval_days <- as.numeric(difftime(d$WearEnd,d$WearStart, units = "days"))
        Days <- WearStartDay + seq(0, Interval_days,1)
        N_FullBTWDays <- length(Days) - 2 

        if (N_FullBTWDays >= 0) {
           sd   <- d$WearStart
           sd_h <- 24 - sd$hour -1
           sd_m <- (60 - sd$min)/60
           sd_total <- sd_h + sd_m
           hours <- sd_total
           hours <- c(hours, rep(24,N_FullBTWDays))
           ed   <- d$WearEnd
           ed_h <- ed$hour
           ed_m <- ed$min/60
           ed_total <- ed_h + ed_m
           hours <- c(hours,ed_total)
        } else {
         hours <- as.numeric(difftime(d$WearEnd,d$WearStart, units = "hours"))
        }
  df <- data.frame(id = rep(d$ID, length(Days)), days = Days, hours = hours)
  return(df)
  }

  df <- data.frame(matrix(ncol = 3, nrow = 0))
  colnames(df) <- c("id", "days", "hours")
  for ( i in 1:nrow(d)) {
   df <- rbind(df,timeInt(d[i,]))
  }

id       days      hours
1   1 2018-05-14 11.0000000
2   1 2018-05-14  4.5000000
3   1 2018-05-15 17.0000000
4   1 2018-05-16 22.5000000
5   1 2018-05-16  0.6666667
6   1 2018-05-17 23.0000000
7   1 2018-05-18 24.0000000
8   1 2018-05-19 15.0000000
9   2 2018-05-16  0.1666667
10  2 2018-05-16  1.9166667
11  2 2018-05-17 24.0000000
12  2 2018-05-18 24.0000000
13  2 2018-05-19 24.0000000
14  2 2018-05-20 24.0000000
15  2 2018-05-21 24.0000000
16  2 2018-05-22 22.7000000

#daily usage of device for each customer
res <- as.data.frame(tapply(df$hours, list(df$days,df$id), sum))
res[is.na(res)] <- 0
res$date <- rownames(res)
res
                  1         2       date
2018-05-14 15.50000  0.000000 2018-05-14
2018-05-15 17.00000  0.000000 2018-05-15
2018-05-16 23.16667  2.083333 2018-05-16
2018-05-17 23.00000 24.000000 2018-05-17
2018-05-18 24.00000 24.000000 2018-05-18
2018-05-19 15.00000 24.000000 2018-05-19
2018-05-20  0.00000 24.000000 2018-05-20
2018-05-21  0.00000 24.000000 2018-05-21
2018-05-22  0.00000 22.700000 2018-05-22

【讨论】：

嗨@Farzad，非常感谢您的帮助！您的代码非常适合我的数据！唯一的问题是一些输出值不正确，我仍在尝试了解原因。我需要做一些修改。