21-absenteeism-work.Rmd

# Absenteeism at work {#absenteeism-work}

```{r absenteism-work, include=FALSE}
chap <- 22
lc <- 0
rq <- 0
# **`r paste0("(LC", chap, ".", (lc <- lc + 1), ")")`**
# **`r paste0("(RQ", chap, ".", (rq <- rq + 1), ")")`**

knitr::opts_chunk$set(
  tidy = FALSE, 
  out.width = '\\textwidth', 
  fig.height = 4,
  warning = FALSE
  )

options(scipen = 99, digits = 3)

# Set random number generator see value for replicable pseudorandomness. Why 76?
# https://www.youtube.com/watch?v=xjJ7FheCkCU
set.seed(76)
```


The high competitiveness in the market, professional development combined with the development of organizations and the pressure to reach increasingly audacious goals, create increasingly overburdened employees and end up acquiring some disturbance in the state of health related to the type of work activity, including depression considered the evil of the 21st century. Taking employees to absenteeism. Absenteeism is defined as absence to work as expected, represents for the company the loss of productivity and quality of work. 

The data set has been taken from [UCI - Absenteeism at work](https://archive.ics.uci.edu/ml/datasets/Absenteeism+at+work#).  The database used has 21 attributes and 740 records from documents that prove that they are absent from work and was collected from January 2008 to December 2016.

## Data reading
  
```{r include=FALSE}
if(!require(tidyverse)) install.packages("tidyverse")
if(!require(DataExplorer)) install.packages("DataExplorer")
if(!require(ggthemes)) install.packages("ggthemes")
if(!require(grid)) install.packages("grid")
if(!require(gridExtra)) install.packages("gridExtra")
if(!require(factoextra)) install.packages("factoextra")
if(!require(FactoMineR)) install.packages("FactoMineR")
```

```{r}
library(tidyverse)
library(DataExplorer)
library(ggthemes)
library(grid)
library(gridExtra)
library(factoextra)
library(FactoMineR)
```

```{r eval=FALSE}
absenteeism_at_work <- read_delim(na = "NA", delim = ";", col_types = cols(col = col_character()), "https://hranalytics.netlify.com/data/Absenteeism_at_work.csv")
```

```{r read_data9, echo=FALSE, warning=FALSE, message=FALSE}
absenteeism_at_work <- read_delim(na = "NA", delim = ";", col_types = cols(col = col_character()), "data/Absenteeism_at_work.csv")
```

## Basic statistics and data preparation

  **Factors are in interger format , so for the sake of analysis we have changed them to factor format.**  
```{r}
str(absenteeism_at_work)
summary(absenteeism_at_work)

# converting variables to factors

col <- c(2:5,12:17)
absenteeism_at_work_factored <- absenteeism_at_work
absenteeism_at_work_factored[col] <- lapply(absenteeism_at_work_factored[col], factor)

# converting codes to meaningful information

absenteeism_at_work_factored <- absenteeism_at_work_factored %>%
  mutate(`Reason for absence` = fct_recode(`Reason for absence`,`Infectious, parasitic diseases`="0", `Neoplasms`="1",`Diseases of the blood`="2",`Endocrine and metabolic diseases`="3",`Mental and behavioural disorders`="4",`Diseases of the nervous system`="5",`Diseases of the eye and adnexa`="6",`Diseases of the ear and mastoid process`="7",`Diseases of the circulatory system`="8",`Diseases of the respiratory system`="9",`Diseases of the digestive system`="10", `Diseases of the skin and subcutaneous tissue`="11",`Diseases of the musculoskeletal system and connective tissue`="12", `Diseases of the genitourinary system`="13",`Pregnancy, childbirth and the puerperium`="14",`Certain conditions originating in the perinatal`="15",  `Congenital malformations, deformations and chromosomal abnormalities`= "16",`Symptoms, signs and abnormal clinical  findings`="17", `Injury, poisoning and certain other consequences of external causes`= "18",`causes of morbidity and mortality`="19", `Factors influencing health status and contact with health services`="21",`patient follow-up`="22",`medical consultation`="23",`blood donation`="24", `laboratory examination`="25", `unjustified absence`="26", `physiotherapy`="27", `dental consultation`="28"))

absenteeism_at_work_factored <- absenteeism_at_work_factored %>%
  mutate(`Month of absence`= fct_recode(`Month of absence`,None="0",Jan="1",Feb="2",Mar="3",Apr="4",May="5", Jun="6",Jul="7",Aug="8",Sep="9",Oct="10",Nov="11",Dec="12") )

absenteeism_at_work_factored <- absenteeism_at_work_factored %>%
  mutate(Seasons= fct_recode(Seasons,summer="1",autumn="2",winter="3",spring="4"))

absenteeism_at_work_factored <- absenteeism_at_work_factored %>%
  mutate(Education = fct_recode(Education,highschool="1",graduate="2",postgraduate="3",`master& doctrate`="4"))

absenteeism_at_work_factored <- absenteeism_at_work_factored %>%
  mutate(`Disciplinary failure`= fct_recode(`Disciplinary failure`,No="0",Yes="1"))

absenteeism_at_work_factored <- absenteeism_at_work_factored %>%
  mutate(`Social drinker`= fct_recode(`Social drinker`,No="0",Yes="1"))

absenteeism_at_work_factored <- absenteeism_at_work_factored %>%
  mutate(`Social smoker`= fct_recode(`Social smoker`,No="0",Yes="1"))

absenteeism_at_work_factored <- absenteeism_at_work_factored %>%
  mutate(`Day of the week` = fct_recode(`Day of the week`, Monday="2", Tuesday="3", Wednesday="4", Thursday="5", Friday="6"))

```


## Data exploration
 
```{r}

p <- absenteeism_at_work_factored %>% 
  ggplot() +
  aes(x = Pet, fill = Pet) + 
  geom_bar() 

s <- absenteeism_at_work_factored %>% 
  ggplot() + 
  aes(x = Son, fill = Son) + 
  geom_bar()

SS <- absenteeism_at_work_factored %>% 
  ggplot() + 
  aes(x =`Social smoker`, fill =`Social drinker`) + 
  geom_bar() 

S <- absenteeism_at_work_factored %>% 
  ggplot() + 
  aes(x =   Seasons,fill = Seasons) + 
  geom_bar()

Day <- absenteeism_at_work_factored %>% 
  ggplot() + 
  aes(x =`Day of the week`, fill =`Day of the week`) + 
  geom_bar() 

grid.arrange(p,s, nrow = 1)
grid.arrange(SS,S, nrow = 1)
grid.arrange(Day, nrow = 1)
```

## Some more digging into the data

 **I have taken those data that consists of Absenteesim in hours that are relavent to the analysis.**  
 **The  649 obs were found to have absent with respect to total of 740 obs.**  
 
 **Here the proportion of elements of categorical variables that contribute to the target variable.**    
  **I have taken only certain variable that I thought would come in to process.**  
  
```{r}
absent <- as.data.frame(absenteeism_at_work_factored %>% dplyr::select(everything()) %>% dplyr::filter(`Absenteeism time in hours` > 0))

season1 <- as.data.frame(absent %>% dplyr::group_by(Seasons) %>% dplyr::summarise(count= n(), percent = round(count*100/nrow(absent),1)) %>% arrange(desc(count)))

season1 %>%
ggplot() + 
  aes(x= reorder(Seasons,percent), y= percent, fill = Seasons) +
  geom_bar(stat='identity') + 
  coord_flip() +
  geom_text(aes(label = percent), vjust = 1.1, hjust = 1.2) + 
  xlab('Seasons')
```

 **The attribute disciplinary failure is taken into consideration and it was found it had no obvious part on target variable. Basically all disciplinary failures resulted in zero hours absences.**
 
```{r}
disciplinary <- as.data.frame(absent %>% dplyr::group_by(`Disciplinary failure`) %>% dplyr::summarise(count= n(), percent = round(count*100/nrow(absent),1))%>% arrange(desc(count)))

disciplinary %>%
  ggplot() + 
  aes(x= reorder(`Disciplinary failure`,percent), 
      y= percent, fill = `Disciplinary failure`) + 
  geom_bar(stat='identity') + 
  coord_flip() +
  geom_text(aes(label = percent), vjust = 1.1, hjust = 1.2) + 
  xlab('Disciplinary failure')
```

## Here the various types of reasons for absence attribute is analysed

 **NOTE: The top four of them cover 50% of the resons for absence**   
     * **medical consultation**     
     * **dental consultation**     
     * **physiotherapy**    
     * **Disease of genitourinary system**    
 **The unjusitified absence amounts to 4.7% of total.**  
 
```{r, fig.width=8.6, fig.height= 8.5}
                                      

Reason <-  as.data.frame(absent %>% group_by(`Reason for absence`) %>% dplyr::summarise(count= n(), percent = round(count*100/nrow(absent),1))%>% arrange(desc(count)))

Reason %>%
ggplot() + 
  aes(x = reorder(`Reason for absence`,percent), 
      y= percent, fill= `Reason for absence`) + 
  geom_bar(stat = 'identity') + 
  coord_flip() + 
  theme(legend.position='none') +  
  geom_text(aes(label = percent), vjust = 0.5, hjust = 1.1) + 
  xlab('Reason for absence')
```

**Close to the half of employees drink alcohol(320/420), so the attempted analysis can be taken into consideration that the it can be a element that influence the target variable.**

```{r}
absent %>%
ggplot() + 
  aes(x= Age,y= `Absenteeism time in hours`,fill= `Social drinker`)+ 
  geom_bar(stat='identity',position= position_dodge()) + 
  scale_x_continuous(breaks =c(seq(20,60,5)),limits=c(20,60))

```

**Service time across hit target**
```{r}

absent %>%
ggplot() + 
  aes(x= `Service time`,
      y= `Hit target`) + 
  geom_point() + 
  geom_smooth(method = 'loess') + 
  ggtitle('Analysis of Hit target across Service time') + 
  xlab('Service time(years)') + 
  ylab('Hit target(%)')

```

**Hit target is achieved by the employees of different age segments**
```{r}

absent %>%
ggplot() + 
  aes(x= Age,y= `Hit target`) + 
  geom_point() + 
  geom_smooth(method = 'loess') + 
  labs(title='Analysis of Hit target across Age',
       x='Age',
       y='Hit target(%)')

```

**Here trend of service time across age is taken. And they have positive correlation**
```{r}

absent %>%
ggplot() + 
  aes(x= Age,y= `Service time`) + 
  geom_point() + 
  geom_smooth(method = 'lm') + 
  labs(title='Analysis of Service time across Age',
       x='Age',
       y='Service time')
```

## Principal component analysis (PCA)

A principal component analysis is used to extract the most important information from a multivariate data table and to express this information as a set of new variables called principal components. Principal component analysis (PCA) reduces the dimensionality of multivariate data, to two or three that can be visualized graphically with minimal loss of information. 

The information in a given data set corresponds to the total variation it contains. The goal of PCA is to identify directions along which the variation in the data is maximal. These directions (called also principal components) can be used to visualize graphically the data.

We will be using the FactoMineR (for computing PCA) and factoextra (for PCA visualization) packages.

The first part of this article describes quickly how to compute and visualize principal component analysis using FactoMineR and factoextra
The second part shows how to identify the most important variables that explain the variations in your data

  **Data preparation for PCA**  
```{r}
absenteeism_at_work$`Work load Average/day ` <- as.numeric(as.character(absenteeism_at_work$`Work load Average/day ` ))

d1 <- absenteeism_at_work %>%
  dplyr::select(-ID) %>%
  dplyr::select(-`Absenteeism time in hours`)

d1 <- scale(d1)  
```
**PCA**  

In the following we will produce a scree plot. The scree plot is a an analysis that shows you how many factors or components you have to retain in your factor or principal components analysis. It is a graphical representation. The assumption is that "the elbow" tells you how many factors or components you have to retain. The elbow means when the line of the graph starts to smooth up.

```{r}
pcaex <- PCA(d1,graph = F) 

#The output of the function PCA() is a list including :
print(pcaex)

#The proportion of variation retained by the principal components (PCs) can be extracted as follow :

egv1 <- get_eigenvalue(pcaex)
head(egv1[, 1:2])

#Here, 60% of the information (variances) contained in the data are retained by the first six principal components.

#The amount of variation retained by each PC is called eigenvalues. The first PC corresponds to the direction with the maximum amount of variation in the data set.
#The importance of PCs can be visualized using a scree plot :

#Plot the eigenvalues/variances against the number of dimensions

# eigen values -
egv1 <- get_eigenvalue(pcaex)
fviz_eig(pcaex,addlabels=T)
```

```{r}
# correlation of variables with PCA components-
fviz_pca_var(pcaex,col.var='red')

pcaex$var$contrib

# quality of presentation of variables in correlogram-
fviz_cos2(pcaex,choice='var',axes=1:2)

# contribution of variables to the respective principal components-
fviz_contrib(pcaex,choice='var',axes=1)
fviz_contrib(pcaex,choice='var',axes=2)
fviz_contrib(pcaex,choice='var',axes=3)
fviz_contrib(pcaex,choice='var',axes=4)
fviz_contrib(pcaex,choice='var',axes=5)
```