Блог

У меня есть множество временных рядов, все они являются частью большого фрейма данных со множеством группирующих переменных, которые мне нужно сгладить. Мне становится комфортно с 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? Или есть простой способ включить соответствующее слияние в mutate векторов разной длины? Проблема в том, что количество пар 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
 

Не уверен, все ли я понял правильно, но, насколько я понимаю, я бы посоветовал взглянуть на 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'
 

Я только что понял, что был просто туповат. Я думаю, что довольно тривиально просто настроить дополнительный столбец с выводом из формулы сглаживания, а затем в a full_join по значениям оси x.

 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