平滑每个 x 具有多个 y 的时间序列答案

【问题标题】：smoothing a timeseries with multiple y per x平滑每个 x 具有多个 y 的时间序列
【发布时间】：2020-12-29 16:08:09
【问题描述】：

我有许多时间序列，它们都是包含许多分组变量的大型数据框的一部分，我需要对其进行平滑处理。我对 purrr 感到很舒服，所以group_by() %>% nest() 的方法似乎是合理的。每个嵌套的数据框看起来像这样：

data <- structure(list(time = c(0, 0, 6, 6, 12, 12, 18, 18, 24, 24, 30, 
    30, 36, 36, 42, 42, 48, 48, 54, 54, 60, 60, 66, 66, 72, 72, 78, 
    78, 84, 84, 90, 90, 96, 96, 102, 102, 108, 108, 114, 114, 120, 
    120, 126, 126, 132, 132, 138, 138), confluence = c(14.68764, 
    19.73559, 2.897458, 3.478664, 3.46789, 4.122939, 4.270285, 4.534702, 
    4.838222, 5.578382, 5.938678, 6.337464, 7.116287, 7.824044, 8.50258, 
    10.16758, 11.13803, 13.25756, 18.46681, 11.97336, 24.45211, 14.61754, 
    30.7178, 19.91414, 37.93423, 26.0687, 45.91022, 33.69255, 57.83714, 
    42.13477, 69.2417, 54.8134, 79.81015, 68.28696, 89.50358, 78.21476, 
    95.31271, 87.13279, 97.71458, 94.69752, 98.59245, 97.71144, 98.8707, 
    98.87447, 98.99731, 99.42957, 99.02805, 99.6716)), row.names = c(NA, 
    -48L), class = c("tbl_df", "tbl", "data.frame"))

library(tidyverse)

ggplot(data = x) +
    geom_point(aes(x = time, y = confluence)) +   
    geom_smooth(aes(x = time, y = confluence))

我想要的平滑函数输出是每个 x（时间点）都有另一列，其中包含平滑值。由于每个 x 有两个 y 值（汇合），因此应该有两个重复且相同的平滑值。

问题是我找不到提供所需输出的平滑函数，因此我可以通过 mutate 轻松附加平滑列，例如data <- data %>% mutate(smooth_y = FUN(time, confluence))。我查看了一些平滑函数，例如 loess(data$time ~ data$confluence) 输出一个对象（我猜是一条带有一堆参数的拟合线，我猜）或 supsmu(data$time, data$confluence) 它删除了输出的重复 x 值。

是否有一个平滑函数可以为所有 x 创建一个输出？或者是否有一种简单的方法可以将适当的合并合并到具有不同长度的向量的变异中？问题是不同拆分组中的 x/y 对的数量可能不相同（一些缺失值，可能有一些重复），所以它必须是一个强大的映射回来（而不是依赖于 y 的简单重复-值）。

期望的输出：

# head(data)
#
# # A tibble: 6 x 3
# time confluence smooth
# <dbl>      <dbl>  <dbl>
#   1     0      14.7   14.7 
# 2     0      19.7   14.7 
# 3     6       2.90   8.72
# 4     6       3.48   8.72
# 5    12       3.47   5.10
# 6    12       4.12   5.10

【问题讨论】：

标签： r tidyverse purrr smoothing

【解决方案1】：

不确定我是否做对了一切，但据我所知，我建议看看broom 包。

使用loess 进行平滑处理，您可以使用broom::augment 轻松附加具有平滑值的列。但是，我不确定这是否适用于您的所有数据集。

为了使示例更有趣，我复制了您的数据集，向您展示如何在一组数据集上应用 augment 和 purrr、tidyr 和 dplyr 的一般方法：

library(tidyverse)
library(broom)

data_list <- bind_rows(list(data1 = data, data2 = data), .id = "id")

data_sm <- data_list %>% 
  nest(data = -id) %>% 
  mutate(mod = purrr::map(data, ~ loess(confluence ~ time, data = .x)),
         data = purrr::map(mod, ~ augment(.x))) %>% 
  unnest(data)

ggplot(data = data_sm) +
  geom_point(aes(x = time, y = confluence, color = "raw")) +   
  geom_smooth(aes(x = time, y = confluence)) +
  geom_point(aes(x = time, y = .fitted, color = "smoothed")) +
  scale_color_manual(values = c(smoothed = "red", raw = "black")) +
  facet_wrap(~id)
#> `geom_smooth()` using method = 'loess' and formula 'y ~ x'

【讨论】：

谢谢你，@stefan。我会检查扫帚包，但我也在考虑一般的解决方案。而且我认为我只是近视并试图立即合并。如果我只是添加一个带有平滑结果的额外列，然后进行连接，事情就变得微不足道了。我现在就输入答案。

【解决方案2】：

我才意识到我只是太密集了。我认为只需使用平滑公式的输出设置一个附加列，然后在 x 轴值上设置一个 full_join，这非常简单。

data <- structure(list(time = c(0, 0, 6, 6, 12, 12, 18, 18, 24, 24, 30, 
    30, 36, 36, 42, 42, 48, 48, 54, 54, 60, 60, 66, 66, 72, 72, 78, 
    78, 84, 84, 90, 90, 96, 96, 102, 102, 108, 108, 114, 114, 120, 
    120, 126, 126, 132, 132, 138, 138), confluence = c(14.68764, 
    19.73559, 2.897458, 3.478664, 3.46789, 4.122939, 4.270285, 4.534702, 
    4.838222, 5.578382, 5.938678, 6.337464, 7.116287, 7.824044, 8.50258, 
    10.16758, 11.13803, 13.25756, 18.46681, 11.97336, 24.45211, 14.61754, 
    30.7178, 19.91414, 37.93423, 26.0687, 45.91022, 33.69255, 57.83714, 
    42.13477, 69.2417, 54.8134, 79.81015, 68.28696, 89.50358, 78.21476, 
    95.31271, 87.13279, 97.71458, 94.69752, 98.59245, 97.71144, 98.8707, 
    98.87447, 98.99731, 99.42957, 99.02805, 99.6716)), row.names = c(NA, 
    -48L), class = c("tbl_df", "tbl", "data.frame"))

library(tidyverse   )

smooth <- data.frame(supsmu(data$time, data$confluence))
data <- full_join(data, smooth, by= c("time" = "x"))

ggplot(data = data) +
    geom_point(aes(x = time, y = confluence)) + 
    geom_smooth(aes(x = time, y = confluence)) +
    geom_point(aes(x = time, y = y), color = "red") 

head(data, 10)

# # A tibble: 10 x 3
# time confluence     y
# <dbl>      <dbl> <dbl>
#   1     0      14.7  14.7 
# 2     0      19.7  14.7 
# 3     6       2.90  8.72
# 4     6       3.48  8.72
# 5    12       3.47  5.10
# 6    12       4.12  5.10
# 7    18       4.27  4.49
# 8    18       4.53  4.49
# 9    24       4.84  5.30
# 10    24       5.58  5.30

【讨论】：