-
Notifications
You must be signed in to change notification settings - Fork 0
/
time_alignment.R
89 lines (85 loc) · 3 KB
/
time_alignment.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
# TODO: add option to correct future status dates using met data before adv cor
#' Correct adv timestamp using jitter correction
#'
#' Provides a per-file timestamp that does not have duplicated
#' or missing timestamps due to serial packet arrival time jitter.
#'
#' Removes future timestamps to prevent "2038" problem.
#'
#' @param timestamp A vector of teensy lander timestamps
#' @param adv_timestamp A vector of ADV timestamps
#'
#' @return A vector of corrected timestamps.
#' @export
correct_status_timestamp_jitter <- function(timestamp, adv_timestamp) {
timestamp[which(timestamp > Sys.time())] <- NA
adv_timestamp[which(adv_timestamp > Sys.time())] <- NA
fix_timestamp_jitter(timestamp, adv_timestamp)
}
#' Correct adv timestamp using initial offset from teensy timestamp
#'
#' Provides a per-file timestamp that does not have duplicated
#' or missing timestamps due to serial packet arrival time jitter.
#'
#' @param timestamp A vector of teensy lander timestamps
#' @param adv_timestamp A vector of ADV timestamps
#'
#' @return A vector of offset-corrected adv timestamps.
#' @export
correct_status_timestamp_adv <- function(timestamp, adv_timestamp) {
i <- which(timestamp <= Sys.time())[1]
if (!length(i)) return(timestamp)
offset <- difftime(timestamp[i], adv_timestamp[i], units = "secs")
adv_timestamp + offset
}
#' Apply timestamps to LECS ADV data
#'
#' Version from R2evans on stack overflow
#'
#' @param adv_data A dataframe with ADV data lines
#' @param status A dataframe with parsed timestamps and original row_nums
#'
#' @return ADV data with timestamps added
#' @export
#' @importFrom dplyr filter select mutate
make_lecs_ts <- function(adv_data, status) {
if ("send" %in% names(status)) {
df <- adv_data |>
mutate(timestamp = as.POSIXct(NA)) |>
dplyr::bind_rows(select(status, row_num, send, type, timestamp)) |>
dplyr::arrange(row_num) |>
dplyr::group_by(send)
} else {
df <- adv_data |>
mutate(timestamp = as.POSIXct(NA)) |>
dplyr::bind_rows(select(status, row_num, type, timestamp)) |>
dplyr::arrange(row_num)
}
df |>
mutate(count2 = count, nexttime = timestamp, prevtime = timestamp) |>
tidyr::fill(count2, .direction = "updown") |>
mutate(
count2 = count2 + 256*cumsum(c(FALSE, diff(count2) < 0)),
boundary = c(TRUE, abs(diff(count2)) > 3), # tol = 3
spread_group = cumsum(boundary)
) |>
dplyr::group_by(spread_group) |>
mutate(
nextind = dplyr::if_else(is.na(timestamp), count2[NA], count2),
prevind = nextind,
) |>
tidyr::fill(prevtime, prevind, .direction = "down") |>
tidyr::fill(nexttime, nextind, .direction = "up") |>
mutate(
newtimestamp = dplyr::case_when(
!is.na(timestamp) ~ timestamp,
is.na(prevtime) | count2 - dplyr::lag(count2) > 2 ~
nexttime + (count2 - nextind)/16,
TRUE ~
prevtime + (count2 - prevind)/16
)
) |>
dplyr::ungroup() |>
filter(type == "D") |>
select(timestamp = newtimestamp, names(adv_data))
}