CODEWITHSUNDEEP
rdatedatetime
huluwa
huluwa

Reputation: 41

R: how can I split one row of a time period into multiple rows based on day and time

I am trying to split rows in an excel file based on day and time. The data is from a study which participants will need to wear a tracking watch. Each row of the data set is started with participants put on the watch (Variable: 'Wear Time Start ') and ended with them taking off the device (Variable: 'Wear Time End').

I need to calculate how many hours of each participant wearing the device on each day (NOT each time period in one row).

Data set before split:

   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           ...

Some explanation about the data set before split: the data type of 'WearStart' and 'WearEnd' are POSIXlt.

Desired output after split:

  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

Then I need to accumulate hours based on day:

  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

Upvotes: 2

Views: 1381

Answers (2)

Farzad Minooei
Farzad Minooei

Reputation: 51

Here is my solution to your question with just using basic functions in 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

Upvotes: 1

Georgery
Georgery

Reputation: 8117

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

Short summary

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

Upvotes: 3

Related Questions