Сжимаем временной ряд в светофор

«Мы сделаем вас счастливыми! Вы будете счастливыми!»
«Отроки во Вселенной» (1974)

Менеджеры в большинстве компаний хотят примерно одного и того же. Чтобы сложные вещи объяснялись простым языком, а все можно было свести к спидометрам, градусникам и светофорам.

Аллегория вполне понятная, пытаться объяснять что-либо — в 99% случаев процедура бессмысленная и энергозатратная. Поэтому ниже пример, как двумя экранами кода можно быстренько превратить временные ряды, которые почти всегда встречаются в больших количествах, в светофор.

Все предыдущие публикации.

Приступаем к процессу «осчастливливания».
Потребуются клей, бумага, скотч, и немного R.

Обычно временные ряды проглядывают на глубину 2-4 недель. Рядов может быть много, ОЧЕНЬ много и их надо как-то привести к светофорной раскраске.

Воспользуемся фактом небольшой глубины и соберем на коленке пульверизатор на основе линейной регрессии. Коэффициент $k$ нам определит цвет краски (красный/зеленый), а стат. значимость даст необходимый желтый для нестабильного поведения. Поскольку пишем на R, то никаких циклов. Базовую идею подсматриваем в книге «R for Data Science», глава «Many models».

library(tidyverse)
library(lubridate)
library(glue)
library(scales)
library(stringi)
library(jsonlite)
library(RColorBrewer)
library(extrafont)
library(hrbrthemes)
library(DBI)
library(anytime)
library(tictoc)
library(checkmate)
library(data.table)
library(ggplot2)
library(ggthemes)
library(cli)
library(gt)
library(lme4) # modeling

Подготовим 12 временных рядов. 4 с отрицательным трендом, 4 с положительным, 4 — случайные флуктуации. Период небольшой (две недели), поэтому при анализе не будем рассматривать возможную сезонность. Она просто не видна на таком периоде.

В случае, когда компактен и лаконичен, помещается на экран и оперирует только локальными данными, управляться с таким кодом и поддерживать его становится гораздо проще.

Сформируем каркасы 12 функций.

set.seed(12)
raw_df <-  1:12 %>%
  tibble(id = ., 
         k = (id - 1) %/% 4 - 1,
         b = runif(length(.), 10, 30)) %>%
  rowwise() %>%
  mutate(data = list(
    tibble(x = 0:13, y = k * runif(1, 0, 3)*x + b))
    )

Сформируем датасет в именах и значениях реальных данных.

signal_tbl <- raw_df %>%
  unnest(data) %>%
  mutate(date_msk = today() + x, 
         value = y + rnorm(nrow(.), sd = 3.5)) %>%
  mutate_at("id", as.factor)

signal_tbl %>%
  ggplot(aes(date_msk, value, group = id)) +
  geom_point() +
  facet_wrap(~id, ncol = 4)

Строим регрессию для каждого объекта (в примере датасеты никак не связаны между собой, поэтому иерархические методы тут не помогут).

lm_tbl <- signal_tbl %>%
  select(id, date_msk, value) %>%
  nest(-id) %>%
  mutate(model = map(data, ~lm(value ~ date_msk, data = .x))) %>%
  mutate(m_params = map(model, broom::tidy)) %>%
  unnest(m_params) %>%
  filter(term == "date_msk") %>%
  setDT() %>%
  .[, id_trend := fifelse(estimate < 0, 
                          "Падение показателя", 
                          "Рост показателя")] %>%
  .[p.value > 0.05, id_trend := "Достоверно неизвестно"] %>%
  as_tibble()

Рисуем внятную табличку с большими буквами.

lm_tbl %>%
  select(id, estimate, std.error, p.value, id_trend) %>%
  mutate(grp = p.value < 0.05) %>%
  arrange(desc(grp), desc(estimate)) %>%
  gt() %>%
  cols_hide(columns = grp) %>%
  fmt_number(
    columns = p.value,
    decimals = 4,
    use_seps = FALSE
  ) %>%
  data_color(
    c(estimate),
    colors = scales::col_numeric(
      c("#f87274", "white", "#63be7b"),
      na.color = "transparent",
      domain = NULL
    )
  ) %>%
  # снимем раскраску с незначимых строк
  tab_style(
    style = list(
      cell_fill(color = "white"),
      cell_text(color = "black")
      ),
    locations = cells_body(rows = p.value > 0.05)
  )

Строим финальную картинку, согласуем цвета с корпоративным брендбуком.

lm_tbl %>%
  select(id, data, estimate, id_trend) %>%
  unnest(data) %>%
  ggplot(aes(date_msk, value, colour = id_trend, group = id)) +
  geom_point(alpha = 0.8) +
  ggthemes::scale_colour_tableau() +
  geom_smooth(se = FALSE, alpha = 0.5) +
  scale_x_date(labels = scales::date_format("%d.%m"), 
               breaks = scales::date_breaks("2 days"),
               guide = guide_axis(n.dodge = 2)) +
  scale_y_continuous(labels = scales::label_percent(accuracy = 1),
                     breaks = scales::breaks_pretty(n = 3)) +
  facet_wrap(~id, ncol = 3, scales = "free") +
  theme_ipsum_rc() +
  labs(x = "Дата", y = "Показатель", colour = "Динамика")

Собственно говоря, все.

Предыдущая публикация — «Важно ли DS аналитику знать про software development?»