我正在尝试从时间序列中推断缺失值。我对 tidyverse 很满意,但似乎遇到了一些障碍,我不确定我是否应该采取不同的方法。
我有一个时间间隔不均匀的数据框。如果测量之间的时间超过某个阈值,我想在上下最近的时间之间进行线性外推,测量值均匀分布。像这样的东西:
df <- tibble(
time = c(1, 2, 3, 8, 9),
meas = c(200, 300, 320, 500, 600)
);
avg_meas_interval <- median(df$time - lag(df$time);
df %>% mutate(
if_else(
time - lag(time) > threshold,
tibble(
time_extrp = seq(lag(time), time, avg_meas_interval),
meas_extrp = seq(lag(meas), meas, length.out = length(time_extrp))
),
NA
)
)
然后我会有一列 tibbles 表示应该在给定行之前插入的外推行,如果没有要插入的行,则为 NA。我可以拉这个和 row_bind.
现在,我在使用这种方法时遇到了一些问题:
看起来像这样的简单外推,输出大小取决于输入数据,很难以纯函数式风格实现。不确定是否有比仅在程序 R 或 python 中实现更好的方法。
也许是这个?
df %>%
mutate(
across(c(time, meas), lag, .names = "lag_{.col}"),
intrvl = c(1, rep(median(diff(time)), n() - 1)), # I'm inferring here ...
extrp = purrr::pmap(
list(time, lag_time, meas, lag_meas, intrvl),
~ if (!is.na(..2) && (..1 - ..2) > threshold) {
tibble(time_extrp = seq(..2, ..1, length.out=..5),
meas_extrp = seq(..4, ..3, length.out=..5))
})
)
# # A tibble: 5 × 6
# time meas lag_time lag_meas intrvl extrp
# <dbl> <dbl> <dbl> <dbl> <dbl> <list>
# 1 1 200 NA NA 1 <NULL>
# 2 2 300 1 200 1 <NULL>
# 3 3 320 2 300 1 <NULL>
# 4 8 500 3 320 1 <tibble [1 × 2]>
# 5 9 600 8 500 1 <NULL>