P.S небольшое предупреждение по выбору цветов на графиках:

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

Задача

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

В данном проекте я планирую выявить одну из значимых зон уязвимости удержания сотрудников компании, чтобы предложить своё решение по удержжанию сотрудников направления “R&D” для компании, специализирующейся именно в этом направлении. Я подозреваю, что компаниия около-фармацевтическая, но на анализе это не отражается. Более подробную информацию предоставлю в следующих частях работы.

Анализ

Данные и логика анализа

Эта часть отчета посвящана изучению структуры оттока сотрудников в компании в зависимости от характеристик самой компании и рассматриваемых сотрудников. Анализ я предполагаю организовать по приниципу “воронки”, так как начинаю с департаментов компании, а заканчиваю показателями портфолио сотрудников, как предикторов оттока.

Подключение к базе данных и загрузка соответствующих пакетов

library(tidyverse)
library(plotly)
library(DBI)
library(RMariaDB)
library(tidymodels)
library(rpart.plot)
con <- dbConnect(RMariaDB::MariaDB(), 
                 user='studentminor', 
                 password='DataMinorHSE!2020', 
                 dbname='employee', 
                 host='34.88.193.134',
                 port = 3306)
dbListTables(con)
## [1] "education" "portfolio" "profile"

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

attr_complete = dbGetQuery(con, "SELECT Attrition, COUNT(*) AS n FROM portfolio GROUP BY Attrition")
attr_complete = attr_complete %>% mutate( Attrition = ifelse(Attrition==0, 'Остался', 'Ушел')) 
plot_ly(attr_complete, x = ~as.factor(Attrition), y = ~as.numeric(n), marker = list(color = c("rgb(153, 0, 0)", "rgb(192, 192, 192)"), line = list(color = "rgb(20, 20, 20)"), opacity = 0.8, width = 2),
            type = 'bar') %>% 
  layout(title = "Отток сотрудников компании",
         xaxis = list(title = "Статус"),
         yaxis = list(title = "Кол-во"))

Немного о выборе исследуемого департамента

Можем увидеть всего три департамента и абсолютное превосходство R&D по количеству сотрудников в базе. Из этого графика сразу понятно, что HR отдел на данном этапе я рассматривать уже не буду - он не является определяющей частью основной деятельности компании. Кроме этого, отчеты данного характера, скорее всего, разрабатываются сотрудниками отдела кадров, поэтому они могут обойтись своими знаниями о своём небольшом отделе, оперативно решать проблемы на микро-уровне. Отдел продаж тоже отпадает, несмотря на относительно схожие пропорции уходящих к остающимся – всё же сфокусируюсь на работниках, приносящих основные результаты своими исследованиями и разработками.

attr_by_dep = dbGetQuery(con, "SELECT Attrition, Department, COUNT(*) as n FROM portfolio GROUP BY Attrition, Department")
attr_by_dep = attr_by_dep %>% mutate( Attrition = ifelse(Attrition==0, 'Остался', 'Ушел')) 
plot_ly(attr_by_dep, x = ~as.factor(Department), y = ~as.numeric(n), color = ~as.factor(Attrition),
            colors = c("#C0C0C0", "#990000"), 
            type = 'bar', hoverinfo = 'y', opacity = 0.8) %>% 
  layout(title = "Отток сотрудников компании в департаментах",
         xaxis = list(title = "Департамент"),
         yaxis = list(title = "Кол-во"))

Изучение выбранного департамента для выявления портрета исследуемого сотрудника

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

В случае с возрастом сотрудников, статистическая мода в районе 33-35 лет при прочих равных условиях. То есть в компании можно встретить людей среднего с большей вероятностью, чем пожилых. А пожилых с большей вероятностью, чем совсем молодых сотрудников в возрасте до 25 лет.

age_data = dbGetQuery(con, "SELECT Age, Attrition, COUNT(*) AS n 
                            FROM profile INNER JOIN portfolio USING(EmployeeNumber)
                       GROUP BY Age, Attrition")
age_data = age_data %>% mutate( Attrition = ifelse(Attrition==0, 'Остался', 'Ушел')) 
plot_ly(age_data, x = ~as.factor(Age), y = ~as.numeric(n), color = ~as.factor(Attrition),
            colors = c("#C0C0C0", "#990000"),
            type = 'bar', hoverinfo = 'y', opacity = 0.8) %>% 
  layout(title = "Отток сотрудников компании по возрасту",
         xaxis = list(title = "Возраст"),
         yaxis = list(title = "Кол-во"))

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

exp_data = dbGetQuery(con, "SELECT TotalWorkingYears, Attrition, COUNT(*) AS n 
                            FROM profile INNER JOIN portfolio USING(EmployeeNumber)
                       GROUP BY TotalWorkingYears , Attrition")
exp_data = mutate(exp_data, Attrition = ifelse(Attrition==0, 'Остался', 'Ушел')) 

plot_ly(exp_data, x = ~as.factor(TotalWorkingYears), y = ~as.numeric(n), color = ~as.factor(Attrition),
            colors = c("#C0C0C0", "#990000"),
            type = 'bar', hoverinfo = 'y', opacity = 0.8) %>% 
  layout(title = "Отток сотрудников компании по опыту работы",
         xaxis = list(title = "Стаж"),
         yaxis = list(title = "Кол-во"))
yrs_data = dbGetQuery(con, "SELECT YearsAtCompany, Attrition, COUNT(*) AS n 
                            FROM portfolio
                       GROUP BY YearsAtCompany , Attrition")
yrs_data = mutate(yrs_data, Attrition = ifelse(Attrition==0, 'Остался', 'Ушел')) 
plot_ly(yrs_data, x = ~as.factor(YearsAtCompany), y = ~as.numeric(n), color = ~as.factor(Attrition),
            colors = c("#C0C0C0", "#990000"),
            type = 'bar', hoverinfo = 'y', opacity = 0.8) %>% 
  layout(title = "Отток сотрудников компании по количеству лет в компании",
         xaxis = list(title = "Кол-во лет в данной компании"),
         yaxis = list(title = "Кол-во"))

Выбор исследуемой группы сотрудников

Как-то быстро я перешел к выбору группы сотрудников. Такое решение обусловлено тем, что, исходя из моего опыта работы с данной базой данных, сильная конкретизация приводит к потере большей части всех наблюдений, а это приводит к selection bias. То есть мне лучше выделить не сильно узкую группу, чтобы можно было получить более интересные взаимосвязи из обучаемой модели. По этой причине, решил извлечь сотрудников исходя из их департамента, возраста и количества лет в компании. То есть была отобрана группа более молодых сотрудников департамента R&D в возрасте до 35 лет и опытом работы в рассматриваемой компании не превышающем 9 лет. Решил работать с количеством лет в компании, вместо общего стажа, так как они очень похожи по структуре, но решения сотрудников об уходе с места работы могут скорее быть обусловлены не предыдущим опытом, а самым настоящим и самым актуальным.

Почему именно эта группа?

  • Исходя из моего анализа группы сотрудников R&D в возрасте до 35 лет, наблюдается отсутствие текучести кадров среди тех, кто работает в компании 10 лет и больше. А возрастную границу в 35 лет я выбрал из-за сконцентрированности опытов сотрудников до десяти лет - то есть они с большей вероятностью не старше 35 лет, но данную гипотезу я не проверял количественно (исходил из интуиции и здравого смысла).
data_rd = dbGetQuery(con, "SELECT Age, Education, Gender, MaritalStatus, NumCompaniesWorked, WorkLifeBalance, DistanceFromHome, Attrition, BusinessTravel, EnvironmentSatisfaction, JobInvolvement, JobRole, JobSatisfaction, MonthlyIncome, OverTime, PercentSalaryHike, PerformanceRating, RelationshipSatisfaction, TrainingTimesLastYear, YearsAtCompany, YearsInCurrentRole, YearsSinceLastPromotion, YearsWithCurrManager, EducationField
FROM profile INNER JOIN portfolio USING(EmployeeNumber)
             INNER JOIN education USING(EduFieldID)
WHERE (Age <= 35 AND Department = 'Research & Development' AND YearsAtCompany<10)")

Отток сотрудников в выбранной группе

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

attr_d = data_rd %>% count(Attrition) %>% mutate(Attrition = ifelse(Attrition==0, 'Остался', 'Ушел')) 
plot_ly(attr_d, x = ~as.factor(Attrition), y = ~as.numeric(n), marker = list(color = c("rgb(192, 192, 192)", "rgb(153, 0, 0)"), line = list(color = "rgb(20, 20, 20)"), opacity = 0.8, width = 2),
            type = 'bar') %>% 
  layout(title = "Отток сотрудников R&D",
         xaxis = list(title = "Статус"),
         yaxis = list(title = "Кол-во"))

Потенциальные переменные для дальнейшего анализа перед обучением модели

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

“Академический состав чаще работает больше остальных, но при этом получает относительно низкие заработные платы.”

Я смог подтвердить данную гипотезу, изучив показатели оттока среди тех, кто работает больше положеного, и выяснил одну интересную деталь – среди работающих много можно заметить практически равное соотношение покидающих компанию и остающихся в ней. Но этого было недостаточно, и для поиска ответа я решил проверить насколько отток и факт сверхнагрузки значительно выражены среди людей различных специальностей. Таким образом, я смог выяснить высокую степень оттока и работы больше положенного среди ученых-исследователей и сотрудников лабораторий. Следующим шагом стала проверка медианных доходов сотрудников различных департаментов и специальностей - здесь я выявил, что медианы месячных доходов представлены в отношении R&D<HR<Sales, а средние показатели R&D<Sales<HR. Кроме этого, сотрудники, упомянутых в предыдущем предложении специальностей, получают в 2-2.5 раза меньше среднего показателя по компании и в заметно меньше сотрудников других должностей и специльностей в рамках своего департамента. То есть моя гипотеза скорее верна.

over = data_rd %>% count(OverTime, Attrition) %>% mutate( Attrition = ifelse(Attrition==0, 'Остался', 'Ушел')) %>% mutate(OverTime = ifelse(OverTime == 'Yes', 'Перегружен', 'Нет')) 
plot_ly(over, x = ~as.factor(OverTime), y = ~as.numeric(n), color = ~as.factor(Attrition),
            colors = c("#C0C0C0", "#990000"),
            type = 'bar', hoverinfo = 'y', opacity = 0.8) %>% 
  layout(title = "Отток сотрудников компании по факту большей загруженности",
         xaxis = list(title = "Статус перегруженности"),
         yaxis = list(title = "Кол-во"))
data = data_rd %>% count(OverTime, JobRole) %>% filter(OverTime == 'Yes') %>% select(-OverTime) %>% arrange(-n)
data1 = data
library(ggplot2)
data[3:6,1] = c('','','', '')



# Compute percentages
data$fraction <- data$n / sum(data$n)

# Compute the cumulative percentages (top of each rectangle)
data$ymax <- cumsum(data$fraction)

# Compute the bottom of each rectangle
data$ymin <- c(0, head(data$ymax, n=-1))

# Compute label position
data$labelPosition <- (data$ymax + data$ymin) / 2


# Compute a good label
data$label <- paste0(data$JobRole)

# Make the plot
ggplot(data, aes(ymax=ymax, ymin=ymin, xmax=4, xmin=3, fill=data1$JobRole)) +
  geom_rect() +
  geom_text( x=2, aes(y=labelPosition, label=label),color = 'black', size=3) + # x here controls label position (inner / outer)
  scale_fill_brewer(palette= 'Reds') +
  scale_color_brewer(palette=2) +
  coord_polar(theta="y") +
  xlim(c(-1, 4)) +
  theme_void() +
  theme(legend.position = "none") +  labs(title= "Доля специлистов R&D с фактом наличия доп.часов работы")

ddata = data_rd %>% dplyr::select(JobRole, Attrition) %>% count(JobRole, Attrition) %>% mutate(Attrition = ifelse(Attrition==0, 'Остался', 'Ушел')) 

plot_ly(ddata, x = ~as.factor(JobRole), y = ~as.numeric(n), color = ~as.factor(Attrition),
            colors = c("#C0C0C0", "#990000"),
            type = 'bar', hoverinfo = 'y', opacity = 0.8) %>% 
  layout(title = "Отток сотрудников компании в зависимости от должности",
         xaxis = list(title = "Специальности"),
         yaxis = list(title = "Кол-во"))

Модель

На данную часть я потратил много времени, так как было сложно подобрать интерпретируемый алгоритм с более-менее адекватной разностью точностей в выборках и самой высокой точностью на тестовой. Сначала хотел действовать в соотвествии с различными научными статьями. Вот пример https://www.sciencedirect.com/science/article/abs/pii/S0957417410007621 одной из таких статей, где используется подход случайного леса. Чаще всего, эти статьи основывались на ансамблях моделей, но с ансамблями у меня сложилось не очень успешно, и я решил остановиться на деревьях решений в силу большей интерпретируемости и более адекватных значений точности, чем с помощью логит-модели.

Преобразование и предобработка данных для построения модели

Модель требует факторную зависимую переменную и факторные фичи (вместо строковых).

data_rd$Attrition = as.factor(data_rd$Attrition)
data_model = data_rd %>% mutate_if(is.character, as.factor) 
set.seed(10100)
split = initial_split(data_model, prop = 0.8)
attr.test = testing(split)
attr.train = training(split)

Модель деревьев решений

Из построенного дерева мы можем увидеть самый важный предиктор (OverTime) и прескриптивные паттерны алгоритма. Кроме переменной OverTime переменной, в топ-5 самых значимых предикторов вошли месячная заработная плата, специальность, удовлетворенность окружением и опыт работы в компании. Все эти пять переменных были выявлены и в разведывательном анализе, но модель позволила подтвердить мои ожидания и помогла найти еще 5 потенциально важных переменных (YearsInCurrentRole, JobInvolvement, YearsWithCurrentManager, PerformanceRating, PercentSalaryHike).

tree <- decision_tree(
  mode = "classification") %>%
  set_engine("rpart")

tree.wf <- workflow() %>% 
  add_model(tree) %>% 
  add_formula(Attrition ~.) %>% 
  fit(data = attr.train)

rpart.plot(tree.wf$fit$fit$fit)

Результаты предсказаний модели на обучающей и тестовой выборках

Исходя из результатов обучения и предсказания, можно увидеть, что на тестовой выборке модель достигает точности в 86%, в то время как на обучающей 79% - не game changer, но для вывода об адекватности модели можно считать шагом вперед. Sensitiviy в тестовой и обучающей выборках равны 85% и 92%, а specificity равна 65%. В целом, необходимые условия выполняются и критической несбалансированности в выборке не наблюдается, а значит можем дальше работать с этой моделью.

Симуляция

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

Пошаговая стратегия

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

Почему именно ожидается такое смещение в отношении сотрудников?

  • Мне кажется, что именно что-то связанное с оборудованием создает “bottlenecks” в исследовательском процессе. Представьте на долю секунду, что вы пользуетесь компьютером 2002 года на Windows XP в своих профессиональных целях - адские мучения, согласен :)
MedIncome = median(data_model$MonthlyIncome)
MedHike = median(data_model$PercentSalaryHike)
test.new = attr.test
test.new1 = test.new %>% mutate(EnvironmentSatisfaction = case_when(
   (JobRole %in% c('Research Scientist', 'Laboratory Technician')) & (EnvironmentSatisfaction %in% c('Low', 'Medium'))~ 'High', T~"Very High")) 
test.new_first = test.new1 %>% 
  mutate(Prediction = predict(tree.wf, test.new1)$.pred_class)
ggplot(attr.test) + geom_bar(aes(x = Attrition), alpha = 0.5) +
  geom_bar(data = test.new_first, aes(x = Prediction), alpha = 0.4, fill = "#33FF99") + labs(title= "Эффект первой политики", x = 'Статус оттока', y = 'Кол-во')

2)Повышение заработной платы людям с доходом ниже среднего на одну третью часть медианной ставки (PercentSalaryHike). Ставку определил отбирая варианты от медианной ставки до ее 25% части. Эффект пропадает где-то в районе \(r > \frac{MedianHike}{300}\). В экономическом смысле, это могут быть государственные гранты для покрытия расходов компании по выплате заработных плат потенциальных исследователей. В данной политике я учитваю именно их - Research Scientists, Laboratory Technicians.

test.new2beta = test.new1 %>% mutate(MonthlyIncome =ifelse((JobRole %in% c('Research Scientist', 'Laboratory Technician')) & (MonthlyIncome < MedIncome), MonthlyIncome*(1+MedHike/300), MonthlyIncome ))


#For Dash
value_to_pay = test.new2beta$MonthlyIncome[test.new2beta$MonthlyIncome/as.integer(test.new2beta$MonthlyIncome)  != 1]  
to_pay = sum(as.integer(value_to_pay))

#For a plot
test.new2 = test.new1 %>% mutate(MonthlyIncome =ifelse((JobRole %in% c('Research Scientist', 'Laboratory Technician')) & (MonthlyIncome < MedIncome), as.integer(MonthlyIncome*(1+MedHike/300)), MonthlyIncome ))

test.new_second = test.new2 %>% mutate(Prediction = predict(tree.wf, test.new2)$.pred_class)

ggplot(attr.test) + geom_bar(aes(x = Attrition), alpha = 0.5) +
  geom_bar(data = test.new_second, aes(x = Prediction), alpha = 0.4, fill = "#33FF99") + labs(title= "Достигнутый результат: эффект второй политики", x = 'Статус оттока', y = 'Кол-во')

  1. Повышение З/П сотрудникам c вовлеченностью в процессе равной “low” и опытом работы в данной компании от одного года по сложной процентной ставке 5% в степени равной количеству лет с прошлого повышения. Это было бы поощрением за хорошую работу и компенсацией средней мировой инфляции за период без повышений.
test.new3 = test.new2 %>% mutate(MonthlyIncome =ifelse((YearsAtCompany>0) & (YearsSinceLastPromotion>0) & (JobInvolvement!='Low'), as.integer(MonthlyIncome*(1.05)^YearsSinceLastPromotion), MonthlyIncome))

test.new_third= test.new3 %>% 
  mutate(Prediction = predict(tree.wf, test.new3)$.pred_class)
  1. Релокация сотрудников из отдаленных районов в радиус шести миль.
test.new5 = test.new3 %>% mutate(DistanceFromHome = ifelse(DistanceFromHome>6, 6, DistanceFromHome))

test.new_fifth = test.new5 %>% 
  mutate(Prediction = predict(tree.wf, test.new5)$.pred_class)

Дэшборд

Общая структура:

  • 3 поля с информацией о сотрудниках исследуемой мною подгруппы
    • Департамент
    • Верхняя граница опыта работы в данной компании
    • Разница между относительными показателями оттока сотрудников (%)
  • 2 графика, относящихся к идентификации проблемной зоны
    • Интерактивный Bar Chart с тремя изменяемыми параметрами (должность, факт ухода и количество наблюдений на графике – чекбокс, фильтр и слайдер)
    • Pie Chart с пропорциями различных должностей среди работающих много (только два департамента выделены цветом) под
  • 3 поля со значениями, относящимся к рекоменудемым решениям и достигнутыми на симуляции результатами
    • Результат сокращения оттока после первой политики
    • Количество денег, требуемых для выплат во второй политике
    • Конечный результат по сокращению оттока
init.test = attr.test %>% count(Attrition)
first.stage = test.new_first %>% count(Prediction)
fin.test = test.new_second %>% count(Prediction)
write.csv(init.test, "~/init_test.csv")
write.csv(fin.test, "~/fin_test.csv")
write.csv(first.stage, "~/first_stage.csv")
write.csv(data_model, "~/RD2021.csv")
write.csv(to_pay, 'to_pay.csv')
dbDisconnect(con)

Общие выводы

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