Ускорение риска и неожиданные перевороты

Может ли ускорение относительного риска переворота дать представление о том, когда перевороты происходят в отсутствие более широких структурных катализаторов?

Два последних переворота в мире, в Зимбабве в 2017 году и в Габоне в этом году, были неожиданными. По данным CoupCast, Габон занял 47-е место среди всех стран Африки к югу от Сахары в 2019 году с точки зрения риска переворота, а Зимбабве — 22-е место в 2017 году.

Ни одна из стран не показала особенно высоких показателей структурных факторов риска, которые CoupCast использует для оценки риска переворота, таких как ВВП на душу населения, предыдущая история переворотов, поражения на выборах действующих лиц и уровень детской смертности. Тем не менее, оба продемонстрировали микрофакторы, которые нелегко отразить в такой модели, как CoupCast.

Например, в Габоне плохое здоровье президента Али Бонго и его отсутствие в стране после того, как он перенес инсульт в октябре 2018 года, прямо приводились заговорщиками в качестве оправдания их заговора. Тем временем в Зимбабве решение Роберта Мугабе уволить Эммерсона Мнангагву в явной попытке расчистить путь своей жене Грейс Мугабе на смену ему привело в ярость военных и ускорило его увольнение.

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

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

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

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

Производные Праймер

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

Рассмотрим следующую строку. Вычислить его наклон было бы довольно просто, так как вы просто разделили бы изменение y на изменение x (подъем над пробегом). Однако, поскольку эта линия не прямая, ее наклон непостоянен; наклон намного больше на правом конце линии, чем на левом. Можно взять наклон между точками 80 и 100, чтобы получить лучшее представление о наклоне к концу линии, однако это все еще не очень конкретно.

Чтобы количественно оценить скорость изменения в каждой точке, мы просто вычисляем превышение над пробегом для каждой точки на линии, когда наш пробег приближается к нулю. Другими словами, в то время как наш наклон будет рассчитываться по следующей формуле, △y/△x, наша производная вычисляется по формуле △y/△x →0.

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

Однако это только первая производная, f′(x), известная как скорость. Взяв вторую производную, мы получим ускорение или меру того, насколько сильно скорость увеличивается или уменьшается. Учитывая поставленную выше задачу количественной оценки волатильности риска переворота, эта вторая производная, f′′(x), может показаться интересной, по крайней мере, поначалу.

Проблема масштабирования второй производной

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

Если f(x) представляет собой линию, возможно подобную приведенной выше, мы можем сказать, что f′′(x)представляет кривизну этой линии в любой заданной точке.

Однако мы также можем представить кривизну линии в формате точка-наклон следующим образом: g(x) = m(f(x)) + b. Однако, сравнивая их, мы видим, что кривизна g(x) всегда будет m раз больше, чем f′′(x).

Другими словами, масштаб того, что входит в расчет нашей второй производной, имеет значение. Вторые деривативы для страны с неизменно высоким риском переворота, такой как Гвинея-Бисау, будут завышены по отношению к стране с неизменно низким риском переворота, такой как Финляндия.

Чтобы исправить это, вместо этого мы используем так называемый коэффициент абсолютного неприятия риска Эрроу-Пратта, который рассчитывается следующим образом: — f′′(x)/f′(x).

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

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

Вычисление и тестирование производных в R

Чтобы использовать эти измерения волатильности для прогнозирования неожиданных переворотов, в качестве предварительного шага необходимо выяснить, действительно ли модели риска в странах, которые пережили неожиданные перевороты, были более волатильными, чем в странах, которые пережили ожидаемые перевороты.

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

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

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

Процесс

И. Подмена данных

Во-первых, вытягивание шести месяцев перед каждым переворотом требует определенных усилий.

reign <- read_csv("REIGN_2019_1.csv")
library(tidyverse)

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

С этой целью наш первый шаг — создать столбец дат и отфильтровать все наблюдения до 1975 года. Наблюдения до 1975 года используются в качестве начального учебного горизонта для нашей процедуры перекрестной проверки скользящего происхождения в CoupCast.

reign <- mutate(reign, 
                fecha = lubridate::make_date(year = year, 
                                             month = month))
reign <- filter(reign, 
                year > "1974")

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

deslleno <- data.frame()
tester <- reign[reign$pt_attempt==1, ]
reign$merge_id <- paste(reign$ccode, 
                        reign$country, 
                        reign$fecha, 
                        sep = "-")
for(i in 1:nrow(tester)){
  
  test2 <- tester[i, 
                 c("country", "ccode", "fecha")]
  
  lag_dates <- seq(test2$fecha, 
                   length = 7, 
                   by = "-1 month")
  country <- rep(test2$country, 
                 times = 7)
  ccode_code <- rep(test2$ccode, 
                    times = 7)
  
  sub_df <- data.frame(lag_dates, country, ccode_code)
  sub_df$merge_id <- paste(ccode_code, 
                           country, 
                           lag_dates, 
                           sep = "-")
  sub_df <- sub_df[2:7,]
  
  deslleno <- rbind(deslleno, sub_df)
}

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

В цикле мы выбираем столбцы страны, кода страны и даты наших строк и сохраняем их в новый объект. Отсюда мы создаем три вектора длины семь, которые отсчитывают семь месяцев назад (в случае столбца даты) и повторяют страну и код страны семь раз.

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

Также обратите внимание, что перед циклом for мы также пошли дальше и создали совместимый столбец ключей в наших данных REIGN.

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

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

rownames(deslleno) <- seq(1, 1446, by = 1)
deslleno$coup_id <- as.numeric("")
deslleno$coup_id[seq(1,nrow(deslleno), by = 6)] <- seq(1,241, 
                                                       by = 1)
deslleno <- deslleno %>% fill(coup_id)
deslleno$coup_id <- as.factor(deslleno$coup_id)
deslleno <- filter(deslleno, 
                   lag_dates > "1974-12-01")
with_ids <- split(deslleno, 
                 f = deslleno$coup_id)

Обратите внимание, что в приведенном выше коде нам также нужно было сбросить индекс фрейма данных, который вышел из нашего цикла, а также создать пустой числовой столбец для нашей переменной coup_id, прежде чем мы сможем добавить фактические значения в каждую шестую строку. Кроме того, перед использованием функции split() полезно отфильтровать все результирующие ключи, которые имеют даты до 1975 года, чтобы мы не отфильтровывали наблюдение без предполагаемых рисков переворота из REIGN позже.

Теперь, когда наш список списков разделен по уникальным событиям переворота, мы можем фактически отфильтровать интересующие нас наблюдения из REIGN, используя еще один цикл for.

stuff <- data.frame()
for(i in 1:length(with_ids)){
  df <- data.frame(with_ids[[i]])
  df1 <- reign[reign$merge_id %in% df$merge_id, ]
  id_value <- unique(df$coup_id)
  df1$coup_id <- id_value
  
  stuff <- rbind(stuff, df1)
}

В приведенном выше цикле мы извлекаем каждый элемент из нашего списка списков и преобразовываем их во фреймы данных, объект df. Отсюда мы затем фильтруем интересующие нас наблюдения из REIGN, используя ключи из каждого элемента в нашем списке, прежде чем добавлять наши coup_id переменных и сохранять все это в пустом фрейме данных, созданном вне нашего цикла.

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

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

grouped_id <- group_by(stuff, coup_id) %>% 
              mutate(mean_pctile = mean(pctile_risk)) %>% 
              ungroup()
id_ranks <- grouped_id[!duplicated(grouped_id$coup_id),]
id_ranks <- id_ranks[order(id_ranks$mean_pctile, 
                           decreasing = T),]

Выше мы группируем по каждому coup_id, создаем новый столбец со средним процентильным риском, а затем разгруппируем, чтобы сохранить ту же структуру наших данных.

Затем, чтобы создать ранги, мы отбрасываем каждый дубликат coup_id, чтобы каждый был только один, и упорядочиваем наши mean_pctile, чтобы увидеть, какие события переворота имели самый высокий средний процентиль за шесть месяцев, предшествовавших каждому перевороту.

Затем мы можем взять верхние и нижние пятнадцать наблюдений из нашего упорядоченного рейтинга, а затем отфильтровать конкретные события переворота, которые мы хотим, из нашего grouped_id фрейма данных, используя значения coup_id. (Одним примечанием является то, что n = 16 в функции head() не является опечаткой, как мы увидим позже, нам придется отбросить одно из событий переворота, потому что оно содержит данные только за два месяца).

top_ranks <- head(id_ranks$coup_id, n = 16)
bottom_ranks <- tail(id_ranks$coup_id, n = 15)
top_risk <- grouped_id[grouped_id$coup_id %in% top_ranks, ]
bottom_risk <- grouped_id[grouped_id$coup_id %in% bottom_ranks, ]
top_risk$coup_id <- factor(top_risk$coup_id, 
                           levels = unique(top_risk$coup_id))
bottom_risk$coup_id <- factor(bottom_risk$coup_id, 
                              levels = unique(bottom_risk$coup_id))

Последняя небольшая задача — сбросить количество уровней для наших coup_id переменных. Поскольку переворотов было 241, для coup_id существует 241 уровень, несмотря на то, что мы отфильтровали только 15 уникальных значений coup_id.

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

II. Анализ данных

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

ap_deriv <- function(first_deriv, second_deriv){
  neg_accel = second_deriv * -1
  ap_coef = neg_accel / first_deriv
  return(ap_coef)
}
spl_deriv <- function(time, risk){
  spl = smooth.spline(time, risk)
  velocity = predict(spl, deriv = 1)
  acceleration = predict(spl, deriv = 2)
  arrow_pratt = ap_deriv(velocity$y, acceleration$y)
  df = data.frame(risk, velocity$y, acceleration$y, jerk$y, arrow_pratt)
  return(df)
}

Наша первая функция, ap_deriv(), вычисляющая коэффициенты Эрроу-Пратта, имеет на входе первую и вторую производные и, по сути, представляет собой версию математической формулы, которую мы видели ранее, в R-коде.

Наша вторая функция, spl_deriv, использует время и риск переворота в качестве входных данных и происходит довольно много.

Сначала он берет два входных параметра и использует их для создания кубического сглаживающего сплайна с помощью функции smooth.spline().

Здесь следует отметить, что перед вычислением производных необходимо сгладить наши данные, чтобы каждая точка была дифференцируемой. После этого мы берем наш результирующий объект spl и используем его в функции predict() для вычисления наших производных, используя аргумент deriv = n, где n — это желаемый порядок производной.

Используя этот подход, мы вычисляем первую и вторую производные вместе с нашими коэффициентами Эрроу-Пратта и помещаем все это во фрейм данных вместе с исходными значениями риска переворота.

С помощью этих определенных функций мы можем эффективно вычислять наши коэффициенты Эрроу-Пратта, используя другой цикл. Для этого мы снова можем использовать функцию split() для наших фреймов данных top_risk и bottom_risk для создания списков списков на основе значений coup_id.

top_risk <- split(top_risk, f = top_risk$coup_id)
top_risk <- top_risk[-10] 
bottom_risk <- split(bottom_risk, f = bottom_risk$coup_id)

В приведенном выше коде мы удаляем десятый элемент из нашего списка top_risk, поскольку он содержит переворот в Португалии в марте 1975 года, который включает данные только за январь и февраль этого года (для работы функции smooth.spline() требуется как минимум четыре точки данных).

Имея полученные списки, довольно просто пройтись по ним с помощью нашей функции spl_deriv(), используя в качестве входных данных количество строк для каждого элемента и риск переворота.

tops <- data.frame()
for(i in 1:length(top_risk)){
  df <- data.frame(top_risk[[i]])
  derivs <- spl_deriv(rownames(df), df$couprisk)
  
  tops <- rbind(tops, derivs)
}
bottoms <- data.frame()
for(i in 1:length(bottom_risk)){
  df <- data.frame(bottom_risk[[i]])
  derivs <- spl_deriv(rownames(df), df$couprisk)
  
  bottoms <- rbind(bottoms, derivs)
}

Наши результирующие кадры данных tops и bottoms содержат риски переворота, первые производные, вторые производные и коэффициенты Эрроу-Пратта для каждого нашего события переворота.

Так в чем же должна быть разница? Ускорение, реализованное с помощью этих коэффициентов Эрроу-Пратта, может кое-что сказать нам о потенциальном риске переворота в странах с более низким уровнем риска, если мы увидим статистически значимую разницу между двумя группами.

Более конкретно. Мы считаем, что ускорение должно быть выше перед неожиданными событиями переворота. Мы используем t-критерий, чтобы увидеть, значительно ли коэффициенты выше, чем набор событий переворота, которые были оценены как имеющие высокий риск.

t.test(bottoms$arrow_pratt, tops$arrow_pratt, 
       alternative = "greater", 
       var.equal = F)

В то время как средние коэффициенты Эрроу-Пратта для нашей выборки событий переворота с наименьшим и наибольшим риском составляют 2,46 и -2,64 соответственно, p-значение для нашего t-критерия равно 0,127.

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

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

Что это означает?

Каковы последствия этого результата? Обе выборки искажены несколькими большими выбросами (эти экстремальные значения являются результатом первых производных, которые очень близки к нулю), что может увеличить вероятность ошибок типа II или ложноотрицательных результатов.

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

Из-за этих выбросов, ненормальности наших выборок и небольшого размера выборки результаты нашего t-критерия не следует рассматривать как истину (и в целом p-значения не следует рассматривать таким образом).

Одним из очевидных способов улучшить наш подход было бы увеличение размера выборки или просто использование всех наших 241 попыток государственного переворота. Однако, поскольку CoupCast довольно точен, за шесть предыдущих месяцев было очень мало попыток переворота с низким процентилем среднего риска.

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

Здесь также следует отметить, что для этого типа исследовательского анализа нет шаблона, и поэтому наш подход здесь больше искусство, чем точная наука.

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

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

Наш t-тест здесь, возможно, лучше всего рассматривать как небольшое опускание пальцев ног, чтобы определить, что находится в сфере возможного.

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

Если мы неправильно интерпретируем наш t-критерий, чтобы сказать, что существует разница в средних, так что коэффициенты могут помочь нашим предсказаниям, тогда как это не так, то мы можем просто продолжить поиск волшебной пыли, которая позволит нам предсказывать неожиданные перевороты. .

Однако, если мы правы, это может принести огромную пользу CoupCast и сообществам, которые пытаются либо предотвратить, либо смягчить последствия переворотов. Учитывая этот компромисс, имеет смысл продолжать смотреть, куда ведет эта кроличья нора. Следите за обновлениями в саге Arrow-Pratt.