91 lines
5.2 KiB
R
91 lines
5.2 KiB
R
get_existent_dates <- function(data, time_segments, include_past_periodic_segments){
|
|
max_delay = max(time_segments$length_duration)
|
|
max_delay <- (if_else(is.na(max_delay) | include_past_periodic_segments == FALSE, duration("0days"), max_delay))
|
|
|
|
existent_dates <- data %>%
|
|
distinct(local_date, .keep_all = FALSE) %>%
|
|
mutate(local_date_obj = lubridate::ymd(local_date)) %>%
|
|
complete(local_date_obj = seq(date(min(local_date_obj) - max_delay), max(local_date_obj), by="days")) %>%
|
|
mutate(local_date = replace_na(as.character(local_date_obj)),
|
|
every_day = 0,
|
|
wday = wday(local_date_obj, week_start = 1),
|
|
mday = mday(local_date_obj),
|
|
qday = qday(local_date_obj),
|
|
yday = yday(local_date_obj)) %>%
|
|
select(-local_date_obj)
|
|
}
|
|
|
|
infer_existent_periodic_segments <- function(existent_dates, segments){
|
|
# build the actual time segments taking into account the data and users' requested length and repeat schedule
|
|
# segment datetime labels are computed on UTC
|
|
crossing(segments, existent_dates) %>%
|
|
pivot_longer(cols = c(every_day,wday, mday, qday, yday), names_to = "day_type", values_to = "day_value") %>%
|
|
filter(repeats_on == day_type & repeats_value == day_value) %>%
|
|
mutate(segment_id_start = lubridate::parse_date_time(paste(local_date, start_time), orders = c("Ymd HMS", "Ymd HM")) + period(overlap_duration),
|
|
segment_id_end = segment_id_start + lubridate::period(length)) %>%
|
|
select(original_label, label, segment_id_start, segment_id_end, overlap_id, length)
|
|
}
|
|
|
|
dedup_nonoverlapping_periodic_segments <- function(nested_inferred_time_segments){
|
|
# Overlapping segments exist when their length is longer than their repeating frequency, e.g. twoday segements starting on every day
|
|
# In process_time_segments we decompose those segments into non-overlapping ones, e.g. twodayA +0days and twodayB +1days
|
|
# This means that any date will have more than one non-overlapping instances, that we need to dedup
|
|
# We choose alternating non-overlapping instances to guarantee any data row is only neeeded in one instance at a time
|
|
# d1,r1,twoday0
|
|
# d2,r2,twoday0 twoday1
|
|
# d3,r3,twoday1 twoday0
|
|
# d4,r4,twoday0 twoday1
|
|
if(nrow(nested_inferred_time_segments) == 0)
|
|
return(nested_inferred_time_segments)
|
|
new_segments <- data.frame(nested_inferred_time_segments %>%
|
|
group_by(original_label) %>%
|
|
mutate(max_groups = max(overlap_id) + 1) %>%
|
|
# select(label, segment_id_start, segment_id_end, overlap_id, max_groups) %>%
|
|
nest() %>%
|
|
mutate(data = map(data, function(nested_data){
|
|
nested_data <- nested_data %>% arrange( segment_id_start, segment_id_end) %>%
|
|
group_by(segment_id_start) %>%
|
|
mutate(n_id = ((cur_group_id()-1) %% max_groups)) %>%
|
|
filter(overlap_id == n_id) %>%
|
|
# select(label, segment_id_start, overlap_id, n_id) %>%
|
|
ungroup()
|
|
})) %>%
|
|
unnest(cols = data) %>%
|
|
ungroup())
|
|
}
|
|
|
|
|
|
|
|
add_periodic_segment_timestamps_and_id <- function(data, segments, local_timezone){
|
|
# segment timestamps are computed on the data's timezone(s)
|
|
time_format_fn <- stamp("23:51:15", orders="HMS", quiet = TRUE)
|
|
segments %>% mutate(segment_id_start_tz = lubridate::force_tz(segment_id_start, tzone = local_timezone),
|
|
segment_start_ts = as.numeric(segment_id_start_tz) * 1000,
|
|
segment_end_ts = as.numeric(segment_id_start_tz + lubridate::period(length)) * 1000 + 999,
|
|
segment_id_start_tz = NULL,
|
|
segment_id = glue("[{label}#{start_date} {start_time},{end_date} {end_time};{segment_start_ts},{segment_end_ts}]",
|
|
start_date=lubridate::date(segment_id_start),
|
|
start_time=time_format_fn(segment_id_start),
|
|
end_date=lubridate::date(segment_id_end),
|
|
end_time=time_format_fn(segment_id_end) )) %>%
|
|
drop_na(segment_start_ts, segment_end_ts)
|
|
}
|
|
|
|
assign_to_periodic_segments <- function(sensor_data, time_segments, include_past_periodic_segments){
|
|
time_segments <- time_segments %>% mutate(length_duration = duration(length))
|
|
existent_dates <- get_existent_dates(sensor_data, time_segments, include_past_periodic_segments)
|
|
inferred_segments <- infer_existent_periodic_segments(existent_dates, time_segments) %>%
|
|
dedup_nonoverlapping_periodic_segments()
|
|
|
|
sensor_data <- sensor_data %>%
|
|
group_by(local_timezone) %>%
|
|
nest() %>%
|
|
mutate(localised_time_segments = map(data, add_periodic_segment_timestamps_and_id, inferred_segments, local_timezone),
|
|
data = map2(data, localised_time_segments, assign_rows_to_segments)) %>%
|
|
select(-localised_time_segments) %>%
|
|
unnest(cols = data) %>%
|
|
arrange(timestamp) %>%
|
|
ungroup()
|
|
|
|
return(sensor_data)
|
|
} |