Байесовский фреймворк и HR задачи. Часть 2 - сеточное приближение
Продолжим наше знакомство с байесовским фреймворком в HR задачах. В прошлый раз мы делали ручной расчёт в Excel, чтобы лучше понять устройство метода в его наипростейшем варианте. Если вы не читали первую статью, то сделайте это прежде, чем продолжить. Сегодня переходим к более продвинутыми случаям и практике в R.
Представим, что перед нами стоит бизнес-задача увеличить коэффициент принятия офферов, от кандидатов. В качестве решения, мы хотим внедрить реферальную программу приёма ожидая, что она даст наиболее высокий коэффициент.
Первое, с чего должно начинаться всякое исследование, это с изучения накопленных знаний и опыта. Мы читаем с вами статью[1], в которой утверждается, что у рефералов наиболее высокий коэффициент принятия офферов и он составляет 95.2% (выборка 434 человека).
Таким образом коэффициент 95.2% становится нашим априорным знанием (prior). Это, кстати, один из способов получить prior - посмотреть другие исследования по теме, лучше всего чтобы это были мета-исследования.
Второе, чем должно продолжаться всякое исследование - это пилот. Мы запускаем тестово нашу реферальную программу и собираем такие данные, что из 20 рефералов 15 в итоге приняли оффер, то есть 75% - это наша наблюдаемая вероятность (likelihood).
Третье, что нам осталось сделать это вывести из этих данных итог - или апостериорное распределение.
В прошлой статье мы смотрели с вами на конкретные значения вероятностей, но в байесовской статистике принято мыслить распределениями, чего в Excel бы мы не достигли, но можем сделать в R. Я снова отсылаю всех интересующихся деталями к книге Джона Крушке Doing Bayesian DataAnalysis, в которой есть подробный код, описание установки требуемого ПО и гайд по R. Кроме того, нам понадобятся программы, которые приложены к книге, без труда можно скачать тут [3].
Подключаем программы из [3] и создаем сетку параметров вероятности θ (тета) от 0 до 1 с очень маленьким шагом.
source("DBDA2E-utilities.R")
source("BernGrid.R")
Theta <- seq(0, 1, length=1001)Теперь нужно ввести априорные данные (prior), можно это сделать, по-разному, но я хочу представить это тоже в виде распределения с известными нам из статьи параметрами.
#Данные из статьи n <- 434 #всего рефералов rate <- 0.9517 #коэффициент принятия офферов y <- round(n * rate) #принято офферов в людях #cчитаем для каждой θ априорную вероятность prior_dist <- Theta ^ y * (1 - Theta) ^ (n - y) #функция правдоподобия Бернулли prior <- prior_dist / sum(prior_dist) #распределние априорной вероятности
Как читать этот график? По оси X указана наша тета или искомая вероятность, а по оси Y указана вероятность наступления этой вероятности. Как видим мода (это в данном случае пик) равна 95.2%, как это и есть в статье, но есть ещё и возможный интервал от 93 до 97%.
Теперь подготовим данные пилота (likelihood), представим их в виде последовательности 0 (не принял оффер) и 1 (принял оффер).
#Данные пилота n_test <- 20 #всего рефералов во время пилота y_test <- 15 #в итоге приняли оффер likelihood = c(rep(0, n_test - y_test), rep(1, y_test))
Здесь мы видим, что пик, это 75%, но интервал достаточно широкий, поскольку данных мало и занимает примерно пространство вероятностей от 60% до 90%
Дело за малым, соединим наш prior и likelihood чтобы получить апостериорное распределение posterior. Для этого воспользуемся функцией BernGrid() из [3].
#Результат
posterior = BernGrid(Theta, prior, likelihood, plotType="Bars" ,
showCentTend="Mode" , showHDI=TRUE , showpD=FALSE)
И так, в итоге мы ожидаем вероятность принятия офферов равную 94%. На что ещё стоит обратить внимание - это то, что помимо точечной вероятности (в данном случае мода) указаны ещё и некие интервалы, называемые HDI.
HDI (highest density interval) - это интервал показывает 95% вероятность какую мы получим в итоге вероятность. К примеру, HDI для апостериорного распределения от 92% до 96%.
Вывод для бизнеса: при внедрении реферальной программы мы ожидаем коэффициент принятия офферов 92%-96%.
P.S. Можно обойтись без готовой функции и посчитать руками.
#Представляем данные нашего пилота с помощью функции правдоподобия Бернулли likelihood_dist <- Theta ^ y_test * (1 - Theta) ^ (n_test - y_test) #Суммируем все возможные варианты для знаменателя evidence <- sum(prior_dist * likelihood_dist) #Расчитываем по формуле Байеса - #совместную вероятность делим на все варианты posterior <- prior_dist * likelihood_dist / evidence
- Vijaya Mani. The Effectiveness of Employee Referral as a Recruitment Source
- John K. Krushke. Doing Bayesian DataAnalysis
- https://drive.google.com/file/d/1fqOrBx0Rr3URMaDBb9UlH5wbbmgI_BHC/view