K-Means Clustering

Importar Bases de Datos

rh <- read.csv("/Users/anita3/Downloads/5bajas_limpia - nueva.csv")
colaboradores <- read.csv("/Users/anita3/Downloads/colaboradores_limpia.csv")

Librerias

library(foreign)
library(dplyr)         
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)      
library(psych)         
## 
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
library(corrplot)     
## corrplot 0.92 loaded
library(jtools)       
library(lmtest)       
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(car)          
## Loading required package: carData
## 
## Attaching package: 'car'
## The following object is masked from 'package:psych':
## 
##     logit
## The following object is masked from 'package:dplyr':
## 
##     recode
library(factoextra)   
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(ggfortify)    
library(ggalluvial)
library(tidyverse)
## Registered S3 methods overwritten by 'broom':
##   method            from  
##   tidy.glht         jtools
##   tidy.summary.glht jtools
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ tibble  3.1.8     ✔ purrr   0.3.4
## ✔ tidyr   1.2.1     ✔ stringr 1.4.1
## ✔ readr   2.1.3     ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%()    masks ggplot2::%+%()
## ✖ psych::alpha()  masks ggplot2::alpha()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ✖ car::recode()   masks dplyr::recode()
## ✖ purrr::some()   masks car::some()

Limpieza base de datos

Remplazar los NA en “permanencia” y “edad” por la media del puesto

Observar cuantos NA´s tenemos por columna

rh_2 <- rh_1
colSums(is.na(rh_2))
## nombre_completo       fecha_nac          genero      fecha_alta        mot_baja 
##               0               1               0               1              25 
##     permanencia            baja          puesto    departamento sal_diario_imss 
##               3              15               0               0               0 
##         colonia              CP       municipio          estado    estado_civil 
##               0               3               0               0               0 
##            edad 
##               0
class(rh_2$permanencia)
## [1] "numeric"
class(rh_2$baja)
## [1] "character"
class(rh_2$edad)
## [1] "character"
class(rh_2$sal_diario_imss)
## [1] "numeric"
rh_2$baja <- as.Date(rh_2$baja)
rh_2$edad <- as.integer(rh_2$edad)
## Warning: NAs introduced by coercion
rh_2$permanencia <- as.integer(rh_2$permanencia)

Agregar columna de mes de baja

rh_3 <- rh_2
rh_3$mes_baja <- as.numeric(format(rh_3$baja, '%m'))
rh_3
## # A tibble: 238 × 17
## # Groups:   puesto [22]
##    nombre_com…¹ fecha…² genero fecha…³ mot_b…⁴ perma…⁵ baja       puesto depar…⁶
##    <chr>        <chr>   <chr>  <chr>   <chr>     <int> <date>     <chr>  <chr>  
##  1 MARIO VALDE… 1990-0… MASCU… 2020-0… RENUNC…     628 2021-11-27 DISE�O "ADMIN…
##  2 ISABEL BARR… 1986-0… FEMEN… 2021-1… RENUNC…      60 2022-01-08 AYUDA… "PRODU…
##  3 MARIA ELIZA… 1999-0… FEMEN… 2021-1… RENUNC…      59 2022-01-08 AYUDA… "STABI…
##  4 ALONDRA ABI… 2001-0… FEMEN… 2021-1… RENUNC…      59 2022-01-08 AYUDA… "CELDA…
##  5 ERIKA ROSAL… 1993-0… FEMEN… 2021-1… RENUNC…      51 2022-01-08 AYUDA… ""     
##  6 GUADALUPE S… 1976-1… FEMEN… 2021-1… BAJA P…      37 2022-01-08 AYUDA… ""     
##  7 YOANA CRIST… 1993-0… FEMEN… 2021-1… BAJA P…      37 2022-01-08 AYUDA… ""     
##  8 CESAR ANTON… 1991-0… MASCU… 2021-1… BAJA P…      31 2022-01-08 AYUDA… ""     
##  9 ROBERTO SAE… 1972-0… MASCU… 2021-1… BAJA P…      18 2022-01-08 AYUDA… ""     
## 10 JAIME DANIE… 2003-0… MASCU… 2021-0… RENUNC…     224 2022-01-10 AYUDA… "MATER…
## # … with 228 more rows, 8 more variables: sal_diario_imss <dbl>, colonia <chr>,
## #   CP <int>, municipio <chr>, estado <chr>, estado_civil <chr>, edad <int>,
## #   mes_baja <dbl>, and abbreviated variable names ¹​nombre_completo,
## #   ²​fecha_nac, ³​fecha_alta, ⁴​mot_baja, ⁵​permanencia, ⁶​departamento
class(rh_3$permanencia)
## [1] "integer"
class(rh_3$baja)
## [1] "Date"
class(rh_3$edad)
## [1] "integer"
class(rh_3$sal_diario_imss)
## [1] "numeric"
class(rh_3$mes_baja)
## [1] "numeric"
summary(rh_3)
##  nombre_completo     fecha_nac            genero           fecha_alta       
##  Length:238         Length:238         Length:238         Length:238        
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##                                                                             
##    mot_baja          permanencia           baja               puesto         
##  Length:238         Min.   :   0.00   Min.   :2021-11-27   Length:238        
##  Class :character   1st Qu.:   9.00   1st Qu.:2022-02-25   Class :character  
##  Mode  :character   Median :  21.00   Median :2022-04-29   Mode  :character  
##                     Mean   :  77.96   Mean   :2022-04-29                     
##                     3rd Qu.:  60.00   3rd Qu.:2022-06-29                     
##                     Max.   :1966.00   Max.   :2022-08-25                     
##                     NA's   :3         NA's   :15                             
##  departamento       sal_diario_imss   colonia                CP       
##  Length:238         Min.   :144.4   Length:238         Min.   :    0  
##  Class :character   1st Qu.:180.7   Class :character   1st Qu.:66645  
##  Mode  :character   Median :180.7   Mode  :character   Median :66646  
##                     Mean   :178.0                      Mean   :64816  
##                     3rd Qu.:180.7                      3rd Qu.:66649  
##                     Max.   :500.0                      Max.   :99999  
##                                                        NA's   :3      
##   municipio            estado          estado_civil            edad      
##  Length:238         Length:238         Length:238         Min.   : 0.00  
##  Class :character   Class :character   Class :character   1st Qu.:23.00  
##  Mode  :character   Mode  :character   Mode  :character   Median :28.00  
##                                                           Mean   :30.39  
##                                                           3rd Qu.:37.00  
##                                                           Max.   :61.00  
##                                                           NA's   :1      
##     mes_baja     
##  Min.   : 1.000  
##  1st Qu.: 2.000  
##  Median : 4.000  
##  Mean   : 4.475  
##  3rd Qu.: 6.000  
##  Max.   :11.000  
##  NA's   :15

Reemplazar los NA por el mes 7

rh_4 <- rh_3
rh_4$mes_baja <- replace(rh_4$mes_baja, is.na(rh_4$mes_baja), 7)

Variables que vamos a analizar en el análisis k-means

rh_alt<-rh_4 %>% dplyr::select(sal_diario_imss, edad, permanencia, mes_baja,genero,estado_civil)
## Adding missing grouping variables: `puesto`
rh_alt
## # A tibble: 238 × 7
## # Groups:   puesto [22]
##    puesto           sal_diario_imss  edad permanencia mes_baja genero    estad…¹
##    <chr>                      <dbl> <int>       <int>    <dbl> <chr>     <chr>  
##  1 DISE�O                      500     32         628       11 MASCULINO SOLTER…
##  2 AYUDANTE GENERAL            152.    36          60        1 FEMENINO  UNION …
##  3 AYUDANTE GENERAL            152.    23          59        1 FEMENINO  CASADO…
##  4 AYUDANTE GENERAL            152.    21          59        1 FEMENINO  SOLTER…
##  5 AYUDANTE GENERAL            152.    29          51        1 FEMENINO  SOLTER…
##  6 AYUDANTE GENERAL            152.    46          37        1 FEMENINO  SOLTER…
##  7 AYUDANTE GENERAL            152.    29          37        1 FEMENINO  UNION …
##  8 AYUDANTE GENERAL            152.    31          31        1 MASCULINO UNION …
##  9 AYUDANTE GENERAL            152.    50          18        1 MASCULINO SOLTER…
## 10 AYUDANTE GENERAL            177.    19         224        1 MASCULINO SOLTER…
## # … with 228 more rows, and abbreviated variable name ¹​estado_civil

Eliminar NA´s

rh_alt<-rh_alt[-c(196, 197,200),] # 
summary(rh_alt) # no missing values
##     puesto          sal_diario_imss      edad        permanencia     
##  Length:235         Min.   :144.4   Min.   : 0.00   Min.   :   0.00  
##  Class :character   1st Qu.:180.7   1st Qu.:23.00   1st Qu.:   9.00  
##  Mode  :character   Median :180.7   Median :28.00   Median :  21.00  
##                     Mean   :178.0   Mean   :30.43   Mean   :  77.96  
##                     3rd Qu.:180.7   3rd Qu.:37.00   3rd Qu.:  60.00  
##                     Max.   :500.0   Max.   :61.00   Max.   :1966.00  
##     mes_baja         genero          estado_civil      
##  Min.   : 1.000   Length:235         Length:235        
##  1st Qu.: 3.000   Class :character   Class :character  
##  Median : 5.000   Mode  :character   Mode  :character  
##  Mean   : 4.604                                        
##  3rd Qu.: 7.000                                        
##  Max.   :11.000

Realizar Clusters

En esta sección se identificaran y visualizaran las características de clústers a traves de la metodología de K-Means Clustering de las siguientes variables:

Estimación de K-Means Clustering
- Edad
- Número de Días Laborados
- Salario Diario

Identificación de características de clústers seleccionados
- Género
- Estado Civil
- Puesto de Trabajo

Cluster 1: Analizar que edad tiene menor permanencia que el promedio.

Normalizar variables

rh_alt1 <- rh_alt
rh_alt1 <- subset(rh_alt1, permanencia>0 & permanencia<79)
rh_alt1 <- subset(rh_alt1, edad>24 & edad<38)
rh_permanencia<-scale(rh_alt1[3:4]) 
summary(rh_permanencia)
##       edad          permanencia     
##  Min.   :-1.4589   Min.   :-1.0086  
##  1st Qu.:-0.9356   1st Qu.:-0.7421  
##  Median :-0.1505   Median :-0.3598  
##  Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.8963   3rd Qu.: 0.3470  
##  Max.   : 1.6814   Max.   : 2.5138

Calcular numero optimo de clusters

fviz_nbclust(rh_permanencia, kmeans, method="wss")+ 
  geom_vline(xintercept=4, linetype=2)+           
  labs(subtitle = "Elbow method")                 

permanencia_cluster1<-kmeans(rh_permanencia,4)
permanencia_cluster1
## K-means clustering with 4 clusters of sizes 26, 9, 37, 8
## 
## Cluster means:
##         edad permanencia
## 1  0.9667615  -0.6075563
## 2  0.9544596   1.6177287
## 3 -0.7799570  -0.3672901
## 4 -0.6084407   1.8533297
## 
## Clustering vector:
##  [1] 2 4 3 3 2 3 3 1 1 1 3 3 3 3 3 3 3 1 3 1 4 4 1 3 3 3 1 3 3 1 1 3 1 1 3 3 1 3
## [39] 1 3 1 1 3 1 1 3 3 1 1 3 3 3 3 3 3 1 2 2 2 2 4 2 1 2 3 4 4 2 4 3 1 1 3 1 1 4
## [77] 3 3 3 1
## 
## Within cluster sum of squares by cluster:
## [1] 10.327682  3.140087 16.382860  4.559511
##  (between_SS / total_SS =  78.2 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Visualización de clusters

fviz_cluster(permanencia_cluster1,data=rh_permanencia)

Tabla de clusters

rh_alt_tabla<-rh_alt1
rh_alt_tabla$Clusters<-permanencia_cluster1$cluster

Identidicar la permanencia por cluster

rh_alt_tabla2<-rh_alt_tabla %>% group_by(Clusters) %>% summarise(permanencia=max(permanencia)) %>% arrange(desc(permanencia))

Agrupar los clusters por nombre

rh_alt_tabla$Cluster_Names<-factor(rh_alt_tabla$Clusters,levels = c(1,2,3,4), 
                              labels=c("Antigüedad Baja", "Antigüedad Alta", "Antigüedad Moderada", "Antigüedad Avanzada"))
rh_alt_tabla3 <- rh_alt_tabla %>% group_by(Cluster_Names,genero) %>% dplyr::summarize(permanencia_años=max(permanencia), 
                                                             edad=mean(edad),
                                                             Count=n())
## `summarise()` has grouped output by 'Cluster_Names'. You can override using the
## `.groups` argument.
clusters<-as.data.frame(rh_alt_tabla3)
clusters
##         Cluster_Names    genero permanencia_años     edad Count
## 1     Antigüedad Baja  FEMENINO               29 34.64286    14
## 2     Antigüedad Baja MASCULINO               21 33.83333    12
## 3     Antigüedad Alta  FEMENINO               60 34.50000     8
## 4     Antigüedad Alta MASCULINO               60 32.00000     1
## 5 Antigüedad Moderada  FEMENINO               37 27.15789    19
## 6 Antigüedad Moderada MASCULINO               32 28.05556    18
## 7 Antigüedad Avanzada  FEMENINO               77 28.28571     7
## 8 Antigüedad Avanzada MASCULINO               60 28.00000     1

Grafico de cluster

ggplot(rh_alt_tabla3,aes(x=reorder(Cluster_Names,Count),y=Count,fill=Cluster_Names)) +
  geom_bar(stat="identity")

Cluster 2: Analizar salario diario y permanencia

summary(rh_alt)
##     puesto          sal_diario_imss      edad        permanencia     
##  Length:235         Min.   :144.4   Min.   : 0.00   Min.   :   0.00  
##  Class :character   1st Qu.:180.7   1st Qu.:23.00   1st Qu.:   9.00  
##  Mode  :character   Median :180.7   Median :28.00   Median :  21.00  
##                     Mean   :178.0   Mean   :30.43   Mean   :  77.96  
##                     3rd Qu.:180.7   3rd Qu.:37.00   3rd Qu.:  60.00  
##                     Max.   :500.0   Max.   :61.00   Max.   :1966.00  
##     mes_baja         genero          estado_civil      
##  Min.   : 1.000   Length:235         Length:235        
##  1st Qu.: 3.000   Class :character   Class :character  
##  Median : 5.000   Mode  :character   Mode  :character  
##  Mean   : 4.604                                        
##  3rd Qu.: 7.000                                        
##  Max.   :11.000

Normalizaer variables

rh_salario<-scale(rh_alt2[4:5]) 

summary(rh_salario)
##  sal_diario_imss    permanencia     
##  Min.   :-2.8567   Min.   :-1.1201  
##  1st Qu.: 0.3499   1st Qu.:-0.7992  
##  Median : 0.3499   Median :-0.2643  
##  Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.3499   3rd Qu.: 0.7518  
##  Max.   : 0.6808   Max.   : 2.5168

Calcular numero optimo de clusters

fviz_nbclust(rh_salario, kmeans, method="wss")+ 
  geom_vline(xintercept=4, linetype=2)+           
  labs(subtitle = "Elbow method")                 

salario_cluster1<-kmeans(rh_salario,4)
salario_cluster1
## K-means clustering with 4 clusters of sizes 15, 30, 30, 64
## 
## Cluster means:
##   sal_diario_imss permanencia
## 1      -2.8567440  0.47016757
## 2       0.3281298  0.01199211
## 3       0.3353366  1.54875184
## 4       0.3585495 -0.84179425
## 
## Clustering vector:
##   [1] 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 4 4 4 4 4 4 4 3 4 4 2 2 4 4 2 2 2 4 4 4
##  [38] 2 2 3 2 4 3 3 3 2 4 3 3 3 3 2 4 4 4 2 4 4 4 4 4 4 4 2 2 4 4 4 4 4 3 2 4 4
##  [75] 4 4 2 2 4 4 4 2 4 4 4 4 2 4 4 2 4 4 4 4 4 4 4 4 4 2 2 3 3 3 3 3 3 3 4 3 3
## [112] 4 3 3 4 3 3 3 3 3 3 3 3 4 4 4 4 4 3 2 2 2 4 2 4 4 2 2 2
## 
## Within cluster sum of squares by cluster:
## [1] 8.309523 2.567639 4.603043 2.643046
##  (between_SS / total_SS =  93.4 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Grafico de cluster

fviz_cluster(salario_cluster1,data=rh_salario)

Como podemos observar el salario no es un factor que influye en la permanencia de las personas dentro de la empresa. Se encontró que las personas que tienen el mismo salario tienen la misma variabilidad que las personas que ganan menos.

Tabla de clusters

rh_alt2_tabla<-rh_alt2
rh_alt2_tabla$Clusters<-salario_cluster1$cluster

Crear dataset

rh_alt2_tabla2<-rh_alt2_tabla %>% group_by(Clusters) %>% summarise(permanencia=max(permanencia)) %>% arrange(desc(permanencia))

Agrupar y nombrar clusters

rh_alt2_tabla$Cluster_Names<-factor(rh_alt2_tabla$Clusters,levels = c(1,2,3,4), 
                              labels=c("Antigüedad Alta", "Antigüedad Moderada", "Antigüedad Avanzada", "Antigüedad Baja"))
rh_alt2_tabla3 <- rh_alt2_tabla %>% group_by(Cluster_Names,puesto) %>% dplyr::summarize(permanencia_dias=max(permanencia), 
                                                             sal_diario_imss=mean(sal_diario_imss),
                                                             Count=n())
## `summarise()` has grouped output by 'Cluster_Names'. You can override using the
## `.groups` argument.
clusters<-as.data.frame(rh_alt2_tabla3)
clusters
##          Cluster_Names                      puesto permanencia_dias
## 1      Antigüedad Alta            AYUDANTE GENERAL               60
## 2  Antigüedad Moderada       AUXILIAR DE EMBARQUES               35
## 3  Antigüedad Moderada            AYUDANTE GENERAL               41
## 4  Antigüedad Moderada                COSTURERO(A)               30
## 5  Antigüedad Avanzada       AUXILIAR DE EMBARQUES               63
## 6  Antigüedad Avanzada            AYUDANTE GENERAL               77
## 7  Antigüedad Avanzada                COSTURERO(A)               60
## 8  Antigüedad Avanzada                MATERIALISTA               64
## 9      Antigüedad Baja            AYUDANTE GENERAL               22
## 10     Antigüedad Baja                COSTURERO(A)               22
## 11     Antigüedad Baja JEFE DE SEGURIDAD E HIGIENE               18
## 12     Antigüedad Baja                   MARCADORA               14
## 13     Antigüedad Baja              MONTACARGUISTA               19
## 14     Antigüedad Baja                    SOLDADOR               16
##    sal_diario_imss Count
## 1         151.6100    15
## 2         180.6800     1
## 3         180.5983    24
## 4         179.8880     5
## 5         176.7200     1
## 6         180.6800    27
## 7         180.6800     1
## 8         180.6800     1
## 9         180.7726    54
## 10        180.6800     3
## 11        180.7000     1
## 12        180.6800     1
## 13        180.6800     1
## 14        180.6800     4

Grafico de clusters

ggplot(rh_alt2_tabla3,aes(x=reorder(Cluster_Names,Count),y=Count,fill=Cluster_Names)) +
  geom_bar(stat="identity")

Cluster 3: Analizar mes_baja (1-8) y edad

summary(rh_alt)
##     puesto          sal_diario_imss      edad        permanencia     
##  Length:235         Min.   :144.4   Min.   : 0.00   Min.   :   0.00  
##  Class :character   1st Qu.:180.7   1st Qu.:23.00   1st Qu.:   9.00  
##  Mode  :character   Median :180.7   Median :28.00   Median :  21.00  
##                     Mean   :178.0   Mean   :30.43   Mean   :  77.96  
##                     3rd Qu.:180.7   3rd Qu.:37.00   3rd Qu.:  60.00  
##                     Max.   :500.0   Max.   :61.00   Max.   :1966.00  
##     mes_baja         genero          estado_civil      
##  Min.   : 1.000   Length:235         Length:235        
##  1st Qu.: 3.000   Class :character   Class :character  
##  Median : 5.000   Mode  :character   Mode  :character  
##  Mean   : 4.604                                        
##  3rd Qu.: 7.000                                        
##  Max.   :11.000

Normalizar variables

rh_mesbaja<-scale(rh_alt3[2:3]) 

summary(rh_mesbaja)
##     mes_baja             edad        
##  Min.   :-1.68512   Min.   :-1.2349  
##  1st Qu.:-0.80017   1st Qu.:-0.8895  
##  Median : 0.08479   Median :-0.3137  
##  Mean   : 0.00000   Mean   : 0.0000  
##  3rd Qu.: 0.96974   3rd Qu.: 0.7226  
##  Max.   : 2.73964   Max.   : 3.0256

Calcular numero optimo de clusters

fviz_nbclust(rh_mesbaja, kmeans, method="wss")+ 
  geom_vline(xintercept=4, linetype=2)+           
  labs(subtitle = "Elbow method")                 

mesbaja_cluster1<-kmeans(rh_mesbaja,4)
mesbaja_cluster1
## K-means clustering with 4 clusters of sizes 66, 24, 49, 28
## 
## Cluster means:
##     mes_baja       edad
## 1  0.7887252 -0.4724990
## 2 -0.8923490  1.1736210
## 3 -0.9897991 -0.7085313
## 4  0.6378810  1.3477166
## 
## Clustering vector:
##   [1] 1 3 3 2 3 3 2 3 3 3 3 2 3 2 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 3 2 3 2 3 3 2 3
##  [38] 3 2 2 3 3 2 3 3 3 2 2 3 3 2 3 3 2 3 2 2 3 3 2 3 3 3 3 2 3 3 3 2 3 3 1 1 1
##  [75] 3 2 3 1 4 4 4 1 1 1 1 1 1 4 1 1 4 1 1 1 4 1 4 1 1 4 4 4 1 1 1 1 1 1 1 4 4
## [112] 1 1 4 4 4 4 1 4 1 1 1 4 1 4 1 4 1 4 4 1 1 1 1 4 1 1 1 1 1 1 1 1 1 1 1 1 4
## [149] 1 4 1 1 1 1 1 1 1 4 1 1 1 1 1 4 1 4 1
## 
## Within cluster sum of squares by cluster:
## [1] 35.77270 15.78750 23.85718 13.76712
##  (between_SS / total_SS =  73.1 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Visualizacion de clusters

fviz_cluster(mesbaja_cluster1,data=rh_mesbaja)

Tabla de clusters

rh_alt3_tabla<-rh_alt3
rh_alt3_tabla$Clusters<-mesbaja_cluster1$cluster

Crear data set

rh_alt3_tabla2<-rh_alt3_tabla %>% group_by(Clusters) %>% summarise(edad=max(edad)) %>% arrange(desc(edad))

Agrupar y nombrar clusters

rh_alt3_tabla$Cluster_Names<-factor(rh_alt3_tabla$Clusters,levels = c(1,2,3,4), 
                              labels=c("Adulta", "Jubilación", "Joven Adulta", "Avanzada"))
rh_alt3_tabla3 <- rh_alt3_tabla %>% group_by(Cluster_Names, estado_civil) %>% dplyr::summarize(edad=max(edad), 
                                                             mes_baja=mean(mes_baja),
                                                             Count=n())
## `summarise()` has grouped output by 'Cluster_Names'. You can override using the
## `.groups` argument.
clusters<-as.data.frame(rh_alt3_tabla3)
clusters
##    Cluster_Names  estado_civil edad mes_baja Count
## 1         Adulta     CASADO(A)   38 6.666667    21
## 2         Adulta DIVORCIADO(A)   37 7.000000     2
## 3         Adulta    SOLTERO(A)   37 6.653846    26
## 4         Adulta   UNION LIBRE   38 6.352941    17
## 5     Jubilación     CASADO(A)   61 2.833333     6
## 6     Jubilación    SOLTERO(A)   52 2.615385    13
## 7     Jubilación   UNION LIBRE   50 3.200000     5
## 8   Joven Adulta                 34 4.000000     1
## 9   Joven Adulta     CASADO(A)   33 2.538462    13
## 10  Joven Adulta    SOLTERO(A)   33 3.333333    18
## 11  Joven Adulta   UNION LIBRE   36 1.705882    17
## 12      Avanzada     CASADO(A)   54 6.428571    14
## 13      Avanzada DIVORCIADO(A)   41 5.000000     1
## 14      Avanzada    SOLTERO(A)   56 5.857143     7
## 15      Avanzada   UNION LIBRE   57 6.500000     6

Grafico de clusters

ggplot(rh_alt3_tabla3,aes(x=reorder(Cluster_Names,Count),y=Count,fill=Cluster_Names)) +
  geom_bar(stat="identity")

Relaciones Entre Variables Cuantitativas y Cualitativas

#lets plot the number of data observations by clusters names
ggplot(rh_alt_tabla3,aes(x=reorder(Cluster_Names,Count),y=Count,fill=genero)) +
  geom_bar(stat="identity")

ggplot(rh_alt2_tabla3,aes(x=reorder(Cluster_Names,Count),y=Count,fill=puesto)) +
  geom_bar(stat="identity")

#lets plot the number of data observations by clusters names
ggplot(rh_alt3_tabla3,aes(x=reorder(Cluster_Names,Count),y=Count,fill=estado_civil)) +
  geom_bar(stat="identity")

Ggalluvial

rh_alt_tabla$puesto <- as.factor(rh_alt_tabla$puesto)
rh_alt_tabla$genero <- as.factor(rh_alt_tabla$genero)
rh_alt_tabla$estado_civil <- as.factor(rh_alt_tabla$estado_civil)

rh_alt4<-rh_alt_tabla %>% dplyr::filter(Clusters==1 | Clusters==3) %>% arrange(Clusters)

ggplot(as.data.frame(rh_alt4),
       aes(y=sal_diario_imss, axis1=genero, axis2=edad)) +
  geom_alluvium(aes(fill=Cluster_Names)) +
  geom_stratum(width = 1/12, fill = "black", color = "grey") +
  geom_label(stat = "stratum", aes(label = after_stat(stratum))) +
  scale_x_discrete(limits = c("edad", "genero"), expand = c(.05, .05)) +
  scale_fill_brewer(type = "qual", palette = "Set1") +
  ggtitle("Relacion de Genero con Edad")

Principales Hallazgos

Hallazgo 1. Las personas con menos permanencia en la empresa son la principal causa de la gran catidad de bajas.

Hallazgo 2. El salario no es factor que influye en la permanencia de una persona dentro de la empresa. Se encontró que las personas que tienen el mismo salario tienen una permanencia variada al igual de los que ganan menos.

Hallazgo 3 De acuerdo al salario diario con la permanencia es contante, sin importar cuánto tiempo lleves en la empresa el salario permanece en 180 pesos diarios.

Hallazgo 4 Del grupo de edad adulta y edad avanzada el mes donde obtuvieron más bajas fue en el mes de agosto.

Hallazgo 5 Del grupo de jubilación y joven adulta el mes donde obtuvieron más bajas fue en el mes de febrero.

LS0tCnRpdGxlOiAiU0VDQ0nDk04gMyIKYXV0aG9yOiAiQW5hIFBhdHJpY2lhIEFwb250ZSAtIEEwMTI4MzkyOCIKZGF0ZTogImByIFN5cy5EYXRlKClgIgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogdHJ1ZQogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlCi0tLQoKIyA8c3BhbiBzdHlsZT0iY29sb3I6ICNGRjdGMjQiPiAqKkstTWVhbnMgQ2x1c3RlcmluZyoqIDwvc3Bhbj4KCioqSW1wb3J0YXIgQmFzZXMgZGUgRGF0b3MqKgpgYGB7cn0KcmggPC0gcmVhZC5jc3YoIi9Vc2Vycy9hbml0YTMvRG93bmxvYWRzLzViYWphc19saW1waWEgLSBudWV2YS5jc3YiKQpjb2xhYm9yYWRvcmVzIDwtIHJlYWQuY3N2KCIvVXNlcnMvYW5pdGEzL0Rvd25sb2Fkcy9jb2xhYm9yYWRvcmVzX2xpbXBpYS5jc3YiKQpgYGAKCkxpYnJlcmlhcwpgYGB7cn0KbGlicmFyeShmb3JlaWduKQpsaWJyYXJ5KGRwbHlyKSAgICAgICAgIApsaWJyYXJ5KGdncGxvdDIpICAgICAgCmxpYnJhcnkocHN5Y2gpICAgICAgICAgCmxpYnJhcnkoY29ycnBsb3QpICAgICAKbGlicmFyeShqdG9vbHMpICAgICAgIApsaWJyYXJ5KGxtdGVzdCkgICAgICAgCmxpYnJhcnkoY2FyKSAgICAgICAgICAKbGlicmFyeShmYWN0b2V4dHJhKSAgIApsaWJyYXJ5KGdnZm9ydGlmeSkgICAgCmxpYnJhcnkoZ2dhbGx1dmlhbCkKbGlicmFyeSh0aWR5dmVyc2UpCmBgYAoKIyMgTGltcGllemEgYmFzZSBkZSBkYXRvcwoKKipSZW1wbGF6YXIgbG9zIE5BIGVuICJwZXJtYW5lbmNpYSIgeSAiZWRhZCIgcG9yIGxhIG1lZGlhIGRlbCBwdWVzdG8qKgpgYGB7ciBpbmNsdWRlPUZBTFNFfQpyaF8xIDwtIHJoCnJoXzEgPC0gcmhfMSAlPiUgZ3JvdXBfYnkocHVlc3RvKSAlPiUgbXV0YXRlKHBlcm1hbmVuY2lhPWlmZWxzZShpcy5uYShwZXJtYW5lbmNpYSksIG1lYW4ocGVybWFuZW5jaWEsbmEucm09VCksIHBlcm1hbmVuY2lhKSkKCnJoXzEKYGBgCgpgYGB7ciBpbmNsdWRlPUZBTFNFfQpzdW1tYXJ5KHJoXzEpCmBgYAoKKipPYnNlcnZhciBjdWFudG9zIE5BwrRzIHRlbmVtb3MgcG9yIGNvbHVtbmEqKgpgYGB7cn0KcmhfMiA8LSByaF8xCmNvbFN1bXMoaXMubmEocmhfMikpCmBgYAoKYGBge3J9CmNsYXNzKHJoXzIkcGVybWFuZW5jaWEpCmNsYXNzKHJoXzIkYmFqYSkKY2xhc3MocmhfMiRlZGFkKQpjbGFzcyhyaF8yJHNhbF9kaWFyaW9faW1zcykKCmBgYAoKYGBge3J9CnJoXzIkYmFqYSA8LSBhcy5EYXRlKHJoXzIkYmFqYSkKcmhfMiRlZGFkIDwtIGFzLmludGVnZXIocmhfMiRlZGFkKQpyaF8yJHBlcm1hbmVuY2lhIDwtIGFzLmludGVnZXIocmhfMiRwZXJtYW5lbmNpYSkKYGBgCgoqKkFncmVnYXIgY29sdW1uYSBkZSBtZXMgZGUgYmFqYSoqCmBgYHtyfQpyaF8zIDwtIHJoXzIKcmhfMyRtZXNfYmFqYSA8LSBhcy5udW1lcmljKGZvcm1hdChyaF8zJGJhamEsICclbScpKQpyaF8zCmBgYAoKYGBge3J9CmNsYXNzKHJoXzMkcGVybWFuZW5jaWEpCmNsYXNzKHJoXzMkYmFqYSkKY2xhc3MocmhfMyRlZGFkKQpjbGFzcyhyaF8zJHNhbF9kaWFyaW9faW1zcykKY2xhc3MocmhfMyRtZXNfYmFqYSkKYGBgCgpgYGB7cn0Kc3VtbWFyeShyaF8zKQpgYGAKCioqUmVlbXBsYXphciBsb3MgTkEgcG9yIGVsIG1lcyA3KioKYGBge3J9CnJoXzQgPC0gcmhfMwpyaF80JG1lc19iYWphIDwtIHJlcGxhY2UocmhfNCRtZXNfYmFqYSwgaXMubmEocmhfNCRtZXNfYmFqYSksIDcpCmBgYAoKKipWYXJpYWJsZXMgcXVlIHZhbW9zIGEgYW5hbGl6YXIgZW4gZWwgYW7DoWxpc2lzIGstbWVhbnMqKgpgYGB7cn0KcmhfYWx0PC1yaF80ICU+JSBkcGx5cjo6c2VsZWN0KHNhbF9kaWFyaW9faW1zcywgZWRhZCwgcGVybWFuZW5jaWEsIG1lc19iYWphLGdlbmVybyxlc3RhZG9fY2l2aWwpCnJoX2FsdApgYGAKCmBgYHtyIGluY2x1ZGU9RkFMU0V9CiNiZCBjb24gbGEgcXVlIHRyYWJhamFyZW1vcyBsb3MgY2x1c3RlcnMKc3VtbWFyeShyaF9hbHQpCmBgYAoKKipFbGltaW5hciBOQcK0cyoqCmBgYHtyfQpyaF9hbHQ8LXJoX2FsdFstYygxOTYsIDE5NywyMDApLF0gIyAKc3VtbWFyeShyaF9hbHQpICMgbm8gbWlzc2luZyB2YWx1ZXMKYGBgCgojIyBSZWFsaXphciBDbHVzdGVycyAgCkVuIGVzdGEgc2VjY2nDs24gc2UgaWRlbnRpZmljYXJhbiB5IHZpc3VhbGl6YXJhbiBsYXMgY2FyYWN0ZXLDrXN0aWNhcyBkZSBjbMO6c3RlcnMgYSB0cmF2ZXMgZGUgbGEgbWV0b2RvbG9nw61hIGRlICoqSy1NZWFucyBDbHVzdGVyaW5nKiogZGUgbGFzIHNpZ3VpZW50ZXMgdmFyaWFibGVzOiAgCiAgCioqRXN0aW1hY2nDs24gZGUgSy1NZWFucyBDbHVzdGVyaW5nKiogIAotIEVkYWQgIAotIE7Dum1lcm8gZGUgRMOtYXMgTGFib3JhZG9zICAKLSBTYWxhcmlvIERpYXJpbyAgCgoqKklkZW50aWZpY2FjacOzbiBkZSBjYXJhY3RlcsOtc3RpY2FzIGRlIGNsw7pzdGVycyBzZWxlY2Npb25hZG9zKiogIAotIEfDqW5lcm8gICAKLSBFc3RhZG8gQ2l2aWwgIAotIFB1ZXN0byBkZSBUcmFiYWpvCgojIyMgQ2x1c3RlciAxOiBBbmFsaXphciBxdWUgZWRhZCB0aWVuZSBtZW5vciBwZXJtYW5lbmNpYSBxdWUgZWwgcHJvbWVkaW8uCgoqKk5vcm1hbGl6YXIgdmFyaWFibGVzKioKYGBge3J9CnJoX2FsdDEgPC0gcmhfYWx0CnJoX2FsdDEgPC0gc3Vic2V0KHJoX2FsdDEsIHBlcm1hbmVuY2lhPjAgJiBwZXJtYW5lbmNpYTw3OSkKcmhfYWx0MSA8LSBzdWJzZXQocmhfYWx0MSwgZWRhZD4yNCAmIGVkYWQ8MzgpCgpgYGAKCmBgYHtyfQpyaF9wZXJtYW5lbmNpYTwtc2NhbGUocmhfYWx0MVszOjRdKSAKc3VtbWFyeShyaF9wZXJtYW5lbmNpYSkKYGBgCgoqKkNhbGN1bGFyIG51bWVybyBvcHRpbW8gZGUgY2x1c3RlcnMqKgpgYGB7cn0KZnZpel9uYmNsdXN0KHJoX3Blcm1hbmVuY2lhLCBrbWVhbnMsIG1ldGhvZD0id3NzIikrIAogIGdlb21fdmxpbmUoeGludGVyY2VwdD00LCBsaW5ldHlwZT0yKSsgICAgICAgICAgIAogIGxhYnMoc3VidGl0bGUgPSAiRWxib3cgbWV0aG9kIikgICAgICAgICAgICAgICAgIAogICAgICAgICAgIApgYGAKCmBgYHtyfQpwZXJtYW5lbmNpYV9jbHVzdGVyMTwta21lYW5zKHJoX3Blcm1hbmVuY2lhLDQpCnBlcm1hbmVuY2lhX2NsdXN0ZXIxCmBgYAoKKipWaXN1YWxpemFjacOzbiBkZSBjbHVzdGVycyoqCmBgYHtyfQpmdml6X2NsdXN0ZXIocGVybWFuZW5jaWFfY2x1c3RlcjEsZGF0YT1yaF9wZXJtYW5lbmNpYSkKYGBgCgoKIyMjIyBUYWJsYSBkZSBjbHVzdGVycwpgYGB7cn0KcmhfYWx0X3RhYmxhPC1yaF9hbHQxCnJoX2FsdF90YWJsYSRDbHVzdGVyczwtcGVybWFuZW5jaWFfY2x1c3RlcjEkY2x1c3RlcgpgYGAKCioqSWRlbnRpZGljYXIgbGEgcGVybWFuZW5jaWEgcG9yIGNsdXN0ZXIqKgpgYGB7cn0KcmhfYWx0X3RhYmxhMjwtcmhfYWx0X3RhYmxhICU+JSBncm91cF9ieShDbHVzdGVycykgJT4lIHN1bW1hcmlzZShwZXJtYW5lbmNpYT1tYXgocGVybWFuZW5jaWEpKSAlPiUgYXJyYW5nZShkZXNjKHBlcm1hbmVuY2lhKSkKYGBgCgoqKkFncnVwYXIgbG9zIGNsdXN0ZXJzIHBvciBub21icmUqKgpgYGB7cn0KcmhfYWx0X3RhYmxhJENsdXN0ZXJfTmFtZXM8LWZhY3RvcihyaF9hbHRfdGFibGEkQ2x1c3RlcnMsbGV2ZWxzID0gYygxLDIsMyw0KSwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGxhYmVscz1jKCJBbnRpZ8O8ZWRhZCBCYWphIiwgIkFudGlnw7xlZGFkIEFsdGEiLCAiQW50aWfDvGVkYWQgTW9kZXJhZGEiLCAiQW50aWfDvGVkYWQgQXZhbnphZGEiKSkKYGBgCgpgYGB7cn0KcmhfYWx0X3RhYmxhMyA8LSByaF9hbHRfdGFibGEgJT4lIGdyb3VwX2J5KENsdXN0ZXJfTmFtZXMsZ2VuZXJvKSAlPiUgZHBseXI6OnN1bW1hcml6ZShwZXJtYW5lbmNpYV9hw7Fvcz1tYXgocGVybWFuZW5jaWEpLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGVkYWQ9bWVhbihlZGFkKSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIENvdW50PW4oKSkKYGBgCgpgYGB7cn0KY2x1c3RlcnM8LWFzLmRhdGEuZnJhbWUocmhfYWx0X3RhYmxhMykKY2x1c3RlcnMKYGBgCgoqKkdyYWZpY28gZGUgY2x1c3RlcioqCmBgYHtyfQpnZ3Bsb3QocmhfYWx0X3RhYmxhMyxhZXMoeD1yZW9yZGVyKENsdXN0ZXJfTmFtZXMsQ291bnQpLHk9Q291bnQsZmlsbD1DbHVzdGVyX05hbWVzKSkgKwogIGdlb21fYmFyKHN0YXQ9ImlkZW50aXR5IikKYGBgCgojIyMgQ2x1c3RlciAyOiBBbmFsaXphciBzYWxhcmlvIGRpYXJpbyB5IHBlcm1hbmVuY2lhCgpgYGB7cn0Kc3VtbWFyeShyaF9hbHQpCmBgYAoKKipOb3JtYWxpemFlciB2YXJpYWJsZXMqKgpgYGB7ciBpbmNsdWRlPUZBTFNFfQpyaF9hbHQyIDwtIHJoX2FsdApyaF9hbHQyIDwtIHJoX2FsdDIgJT4lIGRwbHlyOjpzZWxlY3QobWVzX2JhamEsIGVkYWQsIHNhbF9kaWFyaW9faW1zcyxwZXJtYW5lbmNpYSkKcmhfYWx0MiA8LSBzdWJzZXQocmhfYWx0MiwgcGVybWFuZW5jaWE+OCAmIHBlcm1hbmVuY2lhPDgwKQpyaF9hbHQyIDwtIHN1YnNldChyaF9hbHQyLCBzYWxfZGlhcmlvX2ltc3M8NDk5KQoKYGBgCgpgYGB7cn0Kcmhfc2FsYXJpbzwtc2NhbGUocmhfYWx0Mls0OjVdKSAKCnN1bW1hcnkocmhfc2FsYXJpbykKYGBgCgoqKkNhbGN1bGFyIG51bWVybyBvcHRpbW8gZGUgY2x1c3RlcnMqKgpgYGB7cn0KZnZpel9uYmNsdXN0KHJoX3NhbGFyaW8sIGttZWFucywgbWV0aG9kPSJ3c3MiKSsgCiAgZ2VvbV92bGluZSh4aW50ZXJjZXB0PTQsIGxpbmV0eXBlPTIpKyAgICAgICAgICAgCiAgbGFicyhzdWJ0aXRsZSA9ICJFbGJvdyBtZXRob2QiKSAgICAgICAgICAgICAgICAgCiAgICAgICAgICAgCmBgYAoKYGBge3J9CnNhbGFyaW9fY2x1c3RlcjE8LWttZWFucyhyaF9zYWxhcmlvLDQpCnNhbGFyaW9fY2x1c3RlcjEKYGBgCgoqKkdyYWZpY28gZGUgY2x1c3RlcioqCmBgYHtyfQpmdml6X2NsdXN0ZXIoc2FsYXJpb19jbHVzdGVyMSxkYXRhPXJoX3NhbGFyaW8pCmBgYApDb21vIHBvZGVtb3Mgb2JzZXJ2YXIgZWwgc2FsYXJpbyBubyBlcyB1biBmYWN0b3IgcXVlIGluZmx1eWUgZW4gbGEgcGVybWFuZW5jaWEgZGUgbGFzIHBlcnNvbmFzIGRlbnRybyBkZSBsYSBlbXByZXNhLiBTZSBlbmNvbnRyw7MgcXVlIGxhcyBwZXJzb25hcyBxdWUgdGllbmVuIGVsIG1pc21vIHNhbGFyaW8gdGllbmVuIGxhIG1pc21hIHZhcmlhYmlsaWRhZCBxdWUgbGFzIHBlcnNvbmFzIHF1ZSBnYW5hbiBtZW5vcy4KCiMjIyMgVGFibGEgZGUgY2x1c3RlcnMKCmBgYHtyfQpyaF9hbHQyX3RhYmxhPC1yaF9hbHQyCnJoX2FsdDJfdGFibGEkQ2x1c3RlcnM8LXNhbGFyaW9fY2x1c3RlcjEkY2x1c3RlcgpgYGAKCioqQ3JlYXIgZGF0YXNldCoqCmBgYHtyfQpyaF9hbHQyX3RhYmxhMjwtcmhfYWx0Ml90YWJsYSAlPiUgZ3JvdXBfYnkoQ2x1c3RlcnMpICU+JSBzdW1tYXJpc2UocGVybWFuZW5jaWE9bWF4KHBlcm1hbmVuY2lhKSkgJT4lIGFycmFuZ2UoZGVzYyhwZXJtYW5lbmNpYSkpCmBgYAoKKipBZ3J1cGFyIHkgbm9tYnJhciBjbHVzdGVycyoqCmBgYHtyfQpyaF9hbHQyX3RhYmxhJENsdXN0ZXJfTmFtZXM8LWZhY3RvcihyaF9hbHQyX3RhYmxhJENsdXN0ZXJzLGxldmVscyA9IGMoMSwyLDMsNCksIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBsYWJlbHM9YygiQW50aWfDvGVkYWQgQWx0YSIsICJBbnRpZ8O8ZWRhZCBNb2RlcmFkYSIsICJBbnRpZ8O8ZWRhZCBBdmFuemFkYSIsICJBbnRpZ8O8ZWRhZCBCYWphIikpCmBgYAoKYGBge3J9CnJoX2FsdDJfdGFibGEzIDwtIHJoX2FsdDJfdGFibGEgJT4lIGdyb3VwX2J5KENsdXN0ZXJfTmFtZXMscHVlc3RvKSAlPiUgZHBseXI6OnN1bW1hcml6ZShwZXJtYW5lbmNpYV9kaWFzPW1heChwZXJtYW5lbmNpYSksIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2FsX2RpYXJpb19pbXNzPW1lYW4oc2FsX2RpYXJpb19pbXNzKSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIENvdW50PW4oKSkKYGBgCgpgYGB7cn0KY2x1c3RlcnM8LWFzLmRhdGEuZnJhbWUocmhfYWx0Ml90YWJsYTMpCmNsdXN0ZXJzCmBgYAoqKkdyYWZpY28gZGUgY2x1c3RlcnMqKgpgYGB7cn0KZ2dwbG90KHJoX2FsdDJfdGFibGEzLGFlcyh4PXJlb3JkZXIoQ2x1c3Rlcl9OYW1lcyxDb3VudCkseT1Db3VudCxmaWxsPUNsdXN0ZXJfTmFtZXMpKSArCiAgZ2VvbV9iYXIoc3RhdD0iaWRlbnRpdHkiKQpgYGAKCiMjIyBDbHVzdGVyIDM6IEFuYWxpemFyIG1lc19iYWphICgxLTgpIHkgZWRhZAoKYGBge3J9CnN1bW1hcnkocmhfYWx0KQpgYGAKCioqTm9ybWFsaXphciB2YXJpYWJsZXMqKgpgYGB7ciBpbmNsdWRlPUZBTFNFfQpyaF9hbHQzIDwtIHJoX2FsdApyaF9hbHQzIDwtIHJoX2FsdDMgJT4lIGRwbHlyOjpzZWxlY3QobWVzX2JhamEsIGVkYWQsIHNhbF9kaWFyaW9faW1zcyxwZXJtYW5lbmNpYSxnZW5lcm8sZXN0YWRvX2NpdmlsKQpyaF9hbHQzIDwtIHN1YnNldChyaF9hbHQzLGVkYWQ+MjMpCmBgYAoKYGBge3J9CnJoX21lc2JhamE8LXNjYWxlKHJoX2FsdDNbMjozXSkgCgpzdW1tYXJ5KHJoX21lc2JhamEpCmBgYAoKKipDYWxjdWxhciBudW1lcm8gb3B0aW1vIGRlIGNsdXN0ZXJzKioKYGBge3J9CmZ2aXpfbmJjbHVzdChyaF9tZXNiYWphLCBrbWVhbnMsIG1ldGhvZD0id3NzIikrIAogIGdlb21fdmxpbmUoeGludGVyY2VwdD00LCBsaW5ldHlwZT0yKSsgICAgICAgICAgIAogIGxhYnMoc3VidGl0bGUgPSAiRWxib3cgbWV0aG9kIikgICAgICAgICAgICAgICAgIAogICAgICAgICAgIApgYGAKCmBgYHtyfQptZXNiYWphX2NsdXN0ZXIxPC1rbWVhbnMocmhfbWVzYmFqYSw0KQptZXNiYWphX2NsdXN0ZXIxCmBgYAoKKipWaXN1YWxpemFjaW9uIGRlIGNsdXN0ZXJzKioKYGBge3J9CmZ2aXpfY2x1c3RlcihtZXNiYWphX2NsdXN0ZXIxLGRhdGE9cmhfbWVzYmFqYSkKYGBgCgoKIyMjIyBUYWJsYSBkZSBjbHVzdGVycwoKYGBge3J9CnJoX2FsdDNfdGFibGE8LXJoX2FsdDMKcmhfYWx0M190YWJsYSRDbHVzdGVyczwtbWVzYmFqYV9jbHVzdGVyMSRjbHVzdGVyCmBgYAoKKipDcmVhciBkYXRhIHNldCoqCmBgYHtyfQpyaF9hbHQzX3RhYmxhMjwtcmhfYWx0M190YWJsYSAlPiUgZ3JvdXBfYnkoQ2x1c3RlcnMpICU+JSBzdW1tYXJpc2UoZWRhZD1tYXgoZWRhZCkpICU+JSBhcnJhbmdlKGRlc2MoZWRhZCkpCmBgYAoKKipBZ3J1cGFyIHkgbm9tYnJhciBjbHVzdGVycyoqCmBgYHtyfQpyaF9hbHQzX3RhYmxhJENsdXN0ZXJfTmFtZXM8LWZhY3RvcihyaF9hbHQzX3RhYmxhJENsdXN0ZXJzLGxldmVscyA9IGMoMSwyLDMsNCksIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBsYWJlbHM9YygiQWR1bHRhIiwgIkp1YmlsYWNpw7NuIiwgIkpvdmVuIEFkdWx0YSIsICJBdmFuemFkYSIpKQpgYGAKCmBgYHtyfQpyaF9hbHQzX3RhYmxhMyA8LSByaF9hbHQzX3RhYmxhICU+JSBncm91cF9ieShDbHVzdGVyX05hbWVzLCBlc3RhZG9fY2l2aWwpICU+JSBkcGx5cjo6c3VtbWFyaXplKGVkYWQ9bWF4KGVkYWQpLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1lc19iYWphPW1lYW4obWVzX2JhamEpLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgQ291bnQ9bigpKQpgYGAKCmBgYHtyfQpjbHVzdGVyczwtYXMuZGF0YS5mcmFtZShyaF9hbHQzX3RhYmxhMykKY2x1c3RlcnMKYGBgCioqR3JhZmljbyBkZSBjbHVzdGVycyoqCmBgYHtyfQpnZ3Bsb3QocmhfYWx0M190YWJsYTMsYWVzKHg9cmVvcmRlcihDbHVzdGVyX05hbWVzLENvdW50KSx5PUNvdW50LGZpbGw9Q2x1c3Rlcl9OYW1lcykpICsKICBnZW9tX2JhcihzdGF0PSJpZGVudGl0eSIpCmBgYAoKIyMgUmVsYWNpb25lcyBFbnRyZSBWYXJpYWJsZXMgQ3VhbnRpdGF0aXZhcyB5IEN1YWxpdGF0aXZhcwoKYGBge3J9CiNsZXRzIHBsb3QgdGhlIG51bWJlciBvZiBkYXRhIG9ic2VydmF0aW9ucyBieSBjbHVzdGVycyBuYW1lcwpnZ3Bsb3QocmhfYWx0X3RhYmxhMyxhZXMoeD1yZW9yZGVyKENsdXN0ZXJfTmFtZXMsQ291bnQpLHk9Q291bnQsZmlsbD1nZW5lcm8pKSArCiAgZ2VvbV9iYXIoc3RhdD0iaWRlbnRpdHkiKQpgYGAKYGBge3J9CmdncGxvdChyaF9hbHQyX3RhYmxhMyxhZXMoeD1yZW9yZGVyKENsdXN0ZXJfTmFtZXMsQ291bnQpLHk9Q291bnQsZmlsbD1wdWVzdG8pKSArCiAgZ2VvbV9iYXIoc3RhdD0iaWRlbnRpdHkiKQpgYGAKCmBgYHtyfQojbGV0cyBwbG90IHRoZSBudW1iZXIgb2YgZGF0YSBvYnNlcnZhdGlvbnMgYnkgY2x1c3RlcnMgbmFtZXMKZ2dwbG90KHJoX2FsdDNfdGFibGEzLGFlcyh4PXJlb3JkZXIoQ2x1c3Rlcl9OYW1lcyxDb3VudCkseT1Db3VudCxmaWxsPWVzdGFkb19jaXZpbCkpICsKICBnZW9tX2JhcihzdGF0PSJpZGVudGl0eSIpCmBgYAoKIyMgR2dhbGx1dmlhbApgYGB7cn0KcmhfYWx0X3RhYmxhJHB1ZXN0byA8LSBhcy5mYWN0b3IocmhfYWx0X3RhYmxhJHB1ZXN0bykKcmhfYWx0X3RhYmxhJGdlbmVybyA8LSBhcy5mYWN0b3IocmhfYWx0X3RhYmxhJGdlbmVybykKcmhfYWx0X3RhYmxhJGVzdGFkb19jaXZpbCA8LSBhcy5mYWN0b3IocmhfYWx0X3RhYmxhJGVzdGFkb19jaXZpbCkKCnJoX2FsdDQ8LXJoX2FsdF90YWJsYSAlPiUgZHBseXI6OmZpbHRlcihDbHVzdGVycz09MSB8IENsdXN0ZXJzPT0zKSAlPiUgYXJyYW5nZShDbHVzdGVycykKCmdncGxvdChhcy5kYXRhLmZyYW1lKHJoX2FsdDQpLAogICAgICAgYWVzKHk9c2FsX2RpYXJpb19pbXNzLCBheGlzMT1nZW5lcm8sIGF4aXMyPWVkYWQpKSArCiAgZ2VvbV9hbGx1dml1bShhZXMoZmlsbD1DbHVzdGVyX05hbWVzKSkgKwogIGdlb21fc3RyYXR1bSh3aWR0aCA9IDEvMTIsIGZpbGwgPSAiYmxhY2siLCBjb2xvciA9ICJncmV5IikgKwogIGdlb21fbGFiZWwoc3RhdCA9ICJzdHJhdHVtIiwgYWVzKGxhYmVsID0gYWZ0ZXJfc3RhdChzdHJhdHVtKSkpICsKICBzY2FsZV94X2Rpc2NyZXRlKGxpbWl0cyA9IGMoImVkYWQiLCAiZ2VuZXJvIiksIGV4cGFuZCA9IGMoLjA1LCAuMDUpKSArCiAgc2NhbGVfZmlsbF9icmV3ZXIodHlwZSA9ICJxdWFsIiwgcGFsZXR0ZSA9ICJTZXQxIikgKwogIGdndGl0bGUoIlJlbGFjaW9uIGRlIEdlbmVybyBjb24gRWRhZCIpCmBgYAoKCiMjIFByaW5jaXBhbGVzIEhhbGxhemdvcwoKKipIYWxsYXpnbyAxLioqIExhcyBwZXJzb25hcyBjb24gbWVub3MgcGVybWFuZW5jaWEgZW4gbGEgZW1wcmVzYSBzb24gbGEgcHJpbmNpcGFsIGNhdXNhIGRlIGxhIGdyYW4gY2F0aWRhZCBkZSBiYWphcy4KCioqSGFsbGF6Z28gMi4qKiBFbCBzYWxhcmlvIG5vIGVzIGZhY3RvciBxdWUgaW5mbHV5ZSBlbiBsYSBwZXJtYW5lbmNpYSBkZSB1bmEgcGVyc29uYSBkZW50cm8gZGUgbGEgZW1wcmVzYS4gU2UgZW5jb250csOzIHF1ZSBsYXMgcGVyc29uYXMgcXVlIHRpZW5lbiBlbCBtaXNtbyBzYWxhcmlvIHRpZW5lbiB1bmEgcGVybWFuZW5jaWEgdmFyaWFkYSBhbCBpZ3VhbCBkZSBsb3MgcXVlIGdhbmFuIG1lbm9zLgoKKipIYWxsYXpnbyAzKiogRGUgYWN1ZXJkbyBhbCBzYWxhcmlvIGRpYXJpbyBjb24gbGEgcGVybWFuZW5jaWEgZXMgY29udGFudGUsIHNpbiBpbXBvcnRhciBjdcOhbnRvIHRpZW1wbyBsbGV2ZXMgZW4gbGEgZW1wcmVzYSBlbCBzYWxhcmlvIHBlcm1hbmVjZSBlbiAxODAgcGVzb3MgZGlhcmlvcy4KCioqSGFsbGF6Z28gNCoqIERlbCBncnVwbyBkZSBlZGFkIGFkdWx0YSB5IGVkYWQgYXZhbnphZGEgZWwgbWVzIGRvbmRlIG9idHV2aWVyb24gbcOhcyBiYWphcyBmdWUgZW4gZWwgbWVzIGRlIGFnb3N0by4KCioqSGFsbGF6Z28gNSoqIERlbCBncnVwbyBkZSBqdWJpbGFjacOzbiB5IGpvdmVuIGFkdWx0YSBlbCBtZXMgZG9uZGUgb2J0dXZpZXJvbiBtw6FzIGJhamFzIGZ1ZSBlbiBlbCBtZXMgZGUgZmVicmVyby4KCg==