Автоматический способ выделения частей графика временного ряда, значения которых превышают определенный порог? - PullRequest
Новая
       46

Автоматический способ выделения частей графика временного ряда, значения которых превышают определенный порог?

0 голосов
/ 28 июня 2019

Я ищу автоматический способ подсветки некоторых частей графика, у которых значения Station2 превышают предварительно определенный порог, который в данном случае равен 0.Я могу сделать это вручную, указав Date во фрейме данных (dateRanges) после проверки графика.

Заранее благодарим вас за любые предложения! 

library(ggplot2)

# sample data
df <- structure(list(Date = structure(c(15355L, 15356L, 15357L, 15358L, 
                15359L, 15360L, 15361L, 15362L, 15363L, 15364L, 15365L, 15366L, 
                15367L, 15368L, 15369L, 15370L, 15371L, 15372L, 15373L, 15374L, 
                15375L, 15376L, 15377L, 15378L, 15379L, 15380L, 15381L, 15382L, 
                15383L, 15384L, 15385L, 15386L, 15387L, 15388L, 15389L, 15390L, 
                15391L, 15392L, 15393L, 15394L, 15355L, 15356L, 15357L, 15358L, 
                15359L, 15360L, 15361L, 15362L, 15363L, 15364L, 15365L, 15366L, 
                15367L, 15368L, 15369L, 15370L, 15371L, 15372L, 15373L, 15374L, 
                15375L, 15376L, 15377L, 15378L, 15379L, 15380L, 15381L, 15382L, 
                15383L, 15384L, 15385L, 15386L, 15387L, 15388L, 15389L, 15390L, 
                15391L, 15392L, 15393L, 15394L, 15355L, 15356L, 15357L, 15358L, 
                15359L, 15360L, 15361L, 15362L, 15363L, 15364L, 15365L, 15366L, 
                15367L, 15368L, 15369L, 15370L, 15371L, 15372L, 15373L, 15374L, 
                15375L, 15376L, 15377L, 15378L, 15379L, 15380L, 15381L, 15382L, 
                15383L, 15384L, 15385L, 15386L, 15387L, 15388L, 15389L, 15390L, 
                15391L, 15392L, 15393L, 15394L), class = "Date"), key = structure(c(1L, 
                1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
                1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
                2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
                3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 
                1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
                2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
                2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
                3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("Station1", "Station2", 
                "Temp."), class = "factor"), value = c(5277.9, 5254.8, 5207.1, 
                5177.9, 5594.7, 11665.7, 11630.8, 13472.8, 12738.1, 7970.3, 6750.3, 
                7147.2, 7013.5, 6280.1, 5879.4, 5695.1, 5570.4, 5412.1, 5199.2, 
                5007.9, 0, 0, 0, 0, 0, 0, 1600, 2100, 2100, 1199.2, 1017.6, 1076.5, 
                1054.9, 944.2, 589.2, 570.7, 558.1, 542.2, 0, 0, 46.6, 45.7, 
                46, 46.8, 46.8, 45, 45.1, 44.4, 46, 48, 49.5, 48.7, 47.3, 47.5, 
                48.6, 48.6, 49.3, 49.5, 48.6, 48.4, 5006.3, 5009.7, 5220.5, 7541.8, 
                11472.3, 12755, 13028.2, 11015.3, 7998.4, 6624, 6065.7, 5804.3, 
                6852.9, 7067.6, 7103.7, 7896.9, 7805.5, 15946.9, 17949.6, 13339.1, 
                0, 0, 0, 0, 2100, 2100, 2100, 2100, 1604.5, 996.5, 912.5, 582.3, 
                1030.7, 1063.1, 1070.2, 1188.8, 1622.6, 2100, 2100, 0, 51.8, 
                50.9, 50.2, 50.5, 51.6, 52, 50.5, 50.4, 49.6, 48.9, 50.2, 51.1, 
                51.1, 50.5, 49.5, 49.8, 49.5, 49.5, 51.6, 51.1), grp = c("Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Temp. (F)", 
                "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", 
                "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", 
                "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", 
                "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", 
                "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Flow (cfs)", "Temp. (F)", 
                "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", 
                "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", 
                "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)", 
                "Temp. (F)", "Temp. (F)", "Temp. (F)", "Temp. (F)")), class = c("tbl_df", 
                "tbl", "data.frame"), row.names = c(NA, -120L))

head(df)
#> # A tibble: 6 x 4
#>   Date       key       value grp       
#>   <date>     <fct>     <dbl> <chr>     
#> 1 2012-01-16 Station1  5278. Flow (cfs)
#> 2 2012-01-17 Station1  5255. Flow (cfs)
#> 3 2012-01-18 Station1  5207. Flow (cfs)
#> 4 2012-01-19 Station1  5178. Flow (cfs)
#> 5 2012-01-20 Station1  5595. Flow (cfs)
#> 6 2012-01-21 Station1 11666. Flow (cfs)

# base plot
gg1 <- ggplot(df, aes(Date, value)) +
  geom_line(aes(group = key, color = key), size = 1) +
  facet_grid(grp ~ ., switch = 'y', scales = 'free_y') +
  scale_color_brewer("", palette = "Dark2") +
  scale_x_date(date_breaks = "1 week", date_labels = "%d-%b") +
  labs(x = "", y = "") +
  theme_bw(base_size = 16) +
  theme(strip.placement = 'outside') +
  theme(legend.position = 'bottom') +
  theme(strip.background.y = element_blank()) +
  NULL

# define and plot the highlight period manually
dateRanges <- data.frame(
  from = as.Date(c("2012-01-20", "2012-02-11")),
  to = as.Date(c("2012-02-04", "2012-02-23"))
)

gg2 <- gg1 +
  geom_rect(data = dateRanges, 
            aes(xmin = from - 1, xmax = to, ymin = -Inf, ymax = Inf), 
            inherit.aes = FALSE,
            color = 'grey90',
            alpha = 0.2)
gg2

Создано в 2019-06-28 пакетом Представить (v0.3.0)

Ответы [ 2 ]

1 голос
/ 28 июня 2019

Что-то вроде: 

library(dplyr)
dateRanges <- df %>% 
  mutate(Date2 = lead(Date)) %>% 
  filter(key == 'Station2', value > 0 | lead(value) > 0, Date2 - Date == 1)

gg1 +
  geom_rect(data = dateRanges, 
            aes(xmin = Date, xmax = Date2, ymin = -Inf, ymax = Inf), 
            inherit.aes = FALSE,
            color = NA,
            fill = 'grey20',
            alpha = 0.2)

Проще всего нарисовать одну rect за день.

1 голос
/ 28 июня 2019

Вот способ использования dplyr и tidyr из метапакета tidyverse для создания одного прямоугольника на положительный диапазон потока Station2:

Сначала я изолирую строки потока Station2, затем фильтрую длянули до или после положительных значений, затем соберите и распределите, чтобы создать начало и конец для каждого смежного участка: 

library(tidyverse)
dateRanges <- df %>%
  filter(key == "Station2", grp == "Flow (cfs)") %>%
  mutate(from = value == 0 & lead(value, default = -1) > 0,
         to   = value == 0 &  lag(value, default = -1) > 0,
         highlight_num = cumsum(from)) %>% 
  gather(type, val, from:to) %>%
  filter(val) %>%
  select(type, Date, highlight_num) %>%
  spread(type, Date)

> dateRanges
# A tibble: 2 x 3
  highlight_num from       to        
          <int> <date>     <date>    
1             1 2012-02-10 2012-02-23
2             2 2012-01-19 2012-02-04

Обратите внимание, мои спецификации диапазона здесь немного отличаются, так как, похоже, ваши диапазоны начинаются спервое положительное значение, но продолжайте к нулю после положительного диапазона.Для моего кода вы должны построить: 

...
geom_rect(data = dateRanges, 
            aes(xmin = from, xmax = to, ymin = -Inf, ymax = Inf),
...

Редактировать # 2:

На оригинальном плакате была представлена ​​большая выборка данных, которая раскрыла два крайних случая, которые я не рассматривал,1) НС в value;легко фильтровать.2) случаи, когда один день стремится к нулю, таким образом, являясь как началом, так и концом диапазона.Один из подходов к решению этой проблемы - определить начало и конец как первое и последнее положительные значения.Код ниже, похоже, работает с большими данными. 

dateRanges <- df %>%
  filter(!is.na(value)) %>%
  filter(key == "Station2", grp == "Flow (cfs)") %>%
  mutate(positive = value > 0,
         border   = positive != lag(positive, default = TRUE),
         from     = border & positive,
         to       = border & !positive,
         highlight_num = cumsum(from)) %>%
  gather(type, val, from:to) %>% 
  filter(val) %>% 
  select(type, Date, highlight_num) %>%
  spread(type, Date) %>%
  filter(!is.na(from), !is.na(to))

enter image description here

...