Рецессия и DataScience 💪🧠

Краткое повторение ⏭

Предыдущие заметки серии:

Продолжаю серию заметок о том как определить наличие рецессии в США в режиме реального времени, а не по прошествии многих месяцев и официального объявления от профильного ведомства США. Последняя заметка изобиловала хоть и упрощенной, но академической математикой, которая меня порядком измотала. Впрочем, больше всего меня раздосадовал результат, а точнее его отсутствие: выяснилось, что простая модель логистической регрессии справляется с прогнозом лучше чем модель с переключением на основе марковских цепей.

После того как меня засосало академическое болото предыдущей заметки, возникла необходимость в использовании лебедки, которой можно бы было вытащить вопрос на траекторию рабочего решения. В качестве лебедки я буду использовать достаточно распространенную модель машинного обучения, а именно LightGBM 🤓

LightGBM - это алгоритм на основе деревьев решений с бустингом т.е. способностью определять слабые, но значимые зависимости. Подробное описание принципов работы данного алгоритма останется за рамками данной заметки.

Расчеты 🧮

Я буду использовать прежний набор библиотек, которые были в серии статей про рецессию и в дополнение с ним пакет lightgbm

library(data.table) # быстрый пакет для работы с табличными данными
library(collapse) # быстрый пакет для работы с табличными данными
library(stringi) # пакет для работы с текстовой информацией 
library(DT) # пакет создания интерактивных таблиц
library(echarts4r) # интерактивные графики
library(firatheme) # палитра, которую я использую для непрерывных индикаторов
library(emphatic) # пакет для раскрашивания матриц и табличек для наглядности 
library(lightgbm) # пакет с алгоритмом LightGBM

# Сохраняем палитру в отдельную переменную
my_pal <- palette.colors(palette = "Tableau") %>% unname()

Исходные данные были обновлены на момент написания статьи, более того, я специально ждал обновлений на конец сентября, которые расставили некоторые точки над i. Преобразования данных сделано прежним образом за исключением добавления некоторых предикторов/фич:

суффикс dn характеризует абсолютные изменения предикторов
суффикс sd3 характеризует стандартное отклонение для абсолютных изменений предикторов за три последних месяца
суффикс mn3 характеризует среднее для абсолютных изменений предикторов за три последних месяца
суффикс sd6 характеризует стандартное отклонение для абсолютных изменений предикторов за шесть последних месяца
суффикс mn6 характеризует среднее для абсолютных изменений предикторов за шесть последних месяца

Предикторы, которые связаны со значениями предыдущих периодов, должны добавить в модель возможность учитывать некоторую ретроспективу вместо того чтобы отталкиваться исключительно от моментальных значений. Это способствует больше уверенности модели и меньшей дерганности в том случае, если такие предикторы окажутся существенными.

# Загрузка подготовленных данных
indctrs0 <- fst::read_fst("data/indctrs.fst", as.data.table = TRUE)

preds <- c("PAYEMS", "INDPRO", "W875RX1", "CMRMTSPL")

rec_dt <- indctrs0  %>%  
  # Получение относительных изменений
  .[, stri_c(preds, "_ch") := lapply(.SD, \(x) shift((x - shift(x))/x)), .SDcols = preds]  %>% 
  # Получение сдвига на один период
  .[, stri_c(c(preds, stri_c(preds, "_ch")), "_lg") := lapply(.SD, shift), .SDcols = c(preds, stri_c(preds, "_ch"))] %>% 
  .[, (stri_c(preds, "_dn")) := lapply(.SD, \(x) x - shift(x)), .SDcols = preds]  %>% 
  .[, (stri_c(preds, "_sd3")) := lapply(.SD, \(x)frollapply(x, n=3, fsd)), .SDcols = (stri_c(preds, "_dn"))]  %>% 
  .[, (stri_c(preds, "_mn3")) := lapply(.SD, \(x)frollapply(x, n=3, fmean)), .SDcols = (stri_c(preds, "_dn"))]  %>% 
  .[, (stri_c(preds, "_sd6")) := lapply(.SD, \(x)frollapply(x, n=6, fsd)), .SDcols = (stri_c(preds, "_dn"))]  %>% 
  .[, (stri_c(preds, "_mn6")) := lapply(.SD, \(x)frollapply(x, n=6, fmean)), .SDcols = (stri_c(preds, "_dn"))]  %>% 
  fsubset(date > as.Date("1968-02-01") & date < as.Date("2022-01-01")) |>
  na_omit()

datatable(rec_dt[1:30], style = 'bootstrap4', extensions = 'Responsive', 
          options = list(pageLength = 6), caption = "Предикторы рецессии")

В качестве ремарки следует помнить, что каждое обновление данных на официальном сайте ФРС подразумевает не только добавление значений на новый период времени, но и ретроспективный пересмотр уже опубликованных данных, поэтому картина по прошедшему периоду может несколько меняться по мере поступления таких корректировок. Вероятна ситуация когда модель предсказывает рецессию на определенный промежуток времени, но позже поступают сведения о пересмотре данных и модель может поменять свое мнение.

Модели машинного обучение в отличие от простых моделей регрессии имеют свойство переобучаться поэтому в данном случае выборка будет разбита на две подвыборки 75%/25%, где первая предназначена для обучения модели, а вторая для тестирования (недопущения переобучения). В качестве результата будет выведен график важности предикторов:


n_rows <- fnrow(rec_dt) # количество наблюдений
indx_split <- round(n_rows*0.75) # индекс для определения обучающей выборки
split_date <- rec_dt$date[indx_split]

# Обучающая выборка данных
dtrain <- lgb.Dataset(as.matrix(rec_dt[1:indx_split, -c(1:7)]), label = rec_dt$USRECD[1:indx_split])
# Выборка данных для тестирования
dtest <- lgb.Dataset(as.matrix(rec_dt[(indx_split + 1):n_rows, -c(1:7)]), label = rec_dt$USRECD[(indx_split + 1):n_rows])

# Параметры модели
params <- list(objective = "binary", metric = "binary_error", learning_rate = 1.0)

# Моделирование
rec_lgb <- lgb.train(params = params, data = dtrain, nrounds = 80L, verbose = -1,
                   valids = list(test = dtest), early_stopping_rounds = 10L)

lgb.importance(rec_lgb , percentage = TRUE)[order(Gain)] |>
  e_chart(Feature) |> 
  e_bar(Gain) |> 
  e_bar(Cover) |> 
  e_bar(Frequency) |> 
  e_draft("InvestCookies.ru", size = "80px", opacity = 0.2) |> 
  e_title(text = "Важность предикторов (фич) для предсказания модели") |> 
  e_y_axis(name = "Процент", formatter = e_axis_formatter("percent")) |> 
  e_x_axis(name = "Предиктор", axisLabel = list(margin = -6e2)) |>
  e_legend(padding = 30) |> 
  e_flip_coords() |>
  e_color(color = my_pal)

Некоторые пояснения по различным видам важности:

Cover - количество наблюдений, связанных с предиктором
Frequency - количество расщеплений в дереве, связанных с предиктором
Gain - общая значимость предиктора

В данном случае важными предикторами оказались:

CMRMTSPL_mn6 - среднее абсолютное изменение Реальных продаж производящих отраслей за 6 месяцев
PAYEMS_mn3 - среднее абсолютное изменение Занятости, выраженной в количестве работающего персонала за 3 месяца
W875RX1_mn3 - среднее абсолютное изменение Доходов населения, исключая трансферты за 3 месяца
INDPRO_dn - абсолютное изменение Индустриального производства за прошедший период

Таким образом, все основные предикторы существенно влияют на прогнозы модели, но не в виде мгновенных значений, а в виде некоторого ретроспективного окна 3 - 6 месяцев.

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

# Функция которая считает полезные метрики модели
get_metrics <- function(dt){
  mtrx <- table(dt)
  n <- fnrow(dt)
  accuracy <- round(fsum(diag(mtrx))/n, 2)
  precision = round(diag(mtrx) / colSums(mtrx) , 2)
  recall = round(diag(mtrx) / rowSums(mtrx), 2)
  f1 = round(2 * precision * recall / (precision + recall) , 2)
  
  qDF(mtrx) |> cbind(data.frame(metrics = c("->", "->"), precision, recall, f1)) |> 
    hl(scale_color_fira(continuous = TRUE), cols = 1:2, calc_scale = "each") |>
    as_html(style = "color:White")
}

rec_dt[date > split_date] |> 
  tfm(mdl = predict(rec_lgb, as.matrix(rec_dt[date > split_date, -c(1:7)]))) %>% 
  tfm(pred = fifelse(mdl > .5, 1, 0)) |> 
  fselect(USRECD, pred) |>
  get_metrics()

      0  1 metrics precision recall   f1
0   148  0      ->      0.99   1.00 0.99
1     2 10      ->      1.00   0.83 0.91

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

В виде графика временного ряда прогноз выглядит следующим образом:

new_rec_dt <- indctrs0  %>%  
  # Получение относительных изменений
  .[, stri_c(preds, "_ch") := lapply(.SD, \(x) shift((x - shift(x))/x)), .SDcols = preds]  %>% 
  # Получение сдвига на один период
  .[, stri_c(c(preds, stri_c(preds, "_ch")), "_lg") := lapply(.SD, shift), .SDcols = c(preds, stri_c(preds, "_ch"))] %>% 
  .[, (stri_c(preds, "_dn")) := lapply(.SD, \(x) x - shift(x)), .SDcols = preds]  %>% 
  .[, (stri_c(preds, "_sd3")) := lapply(.SD, \(x)frollapply(x, n=3, fsd)), .SDcols = (stri_c(preds, "_dn"))]  %>% 
  .[, (stri_c(preds, "_mn3")) := lapply(.SD, \(x)frollapply(x, n=3, fmean)), .SDcols = (stri_c(preds, "_dn"))]  %>% 
  .[, (stri_c(preds, "_sd6")) := lapply(.SD, \(x)frollapply(x, n=6, fsd)), .SDcols = (stri_c(preds, "_dn"))]  %>% 
  .[, (stri_c(preds, "_mn6")) := lapply(.SD, \(x)frollapply(x, n=6, fmean)), .SDcols = (stri_c(preds, "_dn"))]  %>% 
  fsubset(date > as.Date("1970-01-01")) |>
  na_omit()

new_rec_dt |> 
  tfm(mdl = predict(rec_lgb, as.matrix(new_rec_dt[, -c(1:7)]))) |> 
  e_charts(date) |> 
  e_area(USRECD, symbol= 'none', lineStyle = list(width = 0), 
         name = "Период рецессии", color = "rgba(225, 87, 89, .5)") |> 
  e_line(mdl, symbol= 'none', color = my_pal[1], lineStyle = list(width = 1),
         name = "Вероятность рецессии LGB") |>
  e_datazoom(x_index = 0, type = "slider") |>
  e_title(text = "Оценка вероятности рецесии в США") |> 
  e_y_axis(name = "Вероятность рецесии", formatter = e_axis_formatter("percent")) |> 
  e_x_axis(name = "Месяц") |> 
  e_draft("InvestCookies.ru", size = "80px", opacity = 0.2) |> 
  e_legend(padding = 30) |> 
  e_tooltip(trigger = "axis", axisPointer = list(type = "line"), 
            backgroundColor = "rgba(255,255,255,0.7)", 
            formatter = e_tooltip_pointer_formatter("percent")) |> 
  e_mark_area(serie = "Период рецессии", data = list(list(xAxis = as.Date("2022-01-01"), name = "Прогноз"),
                          list(xAxis = as.Date("2022-07-01"))),
              itemStyle = list(color = my_pal[1], opacity = .2)) |> 
   e_mark_area(serie = "Вероятность рецессии LGB", data = list(list(xAxis = split_date, name = "Тест"),
                          list(xAxis = as.Date("2022-01-01"))),
              itemStyle = list(color = my_pal[2], opacity = .2))

Модель интерпретирует текущее положение как терминальное т.е. экономическая система балансирует на грани сваливания в рецессию и формально в мае 2022 рецессия состоялась и далее ситуация откатилась обратно в слабый рост. Действительно, происходящие сегодня сложно объяснить циклической динамикой. В прежние времена ФРС следовало своим внутренним протоколам и занималась контрциклическими интервенциями на рынках капитала, которые подразумевали повышения ключевой ставки при перегреве экономики и наоборот инъекции ликвидности в периоды нехватки таковой, прежде всего, на уровне банковского сектора и первичных дилеров. В настоящее время стратегия ФРС сводится к осторожному балансированию экономики возле некоторого равновесия без сваливания в откровенную рецессию, которая сулит катастрофическими проблемами на долговом рынке. Немаловажно также, что текущая геополитическая конфигурация способствует перенаправлению потоков глобального капитала на финансовые рынки США, что хорошо видно по курсу доллара США по отношению к мировым валютам. Дополнительный приток капитала, а также позитивная переоценка международной инвестиционной позиции США способствуют стабилизации ситуации на рынках капитала США, а также формированию некоторого запаса прочности в условиях нарастающего хаоса в Европе. Если ситуация будет продолжаться в том же духе, то в ближайшее время экономика США подтвердит статус тихой гавани для мирового капитала, который, теряя тапки, устремится в эту гавань с новой силой. С моей стороны логично будет перейти к модели прогноза рецессии на будущий, а не текущий период, скажем, на 6 месяцев вперед 🔮

Выводы 🍪

По традиции краткие выводы из всего написанного для широкого круга читателей:

Сочетание экономитрических методов с машинным обучением позволяет получить не только хороший прогноз, но и неплохую интерпретацию такого прогноза 🤓🥸😎
Экономика США “нырнула” в рецессии в мае 2022 года, но такой “нырок” не похож на предыдущие циклические кризисы и вероятно даже не будет квалифицирован как рецессия 🤿
Текущая геополитическая конфигурация способствует перетоку капитала в США и следовательно поддержанию статуса “тихой гавани”, что в свою очередь способствует если не экономическому процветанию, то точно экономической стабильности 🤫
Следующим этапом будет разумно заглянуть в будущее т.е. разработать модель вероятности наступления рецессии на следующие за текущим периодом 12 месяцев 🔮

Простой способ узнать о новых публикациях – подписаться на Telegram-канал:

🍪🍪🪙 InvestCookies

Краткое повторение ⏭#

Расчеты 🧮#

Выводы 🍪#

Краткое повторение ⏭

Расчеты 🧮

Выводы 🍪