Usuwanie zbędnych kolumn

Ze względu na brak zróżnicowania w kolumnach ,,EmployeeCount”, “Over18” i ,,StandardHours”, usuwamy je z naszego zbioru danych.

HR <- HR %>% select(-EmployeeCount, -Over18, -StandardHours) 

Wykrycie duplikatów

Jak można zauważyć, w naszym zbiorze danych nie wykryliśmy żadnych duplikatów, czyli wszystkie dane dotyczą innych osób

duplikaty <- HR[duplicated(HR) | duplicated(HR, fromLast = TRUE), ]
duplikaty

##  [1] Age                      Attrition                BusinessTravel          
##  [4] DailyRate                Department               DistanceFromHome        
##  [7] Education                EducationField           EmployeeNumber          
## [10] EnvironmentSatisfaction  Gender                   HourlyRate              
## [13] JobInvolvement           JobLevel                 JobRole                 
## [16] JobSatisfaction          MaritalStatus            MonthlyIncome           
## [19] MonthlyRate              NumCompaniesWorked       OverTime                
## [22] PercentSalaryHike        PerformanceRating        RelationshipSatisfaction
## [25] StockOptionLevel         TotalWorkingYears        TrainingTimesLastYear   
## [28] WorkLifeBalance          YearsAtCompany           YearsInCurrentRole      
## [31] YearsSinceLastPromotion  YearsWithCurrManager    
## <0 wierszy> (lub 'row.names' o zerowej długości)

Wartości brakujące

Do identyfikacji wartości brakujących użyliśmy biblioteki naniar. Przy użyciu funkcji vis_miss oraz gg_miss_var przygotowaliśmy wizualizację brakujących danych w naszym zbiorze. Przeanalizowaliśmy również procent brakujących danych.

Każdy z powyższych kroków jest kluczowy dla uzyskania miarodajnych wartości i wiarygodnych wyników analizy.

library(naniar)
vis_miss(HR)

miss_var_summary(HR)

## # A tibble: 32 × 3
##    variable         n_miss pct_miss
##    <chr>             <int>    <num>
##  1 Attrition           150    10.2 
##  2 MonthlyIncome       150    10.2 
##  3 Age                 100     6.80
##  4 BusinessTravel        0     0   
##  5 DailyRate             0     0   
##  6 Department            0     0   
##  7 DistanceFromHome      0     0   
##  8 Education             0     0   
##  9 EducationField        0     0   
## 10 EmployeeNumber        0     0   
## # ℹ 22 more rows

gg_miss_upset(HR)

gg_miss_var(HR)

Zmienną Attrition zapisaną jako zwykły test zmieniliśmy na typ factor.

HR$Attrition <- factor(HR$Attrition, levels = c("No", "Yes"))

Imputacja danych

Do imputacji danych wykorzystaliśmy metodę wielokrotnej imputacji przy użyciu biblioteki mice. Umożliwiło nam to estymację brakujących wartości na podstawie pozostałych zmiennych oraz charakteryzujących je wzorców. Co więcej, metoda wielokrotnej imputacji jest bardziej wiarygodna niż np. bazowanie na średniej. Pozwala ona zachować naturalny rozkład danych, w tym ich zmienność.

library(mice)
HR_imputed <- mice(HR, m= 5, maxit = 50, seed = 500)
complete_data <- complete(HR_imputed)

Identyfikacja odstających danych

Do identyfikacji i wizualizacji danych odstających (outliers) użyliśmy poniższego kodu. Krok ten służy wykryciu błędów w danych lub nietypowych przypadków, które mogą zaburzyć analizę i doprowadzić nas do błędnych wniosków.

find_outliers <- function(x) {
  Q1 <- quantile(x, 0.25, na.rm = TRUE)
  Q3 <- quantile(x, 0.75, na.rm = TRUE)
  IQR <- Q3 - Q1
  lower_bound <- Q1 - 1.5 * IQR
  upper_bound <- Q3 + 1.5 * IQR
  which(x < lower_bound | x > upper_bound)
}

boxplot(complete_data$YearsAtCompany)

boxplot(complete_data$NumCompaniesWorked)

boxplot(complete_data$PerformanceRating)

boxplot(complete_data$StockOptionLevel)

boxplot(complete_data$TotalWorkingYears)

Mapa korelacji

Wykreślając mapę korelacji tworzymy macierz, która prezentuje relacje między różnymi zmiennymi numerycznymi w zbiorze danych.

Im intensywniejszy kolor, tym silniejsza jest korelacja.

Czerwień wskazuje na dodatnią korelację, niebieskie kolory oznaczają korelację ujemną, a biel/szarość oznacza brak istotnej korelacji między zmiennymi.

W celu stworzenia poniższej mapy, zmieniliśmy zmienne kategoryczne nominalne na zmienne numeryczne.

complete_data$Attrition <- ifelse(complete_data$Attrition == "Yes", 1, 0)
dane_numeryczne <- complete_data[sapply(complete_data, is.numeric)]
korelacje <- cor(dane_numeryczne, use = "complete.obs")

library(ggplot2)
library(reshape2)

mapa_korelacji <- melt(korelacje)
ggplot(data = mapa_korelacji, aes(x = Var1, y = Var2, fill = value)) +
  geom_tile() +
  scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, limit = c(-1,1), space = "Lab", name="Korelacja") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 1, size = 8, hjust = 1)) +
  coord_fixed()

library(ggplot2)
complete_data$Attrition <- ifelse(complete_data$Attrition == 1, "Yes", "No")
complete_data$OverTime <- as.factor(complete_data$OverTime)
ggplot(complete_data, aes(x = "", fill = Attrition)) +
  geom_bar(position = "fill") +  
  coord_polar(theta = "y") +  
  labs(
    title = "Procentowy udział rotacji w zależności od nadgodzin",
    fill = "Rotacja (Attrition)" ,
    x = NULL, 
    y = NULL
  ) +
  scale_y_continuous(labels = scales::percent) +  
facet_wrap(~OverTime, labeller = labeller(OverTime = c("No" = "Brak nadgodzin", "Yes" = "Nadgodziny"))) +
  theme_minimal() +
  theme(axis.text.x = element_blank(),  
        axis.text.y = element_blank(), 
        axis.ticks = element_blank(),  
        panel.grid = element_blank())

Na powyższym wykresie kołowym widzimy dane dotyczące wpływu nadgodzin na decyzję o odejściu z pracy. Wyższy odsetek osób opuszczających firmę w grupie osób z nadgodzinami może sugerować, że nadgodziny wpływają negatywnie na satysfakcję z pracy i są jedną z przyczyn jej zmiany.

library(ggplot2)
library(dplyr)

complete_data$JobRole <- as.factor(complete_data$JobRole)
complete_data$Attrition <- as.factor(complete_data$Attrition)

percent_data <- complete_data %>%
  group_by(JobRole, Attrition) %>%
  summarise(count = n(), .groups = 'drop') %>%
  group_by(JobRole) %>%
  mutate(percentage = count / sum(count) * 100)

ggplot(percent_data, aes(x = JobRole, y = percentage, fill = Attrition)) +
  geom_bar(stat = "identity", position = "stack") +
  labs(
    title = "Procentowy udział rotacji wg stanowiska pracy",
    x = "Stanowisko pracy",
    y = "Procent (%)",
    fill = "Rotacja (Attrition)"
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 7.5, face = "bold")) + 
  geom_text(aes(label = paste0(round(percentage, 1), "%")),  
            position = position_stack(vjust = 0.5), size = 3)

Z kolei następny wykres - słupkowy, ilustruje procentowy udział rotacji pracowników według stanowiska. Sales Representative (39.8%), Laboratory Technician (24.3%) oraz Human Resources (21.2%) to stanowiska z największą rotacją. Najmniejszą rotację odnotowano na stanowisku Research Directora (3.8%), stanowiskach managerskich (5.9%) oraz wśród Healthcare Representatives (7.6%).

library(ggplot2)
library(dplyr)

complete_data$Gender <- as.factor(complete_data$Gender)
complete_data$Attrition <- as.factor(complete_data$Attrition)

complete_data %>%
  group_by(Gender, Attrition) %>%
   summarise(count = n()) %>%
  mutate(percentage = count / sum(count) * 100) %>%
  ggplot(aes(x = "", y = percentage, fill = Attrition)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y", start = 0) +  
  facet_wrap(~ Gender) +  
  labs(
    title = "Płeć a rotacja",
    x = NULL,
    y = NULL,
    fill = "Rotacja (Attrition)"
  ) +
  theme_minimal() +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank()) + 
  geom_text(aes(label = paste0(round(percentage, 1), "%")),  
            position = position_stack(vjust = 0.5)) +
  scale_fill_manual(values = c("Yes" = "#ccffcc", "No" = "#9f5f9f"))  

## `summarise()` has grouped output by 'Gender'. You can override using the
## `.groups` argument.

Powyższe wykresy kołowe prezentują procentowy podział rotacji pracowników ze względu na płeć. Widzimy na nich, że z firmy odchodzi stosunkowo więcej mężczyzn (17%) niż kobiet (14.6%).

library(ggplot2)
library(dplyr)

complete_data$Age <- as.numeric(as.character(complete_data$Age))

complete_data %>%
  group_by(Age, Attrition) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(Age) %>%
  mutate(percentage = count / sum(count) * 100) %>%
  ggplot(aes(x = Age, y = percentage, fill = Attrition)) +
  geom_bar(stat = "identity", position = "fill") +
  labs(
    title = "Procentowy rozkład rotacji według wieku",
    x = "Wiek",
    y = "Procent (%)"
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 8)) +  
  scale_x_continuous(breaks = seq(min(complete_data$Age), max(complete_data$Age), by = 2)) +
  scale_fill_manual(values = c("Yes" = "#A8A8A8", "No" = "#ffebee"))

Z wykresu można zaobserwować większą tendencję do rotacji pracowników w młodszym wieku. Dodatkowo po 40 roku życia widać niewielką tendencję wzrostową rotacji, wraz ze wzrostem wieku, do około 58 roku życia.

complete_data %>%
  group_by(DistanceFromHome, Attrition) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(DistanceFromHome) %>%
  mutate(percentage = count / sum(count) * 100) %>%
  ggplot(aes(x = DistanceFromHome, y = percentage, fill = Attrition)) +
  geom_bar(stat = "identity", position = "fill") +
  labs(
    title = "Procentowy rozkład rotacji według dystansu od miejsca pracy",
    x = "Dystans od miejsca pracy",
    y = "Procent (%)"
  ) +
  theme_minimal() + 
  scale_fill_manual(values = c("Yes" = "#263238", "No" = "#e1bee7"))

Powyższy wykres obrazuje rozkład rotacji według dystansu od miejsca pracy. Większość pracowników nie decyduje się na zmianę pracy ze względu na czas dojazdu, jednak widzimy na wykresie tendencję wzrostową wraz ze wrostem liczby kilometrów oddzielających pracownika od miejsca pracy. Szczególnie zauważalne jest to dla wartości powyżej 8 km.