Is there a way of splitting time and duration variable while leaving other variables unchanged in R?

Viewed 95

I have a dataset that I'd now like to split at 12:00pm (midday) into two, i.e. if variable goes from 08:00-13:00 it becomes 08:00-12:00 and 12:00-13:00 across two rows. The variable duration and cumulative sum would need to be changed accordingly, but the other variables should be as in the original (unchanged).

This should be applicable across different id variables.

id = unchanged from row 1, just repeated
start = changed in both rows
end = changed in both rows
day = unchanged from row 1, just repeated
duration = changed in both rows
cumulative time = changed in both row

ORIGINAL DATAFILE
#Current dataframe
id<-c("m1","m1")
x<-c("2020-01-03 10:00:00","2020-01-03 19:20:00")
start<-strptime(x,"%Y-%m-%d %H:%M:%S")
y<-c("2020-01-03 16:00:00","2020-01-03 20:50:00")
end<-strptime(y,"%Y-%m-%d %H:%M:%S")
day<-c(1,1)
mydf<-data.frame(id,start,end,day)
# calculate duration and time
mydf$duration<-as.numeric(difftime(mydf$end,mydf$start,units = "hours"))
mydf$time<-c(cumsum(mydf$duration))

REQUIRED DATAFILE
#Required dataframe
id2<-c("m1","m1","m1")
x2<-c("2020-01-03 10:00:00","2020-01-03 12:00:00","2020-01-03 19:20:00")
start2<-strptime(x2,"%Y-%m-%d %H:%M:%S")
y2<-c("2020-01-03 12:00:00","2020-01-03 16:00:00","2020-01-03 20:50:00")
end2<-strptime(y2,"%Y-%m-%d %H:%M:%S")
day2<-c(1,1,1)
mydf2<-data.frame(id2,start2,end2,day2)
# calculate duration and time
mydf2$duration<-c(2,4,1.5)
mydf2$time<-c(2,6,7.5)
2 Answers

Good question. So, each line implicitly contains either one or two intervals, so you should be able to just define those interval(s) on each line and then pivot to long, but you can't pivot with interval values (yet?). So, here's my approach, which computes up to two shift start times for each line, and then infers the shift end from the start of the next shift after pivoting. Comments inline.

library(lubridate, warn.conflicts = FALSE)
library(tidyverse)
library(magrittr, warn.conflicts = FALSE)
library(hablar, warn.conflicts = FALSE)

(mydf <- tibble(
  id    = "m1",
  start = as_datetime(c("2020-01-03 10:00:00", "2020-01-03 19:20:00")),
  end   = as_datetime(c("2020-01-03 16:00:00", "2020-01-03 20:50:00")),
  day   = 1
))
#> # A tibble: 2 x 4
#>   id    start               end                   day
#>   <chr> <dttm>              <dttm>              <dbl>
#> 1 m1    2020-01-03 10:00:00 2020-01-03 16:00:00     1
#> 2 m1    2020-01-03 19:20:00 2020-01-03 20:50:00     1

(mydf2 <- 
    mydf %>% 
    # Assume the relevant noontime cutoff is on the same day as the start
    mutate(midday = 
             start %>% as_date() %>% 
             add(12 %>% hours()) %>% 
             fit_to_timeline() %>% 
             # No relevant midday if the shift doesn't include noon
             na_if(not(. %within% interval(start, end)))) %>% 

    # Make an original row ID since there doesn't seem to be one, and we will need
    # to build intervals within the data stemming from each original row
    rownames_to_column("orig_shift") %>% 

    pivot_longer(cols = c(start, midday, end),
                 # The timestamps we have here will be treated as start times
                 values_to = "start",
                 # Drop rows that would exist due to irrelevant middays
                 values_drop_na = TRUE) %>% 
    select(-name) %>% 

    # Infer shift end times as the start of the next shift, within lines defined
    # by the original shifts
    group_by(orig_shift) %>% 
    arrange(start) %>% 
    mutate(end = lead(start)) %>% 
    ungroup() %>% 

    # Drop lines that represent the end of the last shift and not a full one
    drop_na() %>% 

    # Compute those durations and times (should times really be globally
    # cumulative? Also, your specified mydf2 seems to have an incorrect first time
    # value)
    mutate(duration = start %--% end %>% as.numeric("hours"),
           time = cumsum(duration)) %>% 
    select(id, start, end, day, duration, time))
#> # A tibble: 3 x 6
#>   id    start               end                   day duration  time
#>   <chr> <dttm>              <dttm>              <dbl>    <dbl> <dbl>
#> 1 m1    2020-01-03 10:00:00 2020-01-03 12:00:00     1      2     2  
#> 2 m1    2020-01-03 12:00:00 2020-01-03 16:00:00     1      4     6  
#> 3 m1    2020-01-03 19:20:00 2020-01-03 20:50:00     1      1.5   7.5

Created on 2019-10-23 by the reprex package (v0.3.0)

Here is mine solution for a more general case when you have many observations with different dates. The logic is the following.

  1. Firstly, I create a data frame with 12:00pm (midday) splitters.

  2. Next, I identify the rows which should be split by joining the data frame to the initial one and saving them in separate data frame.

  3. Next, I duplicate the rows and create the split_rows

  4. From the original dataset I delete the rows which I split and join the correct doubled rows.

library(dplyr)

split_time_data =
  tibble(split_time = as.POSIXct(seq(0, 365*60*60*24, 60*60*24),
                          origin="2020-01-01 17:00:00")) %>%
  mutate(key = TRUE)# I use 17:00 to make it 12:00 EST, adjust for your purposes

data_to_split =
  mydf %>%
  mutate(key = TRUE) %>%
  left_join(split_time_data) %>%
  filter(between(split_time, start, end)) %>%
  select(-key)

library(lubridate)
split_rows =
  data_to_split %>%
  rbind(data_to_split) %>%
  arrange(start) %>%
  group_by(start) %>%
  mutate(row_number =  row_number() ) %>%
  ungroup() %>%
  mutate(start = if_else(row_number == 1, start, split_time ),
         end = if_else(row_number == 1, split_time, end )) %>%
  select(-row_number, -split_time) %>%
  mutate(duration = hour(end) - hour(start) )

mydf %>%
  anti_join(data_to_split) %>%
  full_join(split_rows) %>%
  arrange(start) %>%
  mutate(time = cumsum(duration) )

The output

  id               start                 end day duration time
1 m1 2020-01-03 10:00:00 2020-01-03 12:00:00   1      2.0  2.0
2 m1 2020-01-03 12:00:00 2020-01-03 16:00:00   1      4.0  6.0
3 m1 2020-01-03 19:20:00 2020-01-03 20:50:00   1      1.5  7.5
Related