calculate number of unique events and sum of time by each date

Viewed 64

I have a large dataset that looks like below.

Date Time PeopleExposed
11/1 1PM  1
11/1 3PM  0
11/2 1PM  5
11/2 4PM  10
11/2 6PM  3
11/2 7PM  0
11/2 8PM  2
11/2 9PM  0
11/3 3PM  5
11/3 6PM  0

PeopleExposed indicates the number of people exposed to a chemical. So going from 0 to a positive number of people means an exposure event happened, then back to 0 means it has ended.

How would I calculate, for each day, the total number of unique "events" and "people-hours of exposure"?

So for # "events", there are 1 for 11/1, 2 for 11/2, and 1 for 11/3.

And for "people-hours":
Event #1, 11/1: 1P is exposed for 2 hours (1PM to 3PM): 2 people-hours.
Event #1, 11/2: 5P are exposed for 3hrs, then 10P are exposed for 2hrs, then 3P are exposed for 1hr: 38 people-hours.
Event #2, 11/2: 2P are exposed for 1hr: 2 people-hours.
Event #1, 11/3: 5P are exposed for 3hrs: 15 people-hours

I want to use data.table or dplyr to return:

Date NumEvents  PeopleHoursTotal
11/1  1          2
11/2  2          40
11/3  1          15

and

Date EventNum  PeopleHoursTotal TimeStart TimeEnd
11/1  1          2                  1PM       3PM
11/2  1          38                 1PM       7PM
11/2  2          2                  8PM       8PM
11/3  1          15                 3PM       6PM

I've been creating indicator variables to create indicator variable columns for start and end of an event, but not sure what to do after that.

2 Answers

You may try

library(dplyr)
library(lubridate)

df2 <- df %>%
  mutate(time = parse_date_time(Time, "%I %p")) %>%
  group_by(Date) %>%
  mutate(EventNum = lag(cumsum(PeopleExposed == 0)) %>% replace_na(., 0) + 1,
         difftime = as.numeric(lead(time) - time)) %>%
  ungroup
df2 %>%
  group_by(Date) %>%
  summarise(NumEvents = length(unique(EventNum)),
            PeopleHoursTotal = sum(PeopleExposed * difftime, na.rm = T))

  Date  NumEvents PeopleHoursTotal
  <chr>     <int>            <dbl>
1 11/1          1                2
2 11/2          2               40
3 11/3          1               15

df2 %>%
  group_by(Date, EventNum) %>%
  summarise(PeopleHoursTotal = sum(PeopleExposed * difftime, na.rm = T),
            TimeStart = first(Time),
            TimeEnd = last(Time))

  Date  EventNum PeopleHoursTotal TimeStart TimeEnd
  <chr>    <dbl>            <dbl> <chr>     <chr>  
1 11/1         1                2 1PM       3PM    
2 11/2         1               38 1PM       7PM    
3 11/2         2                2 8PM       9PM    
4 11/3         1               15 3PM       6PM 

here is a data.table approach

# make posix, this way it is easy to perform calculations of exposions that cross a dateline
DT[, datetime := as.POSIXct(paste0("2021/", Date, "T", Time),
                            format = "%Y/%d/%mT%I%p")]
# get next time
DT[, datetime_next := shift(datetime, type = "lead")]
# calculate people exposed hours
DT[, peh := as.numeric(datetime_next - datetime) * PeopleExposed]
#creatae group-dummy
DT[, dummy := rleid(PeopleExposed > 0)]

# summarise for table 1
DT[PeopleExposed > 0, .(NumEvents = uniqueN(dummy), PeopleHoursTotal = sum(peh)), by = .(Date)]
#    Date NumEvents PeopleHoursTotal
# 1: 11/1         1                2
# 2: 11/2         2               40
# 3: 11/3         1               15

# summarise for table 2
DT[PeopleExposed > 0, .(PeopleHoursTotal = sum(peh),
                        TimeStart = min(datetime),
                        TimeEnd = max(datetime_next)), by = .(dummy, Date)][, `:=`(dummy = NULL, 
                                                                                   EventNum = rowid(Date))][]
#    Date PeopleHoursTotal           TimeStart             TimeEnd EventNum
# 1: 11/1                2 2021-01-11 13:00:00 2021-01-11 15:00:00        1
# 2: 11/2               38 2021-02-11 13:00:00 2021-02-11 19:00:00        1
# 3: 11/2                2 2021-02-11 20:00:00 2021-02-11 21:00:00        2
# 4: 11/3               15 2021-03-11 15:00:00 2021-03-11 18:00:00        1

sample data used

library(data.table)
DT <- fread("Date Time PeopleExposed
11/1 1PM  1
11/1 3PM  0
11/2 1PM  5
11/2 4PM  10
11/2 6PM  3
11/2 7PM  0
11/2 8PM  2
11/2 9PM  0
11/3 3PM  5
11/3 6PM  0")
Related