FORM es una empresa nuevoleonense fundada en 2011, la cual atiende principalmente a clientes dentro del sector automotriz ofreciendo el desarrollo de empaques personalizados con el objetivo de generar ahorros, eficiencias, productividad y rentabilidad.
El reporte que se presentará a continuación se realizó con el objetivo de analizar las diferentes áreas de la empresa mediante el uso de sus bases de datos internas y el uso de información externa para lograr mejoras en sus procesos.
library(data.table)
library(dplyr)
library(plyr)
library(ggplot2)
library(janitor)
library(psych)
library(tidyverse)
library(janitor)
library(knitr)
library(descr)
library(tidyr)
library(plotrix)
library(graphics)
library(lubridate)
library(flextable)
library(crosstable)
library(tseries)
library(forecast)
library(astsa)
library(jtools)
library(lmtest)
library(car)
library(olsrr)
library(corrplot)
library(foreign)
library(factoextra)
library(ggalluvial)
library(viridis)
library(scales)
#install.packages("caret")
library(caret)
# file.choose()
bd <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\FORM BASES DE DATOS\\FORM - Recursos Humanos - colaboradores.csv")
colaboradores <- clean_names(bd)
colaboradores <- subset(colaboradores, select = -c(no_empleado, nombre_completo, fecha_alta, mano_de_obra))
colaboradores$salario_diario[is.na(colaboradores$salario_diario)]<-median(colaboradores$salario_diario, na.rm = TRUE)
Se utiliza la mediana en vez del promedio para descartar datos “outliers” y normalmente toma los datos más populares.
colaboradores$edad<-as.numeric(colaboradores$edad)
colaboradores$genero<-as.factor(colaboradores$genero)
colaboradores$antiguedad<-as.numeric(colaboradores$antiguedad)
colaboradores$puesto<-as.factor(colaboradores$puesto)
colaboradores$salario_diario<-as.numeric(colaboradores$salario_diario)
colaboradores$estado_civil<-as.factor(colaboradores$estado_civil)
summary (colaboradores)
## edad genero antiguedad puesto
## Min. :18.00 FEMENINO :61 Min. : 0.000 AYUDANTE GENERAL:67
## 1st Qu.:26.00 MASCULINO:52 1st Qu.: 0.000 COSTURERA :10
## Median :34.00 Median : 0.000 SOLDADOR : 5
## Mean :36.06 Mean : 1.425 CHOFER : 4
## 3rd Qu.:45.00 3rd Qu.: 2.000 RESIDENTE : 4
## Max. :73.00 Max. :12.000 EXTERNO : 2
## (Other) :21
## salario_diario estado_civil
## Min. :144.4 Casado :44
## 1st Qu.:176.7 Divorciado : 3
## Median :180.7 Soltero :46
## Mean :179.1 Union Libre:20
## 3rd Qu.:180.7
## Max. :337.1
##
write.csv(colaboradores, file="colaboradores_bd_limpia.csv", row.names = FALSE)
describeData(colaboradores,head=1,tail=1)
## n.obs = 113 of which 113 are complete cases. Number of variables = 6 of which all are numeric TRUE
## variable # n.obs type H1 T1
## edad 1 113 1 67 50
## genero* 2 113 2 MASCULINO FEMENINO
## antiguedad 3 113 1 12 0
## puesto* 4 113 2 SUPERVISOR DE MAQUINA AYUDANTE GENERAL
## salario_diario 5 113 1 176.72 180.68
## estado_civil* 6 113 2 Soltero Casado
La base de datos de “RH - Colaboradores” cuenta con 6 variables y 113 registros en cada columna, siendo 678 registros totales.
Variable<-c("Edad", "Género", "Antigüedad", "Puesto", "Salario Diario", "Estado Civil" )
Tipo<-c("Cuantitativa Discreta", "Cualitativa", "Cuantitativa Discreta", "Cualitativa", "Cuantitativa continua", "Cualitativa")
Medida <-c("Años", "NA", "Años", "NA", "Pesos Mexicanos", "NA")
table<-data.frame(Variable,Tipo, Medida)
table
## Variable Tipo Medida
## 1 Edad Cuantitativa Discreta Años
## 2 Género Cualitativa NA
## 3 Antigüedad Cuantitativa Discreta Años
## 4 Puesto Cualitativa NA
## 5 Salario Diario Cuantitativa continua Pesos Mexicanos
## 6 Estado Civil Cualitativa NA
knitr::kable(table)
| Variable | Tipo | Medida |
|---|---|---|
| Edad | Cuantitativa Discreta | Años |
| Género | Cualitativa | NA |
| Antigüedad | Cuantitativa Discreta | Años |
| Puesto | Cualitativa | NA |
| Salario Diario | Cuantitativa continua | Pesos Mexicanos |
| Estado Civil | Cualitativa | NA |
histStack(colaboradores$salario_diario, colaboradores$genero, xlab= "Salario Diario", ylab= "Cantidad de Empleados", legend.pos="topright")
Con este gráfico podemos observar que solo hay un colaborador
que gana más de $300 diarios y es una Mujer. Asimismo,
observamos que la mayoría de los colaboradores ganan entre 170-200
pesos diarios, habiendo más mujeres en este segmento.
hist(x = colaboradores$edad, main = "Histograma de Edad",
xlab = "Edad", ylab = "Frecuencia",
col = "orange")
Con este gráfico podemos observar que la mayoría de los
colaboradores de FORM tienen entre 25 a 30 años.
ggplot(colaboradores, aes(x=genero, y=salario_diario, fill=genero)) +
geom_bar(stat="identity") +
facet_grid(~estado_civil) + scale_fill_brewer(palette = "Set2")
Con este gráfico podemos observar que los que están casados y
solteros suelen ganar más que los que están divorciados y en unión
libre. Además, los hombres casados y las mujeres solteras
son los que ganan más.
media_edad <- mean(colaboradores$edad)
media_edad
## [1] 36.06195
media_antiguedad <- mean(colaboradores$antiguedad)
media_antiguedad
## [1] 1.424779
media_salario <- mean(colaboradores$salario_diario)
media_salario
## [1] 179.1261
mediana_edad <- median(colaboradores$edad)
mediana_edad
## [1] 34
mediana_antiguedad <- median(colaboradores$antiguedad)
mediana_antiguedad
## [1] 0
mediana_salario <- median(colaboradores$salario_diario)
mediana_salario
## [1] 180.68
mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
moda_edad <- mode(colaboradores$edad)
moda_edad
## [1] 32
moda_antiguedad <- mode(colaboradores$antiguedad)
moda_antiguedad
## [1] 0
moda_salario <- mode(colaboradores$salario_diario)
moda_salario
## [1] 180.68
varianza_edad <-var(colaboradores$edad)
varianza_edad
## [1] 165.0051
varianza_antiguedad <-var(colaboradores$antiguedad)
varianza_antiguedad
## [1] 6.353666
varianza_salario <-var(colaboradores$salario_diario)
varianza_salario
## [1] 589.7666
desviacion_edad <- sqrt(varianza_edad)
desviacion_edad
## [1] 12.84543
desviacion_antiguedad <- sqrt(varianza_antiguedad)
desviacion_antiguedad
## [1] 2.520648
desviacion_salario <- sqrt(varianza_salario)
desviacion_salario
## [1] 24.28511
Variable <-c("Edad","Antigüedad","Salario Diario")
Promedio <-c("36.06", "1.42","179.09")
Moda <-c("32","0","180.68")
Mediana <-c("34","0","180.68")
Desviación_Estándar <-c ("12.84","2.52","24.28")
tabla <-data.frame(Variable,Promedio, Moda, Mediana, Desviación_Estándar)
tabla
## Variable Promedio Moda Mediana Desviación_Estándar
## 1 Edad 36.06 32 34 12.84
## 2 Antigüedad 1.42 0 0 2.52
## 3 Salario Diario 179.09 180.68 180.68 24.28
knitr::kable(tabla)
| Variable | Promedio | Moda | Mediana | Desviación_Estándar |
|---|---|---|---|---|
| Edad | 36.06 | 32 | 34 | 12.84 |
| Antigüedad | 1.42 | 0 | 0 | 2.52 |
| Salario Diario | 179.09 | 180.68 | 180.68 | 24.28 |
De estos estadísticos descriptivos podemos destacar principalmente los siguientes hallazgos:
1. La edad promedio de los colaboradores actuales es de 36 años.
2. La mayoría de los colaboradores gana $180.68 pesos diarios (mediana).
3. Existen colaboradores muy antiguos y muy recientes, sin emBargo, la mayoría no tiene ni 1 año aún en la empresa (mediana).
bd1 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\FORM BASES DE DATOS\\FORM - Recursos Humanos - BAJAS BUENA.csv")
bajas <- clean_names(bd1)
summary(bajas)
## apellidos nombre fecha_de_nacimiento edad
## Length:236 Length:236 Length:236 Min. :19.00
## Class :character Class :character Class :character 1st Qu.:23.00
## Mode :character Mode :character Mode :character Median :29.00
## Mean :31.08
## 3rd Qu.:37.00
## Max. :61.00
## NA's :3
## genero rfc fecha_de_alta motivo_de_baja
## Length:236 Length:236 Length:236 Length:236
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## no_dias baja puesto departamento
## Min. : 0.00 Length:236 Length:236 Length:236
## 1st Qu.: 9.00 Class :character Class :character Class :character
## Median : 19.00 Mode :character Mode :character Mode :character
## Mean : 79.76
## 3rd Qu.: 49.00
## Max. :1966.00
## NA's :23
## no_seguro_social salario_diario_imss factor_cred_infonavit
## Length:236 Min. :144.4 Length:236
## Class :character 1st Qu.:180.7 Class :character
## Mode :character Median :180.7 Mode :character
## Mean :178.0
## 3rd Qu.:180.7
## Max. :500.0
##
## n_credito_infonavit lugar_de_nacimiento curp calle
## Length:236 Length:236 Length:236 Length:236
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## numero_interno colonia codigo_postal municipio
## Length:236 Length:236 Length:236 Length:236
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## estado estado_civil tarjeta_cuenta
## Length:236 Length:236 Length:236
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
bajas <- subset(bajas, select = -c(apellidos, nombre, fecha_de_nacimiento, rfc, departamento, no_seguro_social, factor_cred_infonavit, n_credito_infonavit, lugar_de_nacimiento, curp, calle, numero_interno, colonia, codigo_postal, municipio, estado, tarjeta_cuenta, fecha_de_alta, baja))
bajas$no_dias[is.na(bajas$no_dias)]<-median(bajas$no_dias, na.rm = TRUE)
bajas$edad[is.na(bajas$edad)]<-mean(bajas$edad, na.rm = TRUE)
bajas$edad<-as.numeric(bajas$edad)
bajas$genero<-as.factor(bajas$genero)
bajas$motivo_de_baja<-as.factor(bajas$motivo_de_baja)
bajas$no_dias<-as.numeric(bajas$no_dias)
bajas$puesto<-as.factor(bajas$puesto)
bajas$salario_diario_imss<-as.numeric(bajas$salario_diario_imss)
bajas$estado_civil<-as.factor(bajas$estado_civil)
summary (bajas)
## edad genero motivo_de_baja no_dias
## Min. :19.00 FEMENINO :139 ABANDONO : 1 Min. : 0.00
## 1st Qu.:23.00 MASCULINO: 97 BAJA POR FALTAS :141 1st Qu.: 9.00
## Median :29.00 JUBILACION : 1 Median : 19.00
## Mean :31.08 RENUNCIA VOLUNTARIA: 85 Mean : 73.84
## 3rd Qu.:37.00 TERMINO DE CONTRATO: 8 3rd Qu.: 42.50
## Max. :61.00 Max. :1966.00
##
## puesto salario_diario_imss estado_civil
## AYUDANTE GENERAL :179 Min. :144.4 CASADO : 64
## COSTURERA : 11 1st Qu.:180.7 DIVORCIADO : 3
## SOLDADOR : 11 Median :180.7 SOLTERO :108
## AYUDANTE DE EMBARQUES: 7 Mean :178.0 UNION LIBRE: 61
## MONTACARGUISTA : 5 3rd Qu.:180.7
## INSPECTOR CALIDAD : 4 Max. :500.0
## (Other) : 19
write.csv(bajas, file="bajas_bd_limpia.csv", row.names = FALSE)
describeData(bajas,head=1,tail=1)
## n.obs = 236 of which 236 are complete cases. Number of variables = 7 of which all are numeric TRUE
## variable # n.obs type H1 T1
## edad 1 236 1 32 23
## genero* 2 236 2 MASCULINO FEMENINO
## motivo_de_baja* 3 236 2 RENUNCIA VOLUNTARIA BAJA POR FALTAS
## no_dias 4 236 1 628 6
## puesto* 5 236 2 DISEÑO AYUDANTE GENERAL
## salario_diario_imss 6 236 1 500 180.68
## estado_civil* 7 236 2 SOLTERO UNION LIBRE
La base de datos de “RH - Colaboradores” cuenta con 7 variables y 236 registros en cada columna, siendo 1,652 registros totales.
Variable_bajas<-c("Edad", "Género", "Motivo de Baja", "No. Días", "Puesto", "Salario Diario", "Estado Civil" )
Tipo_bajas<-c("Cuantitativa Discreta", "Cualitativa", "Cualitativa", "Cuantitativa Discreta", "Cualitativa", "Cuantitativa continua", "Cualitativa")
Medida_bajas <-c("Años", "NA", "NA", "Años", "NA", "Pesos Mexicanos", "NA")
tabla_bajas<-data.frame(Variable_bajas,Tipo_bajas, Medida_bajas)
tabla_bajas
## Variable_bajas Tipo_bajas Medida_bajas
## 1 Edad Cuantitativa Discreta Años
## 2 Género Cualitativa NA
## 3 Motivo de Baja Cualitativa NA
## 4 No. Días Cuantitativa Discreta Años
## 5 Puesto Cualitativa NA
## 6 Salario Diario Cuantitativa continua Pesos Mexicanos
## 7 Estado Civil Cualitativa NA
knitr::kable(tabla_bajas)
| Variable_bajas | Tipo_bajas | Medida_bajas |
|---|---|---|
| Edad | Cuantitativa Discreta | Años |
| Género | Cualitativa | NA |
| Motivo de Baja | Cualitativa | NA |
| No. Días | Cuantitativa Discreta | Años |
| Puesto | Cualitativa | NA |
| Salario Diario | Cuantitativa continua | Pesos Mexicanos |
| Estado Civil | Cualitativa | NA |
hist(bajas$edad, freq=TRUE, col="pink", main="Edad en años de los Ex-Colaboradores")
Los colaboradores que se han dado de baja en su mayoría tienen entre 20 y 30 años, siendo así los que se van más jóvenes.
ggplot(data=bajas, mapping = aes(no_dias, salario_diario_imss)) + geom_point(aes(color = genero)) + theme_bw()
count(bajas, "no_dias")
## no_dias freq
## 1 0 7
## 2 1 9
## 3 2 6
## 4 3 4
## 5 4 3
## 6 5 5
## 7 6 9
## 8 7 3
## 9 8 7
## 10 9 8
## 11 10 5
## 12 11 5
## 13 12 6
## 14 13 4
## 15 14 6
## 16 15 10
## 17 16 5
## 18 18 3
## 19 19 27
## 20 20 3
## 21 21 2
## 22 22 1
## 23 23 3
## 24 25 4
## 25 26 1
## 26 27 2
## 27 28 2
## 28 29 5
## 29 30 6
## 30 31 1
## 31 32 2
## 32 33 2
## 33 34 2
## 34 35 1
## 35 36 1
## 36 37 2
## 37 39 1
## 38 40 1
## 39 41 3
## 40 47 3
## 41 48 2
## 42 49 1
## 43 50 1
## 44 51 1
## 45 54 1
## 46 57 1
## 47 58 1
## 48 59 2
## 49 60 2
## 50 63 1
## 51 64 1
## 52 71 1
## 53 75 1
## 54 77 1
## 55 86 2
## 56 89 3
## 57 91 1
## 58 93 1
## 59 102 1
## 60 103 2
## 61 104 1
## 62 112 1
## 63 117 1
## 64 125 1
## 65 129 1
## 66 141 3
## 67 148 1
## 68 149 2
## 69 161 1
## 70 169 1
## 71 197 1
## 72 224 1
## 73 239 1
## 74 251 1
## 75 361 1
## 76 366 1
## 77 421 1
## 78 423 1
## 79 455 1
## 80 602 1
## 81 628 1
## 82 646 1
## 83 1236 1
## 84 1408 1
## 85 1429 1
## 86 1966 1
Con esta gráfica podemos observar que el colaborador que ganaba más era hombre (outlier), pues fue el único colaborador que se dio de baja ganando más de 180.68 (moda). Asimismo, han habido bajas de ambos géneros, sin embargo, hay una acumulación de bajas en colaboradores que tenían muy poco tiempo trabajando en FORM, teniendo menos de 3 meses (74 días en promedio) laborando.
table(bajas$motivo_baja)
## < table of extent 0 >
proporciones <- c(1, 141, 1, 87, 8)
etiquetas <- c("Abandono", "Baja por Faltas", "Jubilación", "Renuncia Voluntaria", "Termino de Contrato")
pct <- round(proporciones/sum(proporciones)*100)
etiquetas <- paste(etiquetas, pct)
etiquetas <- paste(etiquetas,"%",sep="")
pie(proporciones,labels = etiquetas,
col=rainbow(length(etiquetas)),
main="Motivo de bajas de los Colaboradores")
Con esta gráfica podemos observar que el motivo más común de baja de los colaboradores han sido por despidos por faltas con un 59% y por renuncia voluntaria por un 37%.
table(bajas$puesto)
##
## ANALISTA DE NOMINAS /AUX DE R.H. AYUDANTE DE EMBARQUES
## 1 7
## AYUDANTE DE MTTO AYUDANTE DE SOLDADOR
## 1 1
## AYUDANTE GENERAL CHOFER
## 179 1
## CORTADOR COSTURERA
## 1 11
## DISEÑO ENCARGADA DE CALIDAD
## 1 1
## FACTURACION GUARDIA DE SEGURIDAD
## 1 2
## INSPECTOR CALIDAD LIMPIEZA
## 4 1
## MARCADORA MATERIALISTA
## 1 2
## MONTACARGUISTA PRACTICANTE DE MTTO
## 5 1
## RESIDENTE SERVICIO AL CLIENTE
## 3 1
## SOLDADOR
## 11
proporciones_puesto <- c(23, 179, 11, 11, 7, 5)
etiquetas_puesto <- c("Otros","Ayudante General", "Costurera", "Soldador", "Ayudante Embarques", "Montacarguista")
pct_puesto <- round(proporciones_puesto/sum(proporciones_puesto)*100)
etiquetas_puesto <- paste(etiquetas_puesto, pct_puesto)
etiquetas_puesto <- paste(etiquetas_puesto,"%",sep="")
pie(proporciones_puesto,labels = etiquetas_puesto,
col=rainbow(length(etiquetas_puesto)),
main="Puesto de los Ex-Colaboradores")
La mayor parte de los ex-colaboradores de Form eran Ayudantes generales (76%).
crosstable(bajas, c(estado_civil, genero), by=motivo_de_baja, total = "both") %>% as_flextable()
label | variable | motivo_de_baja | Total | ||||
ABANDONO | BAJA POR FALTAS | JUBILACION | RENUNCIA VOLUNTARIA | TERMINO DE CONTRATO | |||
estado_civil | CASADO | 0 (0%) | 42 (65.62%) | 1 (1.56%) | 20 (31.25%) | 1 (1.56%) | 64 (27.12%) |
DIVORCIADO | 0 (0%) | 2 (66.67%) | 0 (0%) | 1 (33.33%) | 0 (0%) | 3 (1.27%) | |
SOLTERO | 1 (0.93%) | 51 (47.22%) | 0 (0%) | 51 (47.22%) | 5 (4.63%) | 108 (45.76%) | |
UNION LIBRE | 0 (0%) | 46 (75.41%) | 0 (0%) | 13 (21.31%) | 2 (3.28%) | 61 (25.85%) | |
Total | 1 (0.42%) | 141 (59.75%) | 1 (0.42%) | 85 (36.02%) | 8 (3.39%) | 236 (100.00%) | |
genero | FEMENINO | 0 (0%) | 90 (64.75%) | 0 (0%) | 43 (30.94%) | 6 (4.32%) | 139 (58.90%) |
MASCULINO | 1 (1.03%) | 51 (52.58%) | 1 (1.03%) | 42 (43.30%) | 2 (2.06%) | 97 (41.10%) | |
Total | 1 (0.42%) | 141 (59.75%) | 1 (0.42%) | 85 (36.02%) | 8 (3.39%) | 236 (100.00%) | |
Con esta tabla podemos observar diferentes insights; primeramente, podemos ver que el 58.9% (139 ex-colaboradoras) de las bajas totales reportadas son de mujeres y de estas, el 64.75% se han dado de baja por faltas.
Asimismo podemos observar que el total de los casados, divorciados y en unión libre son mucho más propensos ha ser despedidos que ha renunciar voluntariamente (los que tienen o han tenido pareja) y por el otro lado, existe la misma cantidad de solteros que han renunciado y han sido dados de baja.
media_edad1 <- mean(bajas$edad)
media_edad1
## [1] 31.07725
media_no_dias <- mean(bajas$no_dias)
media_no_dias
## [1] 73.83898
media_salario1 <- mean(bajas$salario_diario)
media_salario1
## [1] 177.9627
mediana_edad1 <- median(bajas$edad)
mediana_edad1
## [1] 29
mediana_no_dias <- median(bajas$no_dias)
mediana_no_dias
## [1] 19
mediana_salario1 <- median(bajas$salario_diario)
mediana_salario1
## [1] 180.68
mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
moda_edad1 <- mode(bajas$edad)
moda_edad1
## [1] 22
moda_no_dias <- mode(bajas$no_dias)
moda_no_dias
## [1] 19
moda_salario1 <- mode(bajas$salario_diario)
moda_salario1
## [1] 180.68
varianza_edad1 <-var(bajas$edad)
varianza_edad1
## [1] 91.86642
varianza_no_dias <-var(bajas$no_dias)
varianza_no_dias
## [1] 45983.08
varianza_salario1 <-var(bajas$salario_diario)
varianza_salario1
## [1] 540.9893
desviacion_edad1 <- sqrt(varianza_edad1)
desviacion_edad1
## [1] 9.584697
desviacion_no_dias <- sqrt(varianza_no_dias)
desviacion_no_dias
## [1] 214.4367
desviacion_salario1 <- sqrt(varianza_salario1)
desviacion_salario1
## [1] 23.25918
Variable1 <-c("Edad","Antiguedad","Salario Diario")
Promedio1 <-c("31.05","0.6","177.985")
Moda1 <-c("22","0","180.68")
Mediana1 <-c("29","0","180.68")
Desviación_Estándar1 <-c ("9.525","0.817","23.065")
tabla1 <-data.frame (Variable1,Promedio1, Moda1, Mediana1, Desviación_Estándar1)
tabla1
## Variable1 Promedio1 Moda1 Mediana1 Desviación_Estándar1
## 1 Edad 31.05 22 29 9.525
## 2 Antiguedad 0.6 0 0 0.817
## 3 Salario Diario 177.985 180.68 180.68 23.065
knitr::kable(tabla1)
| Variable1 | Promedio1 | Moda1 | Mediana1 | Desviación_Estándar1 |
|---|---|---|---|---|
| Edad | 31.05 | 22 | 29 | 9.525 |
| Antiguedad | 0.6 | 0 | 0 | 0.817 |
| Salario Diario | 177.985 | 180.68 | 180.68 | 23.065 |
De estos estadísticos descriptivos podemos destacar principalmente los siguientes hallazgos:
1. La mayor parte de los ex-colaboradores de Form tenian entre 29-31 años (más jóvenes que el promedio de los actuales).
2. La mayoría de los ex-colaboradores ganaban $180.68 pesos diarios (mediana), al igual que los actuales colaboradores.
3. Las colaboradores que se dieron de baja tenían un mínimo periodo de tiempo laborando en la empresa.
# file.choose()
bd2 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\Delivery Plan FINAL - EQUIPO 4 .csv")
delivery_plan <- clean_names(bd2)
summary(delivery_plan)
## cliente_planta proyecto id_odoo item
## Length:231 Length:231 Length:231 Length:231
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## junio julio agosto septiembre
## Min. : 0.00 Min. : 0.0 Min. : 0.00 Min. : 0
## 1st Qu.: 0.00 1st Qu.: 0.0 1st Qu.: 0.00 1st Qu.: 0
## Median : 0.00 Median : 0.0 Median : 0.00 Median : 0
## Mean : 29.06 Mean : 135.9 Mean : 77.45 Mean : 81
## 3rd Qu.: 0.00 3rd Qu.: 0.0 3rd Qu.: 0.00 3rd Qu.: 0
## Max. :1280.00 Max. :13120.0 Max. :3200.00 Max. :3200
## octubre noviembre diciembre ene_22
## Min. : 0.0 Min. : 0.00 Min. : 0.0 Min. : 0.00
## 1st Qu.: 0.0 1st Qu.: 0.00 1st Qu.: 0.0 1st Qu.: 0.00
## Median : 0.0 Median : 0.00 Median : 0.0 Median : 0.00
## Mean : 62.0 Mean : 89.69 Mean : 100.4 Mean : 82.37
## 3rd Qu.: 11.5 3rd Qu.: 4.00 3rd Qu.: 1.5 3rd Qu.: 26.50
## Max. :3200.0 Max. :6400.00 Max. :6400.0 Max. :3200.00
## feb_22 mar_22 abr_22 may_22
## Min. : 0.0 Min. : 0.0 Min. : 0.0 Min. : 0.0
## 1st Qu.: 0.0 1st Qu.: 0.0 1st Qu.: 0.0 1st Qu.: 0.0
## Median : 0.0 Median : 0.0 Median : 0.0 Median : 0.0
## Mean : 103.5 Mean : 153.9 Mean : 186.5 Mean : 187.6
## 3rd Qu.: 0.0 3rd Qu.: 20.0 3rd Qu.: 24.0 3rd Qu.: 22.0
## Max. :9600.0 Max. :9600.0 Max. :16354.0 Max. :17665.0
## jun_22 jul_22 ago_22 sep_22
## Min. : 0.0 Min. : 0.0 Min. : 0.0 Min. : 0.0
## 1st Qu.: 0.0 1st Qu.: 0.0 1st Qu.: 0.0 1st Qu.: 0.0
## Median : 0.0 Median : 0.0 Median : 0.0 Median : 0.0
## Mean : 171.2 Mean : 316.9 Mean : 131.5 Mean : 272.3
## 3rd Qu.: 1.0 3rd Qu.: 15.5 3rd Qu.: 0.0 3rd Qu.: 0.0
## Max. :11050.0 Max. :25900.0 Max. :13200.0 Max. :29379.0
## octubre_22 nov_22 dic_22 ene_23
## Min. : 0.0 Min. : 0.000 Min. : 0.000 Min. : 0.0000
## 1st Qu.: 0.0 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.: 0.0000
## Median : 0.0 Median : 0.000 Median : 0.000 Median : 0.0000
## Mean : 120.9 Mean : 2.113 Mean : 1.225 Mean : 0.5974
## 3rd Qu.: 0.0 3rd Qu.: 0.000 3rd Qu.: 0.000 3rd Qu.: 0.0000
## Max. :16421.0 Max. :324.000 Max. :276.000 Max. :138.0000
## feb_23 mar_23 total_meses
## Min. :0 Min. :0 Min. : 0
## 1st Qu.:0 1st Qu.:0 1st Qu.: 16
## Median :0 Median :0 Median : 115
## Mean :0 Mean :0 Mean : 2306
## 3rd Qu.:0 3rd Qu.:0 3rd Qu.: 724
## Max. :0 Max. :0 Max. :136754
delivery_plan <- delivery_plan %>% dplyr::rename(cliente=cliente_planta,
A_jun_21=junio,
B_jul_21=julio,
C_ago_21=agosto,
D_sep_21=septiembre,
E_oct_21=octubre,
F_nov_21=noviembre,
G_dic_21=diciembre,
H_ene_22=ene_22,
I_feb_22=feb_22,
J_mar_22=mar_22,
K_abr_22=abr_22,
L_may_22=may_22,
M_jun_22=jun_22,
N_jul_22=jul_22,
O_ago_22=ago_22,
P_sep_22=sep_22,
Q_oct_22=octubre_22,
R_nov_22=nov_22,
S_dic_22=dic_22,
T_ene_23=ene_23,
U_feb_23=feb_23,
V_mar_23=mar_23
)
colnames(delivery_plan)
## [1] "cliente" "proyecto" "id_odoo" "item" "A_jun_21"
## [6] "B_jul_21" "C_ago_21" "D_sep_21" "E_oct_21" "F_nov_21"
## [11] "G_dic_21" "H_ene_22" "I_feb_22" "J_mar_22" "K_abr_22"
## [16] "L_may_22" "M_jun_22" "N_jul_22" "O_ago_22" "P_sep_22"
## [21] "Q_oct_22" "R_nov_22" "S_dic_22" "T_ene_23" "U_feb_23"
## [26] "V_mar_23" "total_meses"
delivery_plan <- pivot_longer(delivery_plan, cols=5:14, names_to = "mes", values_to = "unidades")
str(delivery_plan)
## tibble [2,310 × 19] (S3: tbl_df/tbl/data.frame)
## $ cliente : chr [1:2310] "STB3" "STB3" "STB3" "STB3" ...
## $ proyecto : chr [1:2310] "CANASTILLA GRIS" "CANASTILLA GRIS" "CANASTILLA GRIS" "CANASTILLA GRIS" ...
## $ id_odoo : chr [1:2310] "15.785" "15.785" "15.785" "15.785" ...
## $ item : chr [1:2310] "CABLE SET CAJA BACK UP CANASTILLA" "CABLE SET CAJA BACK UP CANASTILLA" "CABLE SET CAJA BACK UP CANASTILLA" "CABLE SET CAJA BACK UP CANASTILLA" ...
## $ K_abr_22 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ L_may_22 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ M_jun_22 : int [1:2310] 200 200 200 200 200 200 200 200 200 200 ...
## $ N_jul_22 : int [1:2310] 900 900 900 900 900 900 900 900 900 900 ...
## $ O_ago_22 : int [1:2310] 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 ...
## $ P_sep_22 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ Q_oct_22 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ R_nov_22 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ S_dic_22 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ T_ene_23 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ U_feb_23 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ V_mar_23 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ total_meses: int [1:2310] 3850 3850 3850 3850 3850 3850 3850 3850 3850 3850 ...
## $ mes : chr [1:2310] "A_jun_21" "B_jul_21" "C_ago_21" "D_sep_21" ...
## $ unidades : int [1:2310] 0 140 530 0 200 0 150 230 500 0 ...
delivery_plan <- filter(delivery_plan, unidades>0)
delivery_plan <- subset (delivery_plan, select = -c (proyecto, id_odoo, item, K_abr_22, L_may_22, M_jun_22,N_jul_22,O_ago_22, P_sep_22, Q_oct_22, R_nov_22, S_dic_22, T_ene_23, V_mar_23, U_feb_23, total_meses))
delivery_plan$cliente<-as.factor(delivery_plan$cliente)
delivery_plan$mes<-as.factor(delivery_plan$mes)
delivery_plan$unidades<-as.numeric(delivery_plan$unidades)
summary(delivery_plan)
## cliente mes unidades
## VARROC :280 H_ene_22: 76 Min. : 1.0
## TRMX : 72 J_mar_22: 70 1st Qu.: 30.0
## DENSO : 57 E_oct_21: 64 Median : 80.0
## YFCF : 54 F_nov_21: 61 Mean : 358.4
## HELLA : 36 G_dic_21: 60 3rd Qu.: 300.0
## YF RAMOS: 28 B_jul_21: 57 Max. :13120.0
## (Other) : 63 (Other) :202
write.csv(delivery_plan, file="delivery_plan_limpia1.csv", row.names = FALSE)
describeData(delivery_plan,head=1,tail=1)
## n.obs = 590 of which 590 are complete cases. Number of variables = 3 of which all are numeric TRUE
## variable # n.obs type H1 T1
## cliente* 1 590 4 STB3 VARROC
## mes* 2 590 4 B_jul_21 F_nov_21
## unidades* 3 590 4 140 200
La base de datos de “Delivery Plan” cuenta con 3 variables y 590 registros en cada columna, siendo 1,770 registros totales.
Variable_delivery_plan<-c("Cliente", "Mes", "Unidades")
Tipo_plan<-c("Cualitativa", "Cualitativa", "Cuantitativa continua")
Medida_plan <-c("NA", "NA", "Unidades")
tabla3<-data.frame(Variable_delivery_plan,Tipo_plan, Medida_plan)
tabla3
## Variable_delivery_plan Tipo_plan Medida_plan
## 1 Cliente Cualitativa NA
## 2 Mes Cualitativa NA
## 3 Unidades Cuantitativa continua Unidades
knitr::kable(tabla3)
| Variable_delivery_plan | Tipo_plan | Medida_plan |
|---|---|---|
| Cliente | Cualitativa | NA |
| Mes | Cualitativa | NA |
| Unidades | Cuantitativa continua | Unidades |
boxplot(unidades ~ mes, data = delivery_plan,
las = 3,
main = "Unidades entregadas en cada mes",
col = rainbow(ncol(trees)))
En esta gráfica podemos observar que en el mes con mayor cantidad de unidades entregadas y menos dispersión entre los datos fue septiembre del 2021. Sin embargo, julio del 2021 tuvo la mayor entrega siendo esta mayor a 10,000 unidades y marzo del 2022 ha tenido varias entregas dispersas mayores a su promedio de entrega.
ggplot(delivery_plan, aes(mes,unidades)) +
geom_bar(stat = "identity") +
scale_fill_brewer(palette = "Accent") + ggtitle("Unidades vendidas por Mes")
En julio de 2021 y marzo de 2022 hubo una mayor cantidad de piezas entregadas; esto se puede deber a las pocas entregas dispersas analizadas en la gráfica anterior que eran de muchas más unidades que el promedio. Sin embargo, no se observa ninguna tendencia fuerte de unidades entregadas por los meses.
count(delivery_plan$cliente)
## x freq
## 1 ABC QUERETARO 1
## 2 ANTOLIN TOLUCA 9
## 3 DENSO 57
## 4 HELLA 36
## 5 INOAC POLYTEC 1
## 6 ISRI 1
## 7 MERIDIAN 5
## 8 SEGROVE 1
## 9 STB 1 1
## 10 STB3 6
## 11 STB4 4
## 12 STB5 4
## 13 STB6 2
## 14 STB8 1
## 15 STB9 1
## 16 TRMX 72
## 17 UFI 8
## 18 VARROC 280
## 19 YANFENG sm 14
## 20 YF QRO 1
## 21 YF RAMOS 28
## 22 YFCF 54
## 23 YFTO 3
proporciones_plan <- c(57, 36, 72, 280, 28, 54, 14, 49)
etiquetas_plan <- c("DENSO", "HELLA", "TRMX", "VARROC", "YF RAMOS", "YFCF", "YAFENG sm", "Otros")
pct_plan <- round(proporciones_plan/sum(proporciones_plan)*100)
etiquetas_plan <- paste(etiquetas_plan, pct_plan)
etiquetas_plan <- paste(etiquetas_plan,"%",sep="")
pie(proporciones_plan,labels = etiquetas_plan,
col=rainbow(length(etiquetas_plan)),
main="Clientes con pedidos para entrega")
Los clientes a los que más unidades se les registró para entrega son VARROC (47%), TRMX (12%), y DENSO (10%).
media_plan <- mean(delivery_plan$unidades)
media_plan
## [1] 358.3729
median_plan <- median(delivery_plan$unidades)
median_plan
## [1] 80
mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
mode_plan <- mode(delivery_plan$unidades)
mode_plan
## [1] 60
varianza_unidades_prog <- var(delivery_plan$unidades)
varianza_unidades_prog
## [1] 1005677
desviacion_unidades_prog<- sqrt(varianza_unidades_prog)
desviacion_unidades_prog
## [1] 1002.834
Variable_plan<-c("Unidades", "Mes", "cliente")
Promedio_plan<-c("358", "NA", "NA")
Mediana_plan<-c("80", "NA", "NA")
Moda_plan<-c("60", "NA", "NA")
Desviacion_Estandar_plan<-c("1002.834", "NA", "NA")
tabla_plan <- data.frame (Variable_plan, Promedio_plan, Mediana_plan, Moda_plan, Desviacion_Estandar_plan)
knitr::kable(tabla_plan)
| Variable_plan | Promedio_plan | Mediana_plan | Moda_plan | Desviacion_Estandar_plan |
|---|---|---|---|---|
| Unidades | 358 | 80 | 60 | 1002.834 |
| Mes | NA | NA | NA | NA |
| cliente | NA | NA | NA | NA |
De estos estadísticos descriptivos podemos destacar principalmente los siguientes hallazgos:
# file.choose()
bd3 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\FORM BASES DE DATOS\\FORM - Delivery Performance BD BUENA.csv")
performance <- clean_names(bd3)
summary(performance)
## fecha printel mahle magna
## Length:324 Min. :0.0000 Min. :-11.650 Min. :0
## Class :character 1st Qu.:0.0000 1st Qu.: 1.800 1st Qu.:0
## Mode :character Median :0.0000 Median : 3.000 Median :0
## Mean :0.4418 Mean : 2.364 Mean :0
## 3rd Qu.:1.0000 3rd Qu.: 3.150 3rd Qu.:0
## Max. :4.4000 Max. : 20.000 Max. :0
## NA's :25 NA's :25 NA's :25
## varroc x x_1 x_2 x_3
## Min. :0 Mode:logical Mode:logical Mode:logical Mode:logical
## 1st Qu.:0 NA's:324 NA's:324 NA's:324 NA's:324
## Median :0
## Mean :0
## 3rd Qu.:0
## Max. :0
## NA's :25
performance <- subset(performance, select = -c(x, x_1, x_2, x_3))
performance$fecha <- as.Date(performance$fecha, format = "%d/%m/%Y")
performance$printel <- as.numeric(performance$printel)
performance$mahle <- as.numeric(performance$mahle)
performance$magna <- as.numeric(performance$magna)
performance$varroc <- as.numeric(performance$varroc)
sapply(performance, function(x) sum(is.na(x)))
## fecha printel mahle magna varroc
## 25 25 25 25 25
performance$fecha[is.na(performance$fecha)]<-median(performance$fecha, na.rm = TRUE)
performance$printel[is.na(performance$printel)]<-median(performance$printel, na.rm = TRUE)
performance$mahle[is.na(performance$mahle)]<-median(performance$mahle, na.rm = TRUE)
performance$magna[is.na(performance$magna)]<-median(performance$magna, na.rm = TRUE)
performance$varroc[is.na(performance$varroc)]<-median(performance$varroc, na.rm = TRUE)
summary(performance)
## fecha printel mahle magna
## Min. :2021-07-22 Min. :0.0000 Min. :-11.650 Min. :0
## 1st Qu.:2021-10-20 1st Qu.:0.0000 1st Qu.: 2.000 1st Qu.:0
## Median :2022-02-07 Median :0.0000 Median : 3.000 Median :0
## Mean :2022-01-30 Mean :0.4077 Mean : 2.413 Mean :0
## 3rd Qu.:2022-04-27 3rd Qu.:0.9625 3rd Qu.: 3.100 3rd Qu.:0
## Max. :2022-07-23 Max. :4.4000 Max. : 20.000 Max. :0
## varroc
## Min. :0
## 1st Qu.:0
## Median :0
## Mean :0
## 3rd Qu.:0
## Max. :0
write.csv(performance, file="performance_bd_limpia.csv", row.names = FALSE)
describeData(performance,head=1,tail=1)
## n.obs = 324 of which 324 are complete cases. Number of variables = 5 of which all are numeric TRUE
## variable # n.obs type H1 T1
## fecha* 1 324 4 2021-07-22 2022-02-07
## printel 2 324 1 0 0
## mahle 3 324 1 2.65 3
## magna 4 324 1 0 0
## varroc 5 324 1 0 0
#La base de datos de “Performance” cuenta con 5 variables y 324 registros en cada columna, siendo 1,620 registros totales.
Variable_performance<-c(“Fecha”, “Printel”, “Mahle”, “Magna”, “Varroc”) Tipo_performance<-c(“Cualitativa”, “Cuantitativa continua”, “Cuantitativa continua”, “Cuantitativa continua”, “Cuantitativa continua”) Medida_performance <-c(“NA”, “Minutos”, “Minutos”, “Minutos”, “Minutos”) tabla2<-data.frame(Variable_performance,Tipo_performance, Medida_performance) tabla2 knitr::kable(tabla2)
ggplot(performance,aes(x=fecha))+
geom_line(aes(y=printel),color="blue")+
geom_line(aes(y=mahle),color="orange")+
geom_line(aes(y=magna),color="green")+
geom_line(aes(y=varroc),color="green")+
labs(x="Fecha",y="Retraso en horas", color="Legend")+
ggtitle("Retrasos de entrega por cliente")
En esta gráfica podemos observar que FORM con los clientes Magna
y Varroc no presentan horas de retraso en sus pedidos (lo cual
se puede deber a que Varroc por ejemplo es su principal cliente pues es
el que más pedidos le hace) sin embargo, con Mahle y Printel si
han presentado retrasos considerables prinicipalmente dentro del primer
trimestre del 2022. Teniendo retrasos de hasta 20 horas.
media_printel <- mean(performance$printel)
media_printel
## [1] 0.4077469
media_mahle <- mean(performance$mahle)
media_mahle
## [1] 2.413333
media_magna <- mean(performance$magna)
media_magna
## [1] 0
media_varroc <- mean(performance$varroc)
media_varroc
## [1] 0
mediana_printel <- median(performance$printel)
mediana_printel
## [1] 0
mediana_mahle <- median(performance$mahle)
mediana_mahle
## [1] 3
mediana_magna <- median(performance$magna)
mediana_magna
## [1] 0
mediana_varroc <- median(performance$varroc)
mediana_varroc
## [1] 0
mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
moda_printel <- mode(performance$printel)
moda_printel
## [1] 0
moda_mahle <- mode(performance$mahle)
moda_mahle
## [1] 3
moda_magna <- mode(performance$magna)
moda_magna
## [1] 0
moda_varroc <- mode(performance$varroc)
moda_varroc
## [1] 0
varianza_printel <-var(performance$printel)
varianza_printel
## [1] 0.5649085
varianza_mahle <-var(performance$mahle)
varianza_mahle
## [1] 3.635233
varianza_magna <-var(performance$magna)
varianza_magna
## [1] 0
varianza_varroc <-var(performance$varroc)
varianza_varroc
## [1] 0
desviacion_printel <- sqrt(varianza_printel)
desviacion_printel
## [1] 0.751604
desviacion_mahle <- sqrt(varianza_mahle)
desviacion_mahle
## [1] 1.906629
desviacion_magna <- sqrt(varianza_magna)
desviacion_magna
## [1] 0
desviacion_varroc <- sqrt(varianza_varroc)
desviacion_varroc
## [1] 0
Variable_del_performance <-c("Printel","Mahle", "Magna", "Varroc")
Promedio_performance <-c("0.4077", "2.41","0", "0")
Moda_performance <-c("0","3","0", "0")
Mediana_performance <-c("0","3","0", "0")
Desviación_Est_performance <-c ("0.751","1.906","0", "0")
tabla1 <-data.frame(Variable_del_performance,Promedio_performance, Moda_performance, Mediana_performance, Desviación_Est_performance)
tabla1
## Variable_del_performance Promedio_performance Moda_performance
## 1 Printel 0.4077 0
## 2 Mahle 2.41 3
## 3 Magna 0 0
## 4 Varroc 0 0
## Mediana_performance Desviación_Est_performance
## 1 0 0.751
## 2 3 1.906
## 3 0 0
## 4 0 0
knitr::kable(tabla1)
| Variable_del_performance | Promedio_performance | Moda_performance | Mediana_performance | Desviación_Est_performance |
|---|---|---|---|---|
| Printel | 0.4077 | 0 | 0 | 0.751 |
| Mahle | 2.41 | 3 | 3 | 1.906 |
| Magna | 0 | 0 | 0 | 0 |
| Varroc | 0 | 0 | 0 | 0 |
De estos estadísticos descriptivos podemos destacar principalmente los siguientes hallazgos:
# file.choose()
bd4 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\FORM BASES DE DATOS\\PRODUCCION_BD.csv")
produccion <- clean_names(bd4)
summary(produccion)
## fecha cliente id_form producto
## Length:3988 Length:3988 Length:3988 Length:3988
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## piezas_prog tmo_min hr_fin estacion_arranque
## Length:3988 Length:3988 Length:3988 Length:3988
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## laminas_procesadas inicio_sep_up fin_inicio_de_sep_up inicio_de_proceso
## Min. : 0 Length:3988 Length:3988 Length:3988
## 1st Qu.: 0 Class :character Class :character Class :character
## Median : 51 Mode :character Mode :character Mode :character
## Mean : 102
## 3rd Qu.: 184
## Max. :1263
##
## fin_de_proceso tiempo_calidad tiempo_materiales
## Length:3988 Length:3988 Min. : 0.000
## Class :character Class :character 1st Qu.: 0.000
## Mode :character Mode :character Median : 0.000
## Mean : 3.187
## 3rd Qu.: 1.000
## Max. :60.000
## NA's :3491
produccion <- subset(produccion,select = -c (id_form, producto, hr_fin, inicio_sep_up, fin_inicio_de_sep_up, inicio_de_proceso, fin_de_proceso, tiempo_materiales))
produccion$piezas_prog <- str_replace(produccion$piezas_prog, "[aeiouLAM=NbBsS]", "")
produccion$piezas_prog <- as.integer(produccion$laminas_procesadas)
produccion$piezas_prog<-as.numeric(produccion$piezas_prog)
produccion$tmo_min<-as.numeric(produccion$tmo_min)
produccion$laminas_procesadas<-as.numeric(produccion$laminas_procesadas)
produccion$tiempo_calidad<-as.numeric(produccion$tiempo_calidad)
produccion$fecha <- as.Date(produccion$fecha, format = "%d/%m/%Y")
produccion$cliente<-as.factor(produccion$cliente)
produccion$estacion_arranque<-as.factor(produccion$estacion_arranque)
summary(produccion)
## fecha cliente piezas_prog tmo_min
## Min. :2022-07-15 STABILUS 1:1343 Min. : 0 Min. : 0.00
## 1st Qu.:2022-08-03 TRMX : 686 1st Qu.: 0 1st Qu.: 15.00
## Median :2022-08-20 STABILUS 3: 599 Median : 51 Median : 20.00
## Mean :2022-08-19 YANFENG : 431 Mean : 102 Mean : 22.37
## 3rd Qu.:2022-09-06 DENSO : 400 3rd Qu.: 184 3rd Qu.: 25.00
## Max. :2022-09-21 (Other) : 528 Max. :1263 Max. :150.00
## NA's : 1 NA's :824
## estacion_arranque laminas_procesadas tiempo_calidad
## TROQUEL.: 503 Min. : 0 Min. : 0.0000
## ROTATIVA: 492 1st Qu.: 0 1st Qu.: 0.0000
## TROQUEL : 463 Median : 51 Median : 1.0000
## CAJAS : 328 Mean : 102 Mean : 0.8631
## C1Y2 : 306 3rd Qu.: 184 3rd Qu.: 1.0000
## C3 : 306 Max. :1263 Max. :22.0000
## (Other) :1590 NA's :346
produccion$tmo_min[is.na(produccion$tmo_min)]<-median(produccion$tmo_min, na.rm = TRUE)
produccion$tiempo_calidad[is.na(produccion$tiempo_calidad)]<-median(produccion$tiempo_calidad, na.rm = TRUE)
summary(produccion)
## fecha cliente piezas_prog tmo_min
## Min. :2022-07-15 STABILUS 1:1343 Min. : 0 Min. : 0.00
## 1st Qu.:2022-08-03 TRMX : 686 1st Qu.: 0 1st Qu.: 15.00
## Median :2022-08-20 STABILUS 3: 599 Median : 51 Median : 20.00
## Mean :2022-08-19 YANFENG : 431 Mean : 102 Mean : 21.88
## 3rd Qu.:2022-09-06 DENSO : 400 3rd Qu.: 184 3rd Qu.: 25.00
## Max. :2022-09-21 (Other) : 528 Max. :1263 Max. :150.00
## NA's : 1
## estacion_arranque laminas_procesadas tiempo_calidad
## TROQUEL.: 503 Min. : 0 Min. : 0.000
## ROTATIVA: 492 1st Qu.: 0 1st Qu.: 1.000
## TROQUEL : 463 Median : 51 Median : 1.000
## CAJAS : 328 Mean : 102 Mean : 0.875
## C1Y2 : 306 3rd Qu.: 184 3rd Qu.: 1.000
## C3 : 306 Max. :1263 Max. :22.000
## (Other) :1590
produccion <- na.omit(produccion)
summary(produccion)
## fecha cliente piezas_prog tmo_min
## Min. :2022-07-15 STABILUS 1:1343 Min. : 0 Min. : 0.00
## 1st Qu.:2022-08-03 TRMX : 686 1st Qu.: 0 1st Qu.: 15.00
## Median :2022-08-20 STABILUS 3: 599 Median : 51 Median : 20.00
## Mean :2022-08-19 YANFENG : 431 Mean : 102 Mean : 21.88
## 3rd Qu.:2022-09-06 DENSO : 400 3rd Qu.: 184 3rd Qu.: 25.00
## Max. :2022-09-21 VARROC : 269 Max. :1263 Max. :150.00
## (Other) : 259
## estacion_arranque laminas_procesadas tiempo_calidad
## TROQUEL.: 503 Min. : 0 Min. : 0.0000
## ROTATIVA: 492 1st Qu.: 0 1st Qu.: 1.0000
## TROQUEL : 463 Median : 51 Median : 1.0000
## CAJAS : 328 Mean : 102 Mean : 0.8749
## C3 : 306 3rd Qu.: 184 3rd Qu.: 1.0000
## C1Y2 : 305 Max. :1263 Max. :22.0000
## (Other) :1590
bd_Produccion_limpia <- produccion
write.csv(bd_Produccion_limpia, file="bd_produccion_limpia.csv", row.names = FALSE)
describeData(produccion,head=1,tail=1)
## n.obs = 3987 of which 3987 are complete cases. Number of variables = 7 of which all are numeric TRUE
## variable # n.obs type H1 T1
## fecha* 1 3987 4 2022-07-16 2022-09-07
## cliente* 2 3987 2 TRMX
## piezas_prog 3 3987 1 3 0
## tmo_min 4 3987 1 10 20
## estacion_arranque* 5 3987 2 C1Y2 ROTATIVA
## laminas_procesadas 6 3987 1 3 0
## tiempo_calidad 7 3987 1 1 1
La base de datos de “Producción” cuenta con 7 variables y 3,987 registros en cada columna, siendo 27,909 registros totales.
Variable_produccion<-c("Fecha", "Cliente", "Piezas Programadas", "Tiempo Mínimo", "Estación Arranque", "Láminas Procesadas", "Tiempo de Calidad")
Tipo_produccion<-c("Cualitativa", "Cualitativa", "Cuantitativa continua", "Cuantitativa continua", "Cualitativa", "Cuantitativa continua", "Cuantitativa continua")
Medida_produccion <-c("NA", "NA", "Unidades", "Minutos", "Na", "Unidades", "Minutos")
tabla4<-data.frame(Variable_produccion,Tipo_produccion, Medida_produccion)
tabla4
## Variable_produccion Tipo_produccion Medida_produccion
## 1 Fecha Cualitativa NA
## 2 Cliente Cualitativa NA
## 3 Piezas Programadas Cuantitativa continua Unidades
## 4 Tiempo Mínimo Cuantitativa continua Minutos
## 5 Estación Arranque Cualitativa Na
## 6 Láminas Procesadas Cuantitativa continua Unidades
## 7 Tiempo de Calidad Cuantitativa continua Minutos
knitr::kable(tabla4)
| Variable_produccion | Tipo_produccion | Medida_produccion |
|---|---|---|
| Fecha | Cualitativa | NA |
| Cliente | Cualitativa | NA |
| Piezas Programadas | Cuantitativa continua | Unidades |
| Tiempo Mínimo | Cuantitativa continua | Minutos |
| Estación Arranque | Cualitativa | Na |
| Láminas Procesadas | Cuantitativa continua | Unidades |
| Tiempo de Calidad | Cuantitativa continua | Minutos |
hist(produccion$piezas_prog, main = "Piezas producidas", ylab = "Frecuencia", xlab = "Piezas Programadas", col = "lightblue")
mean (produccion$piezas_prog)
## [1] 102.0105
En este gráfica podemos observar que es más común producir tandas menores a 300 piezas por cliente, pero en promedio se producen 102.08 piezas por pedido.
plot(produccion$tiempo_calidad, produccion$tmo_min, main = "Tiempo de calidad invertido por tiempo de producción", xlab = "Tiempo de Calidad", ylab = "Tiempo de Producción", col= "blue")
En esta gráfica podemos observar que a un tiempo menor de 50h de
producción, hay una mucha mayor inversión de tiempo de calidad.
Y a un tiempo mayor a 60 horas, hay una mucha menor inversión de
tiempo de calidad. Lo que significa que entre más se tarden
haciendo un producto, menos horas de calidad le invierten, esto se
puede deber a que como el proceso es más largo, le invierten más cuidado
en cada paso, y cuando es más corto el proceso puede ser mas rutinario y
es necesario invertirle horas extra a asegurarse que se haya producido
correctamente.
ggplot(produccion,aes(x=fecha))+
geom_line(aes(y=piezas_prog),color="blue")+
labs(x="Fecha",y="piezas programadas", color="blue")+
ggtitle("Grafica de las piezas programadas por fecha")
En este gráfico se muestra la producción de piezas programadas en los 3 diferentes meses (julio, agosto, septiembre), donde se puede ver que hubo mayor producción en lo que fue agosto.
ggplot(data=produccion, mapping = aes(piezas_prog, laminas_procesadas)) + geom_point(aes(color = tmo_min)) + theme_bw()
Aquí podemos observar que hay una relación lineal positiva entre las piezas producidas y la cantidad de laminas utilizadas (materia prima) realizadas en un tiempo menor a 50 horas en su mayoría.
ggplot(produccion, aes(x=piezas_prog, y=cliente)) +
geom_point()
En esta tabla podemos observar las veces que aparece el cliente en la base de datos de producción, viendo asi que “Stabilius 1” es el cliente que más pedidos le ordena a FORM. Seguido por TRMX, YANFENG y DENSO.
Sin embargo, en la gráfica hecha a continuación se puede observar que YANFENG es el cliente que ha hecho pedidos de más cantidad de piezas.
media_piezas_prog<- mean(produccion$piezas_prog)
media_piezas_prog
## [1] 102.0105
media_tmo_min<- mean(produccion$tmo_min)
media_tmo_min
## [1] 21.88362
media_laminas_procesadas <- mean(produccion$laminas_procesadas)
media_laminas_procesadas
## [1] 102.0105
media_tiempo_calidad<- mean(produccion$tiempo_calidad)
media_tiempo_calidad
## [1] 0.8749436
median_piezas_prog<- median(produccion$piezas_prog)
median_piezas_prog
## [1] 51
median_tmo_min<- median(produccion$tmo_min)
median_tmo_min
## [1] 20
median_laminas_procesadas <- median(produccion$laminas_procesadas)
median_laminas_procesadas
## [1] 51
median_tiempo_calidad<- median(produccion$tiempo_calidad)
median_tiempo_calidad
## [1] 1
mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
moda_piezas_prog <- mode(produccion$piezas_prog)
moda_piezas_prog
## [1] 0
moda_tmo_min <- mode(produccion$tmo_min)
moda_tmo_min
## [1] 20
moda_laminas_procesadas<- mode(produccion$laminas_procesadas)
moda_laminas_procesadas
## [1] 0
moda_tiempo_calidad <- mode(produccion$tiempo_calidad)
moda_tiempo_calidad
## [1] 1
varianza_piezas_prog <-var(produccion$piezas_prog)
varianza_piezas_prog
## [1] 18060.56
varianza_tmo_min <-var(produccion$tmo_min)
varianza_tmo_min
## [1] 143.29
varianza_laminas_procesadas<-var(produccion$laminas_procesadas)
varianza_laminas_procesadas
## [1] 18060.56
varianza_tiempo_calidad <-var(produccion$tiempo_calidad)
varianza_tiempo_calidad
## [1] 0.9836445
desviacion_piezas_prog<- sqrt(varianza_piezas_prog)
desviacion_piezas_prog
## [1] 134.3896
desviacion_tmo_min <- sqrt(varianza_tmo_min)
desviacion_tmo_min
## [1] 11.97038
desviacion_laminas_procesadas <- sqrt(varianza_laminas_procesadas)
desviacion_laminas_procesadas
## [1] 134.3896
desviacion_tiempo_calidad <- sqrt(varianza_tiempo_calidad)
desviacion_tiempo_calidad
## [1] 0.9917885
Variable_prod <-c("Piezas Programadas","Tiempo Mínimo ", "Láminas Procesadas", "Tiempo Calidad")
Promedio_prod <-c("102.08", "21.89","102.08", "0.875")
Moda_prod <-c("0", "20","0", "1")
Mediana_prod <-c("51","20","51", "1")
Desviación_Estándar_prod <-c ("134.411","11.971","134.311", "0.991")
tabla5 <-data.frame(Variable_prod,Promedio_prod, Moda_prod, Mediana_prod, Desviación_Estándar_prod)
tabla5
## Variable_prod Promedio_prod Moda_prod Mediana_prod
## 1 Piezas Programadas 102.08 0 51
## 2 Tiempo Mínimo 21.89 20 20
## 3 Láminas Procesadas 102.08 0 51
## 4 Tiempo Calidad 0.875 1 1
## Desviación_Estándar_prod
## 1 134.411
## 2 11.971
## 3 134.311
## 4 0.991
knitr::kable(tabla5)
| Variable_prod | Promedio_prod | Moda_prod | Mediana_prod | Desviación_Estándar_prod |
|---|---|---|---|---|
| Piezas Programadas | 102.08 | 0 | 51 | 134.411 |
| Tiempo Mínimo | 21.89 | 20 | 20 | 11.971 |
| Láminas Procesadas | 102.08 | 0 | 51 | 134.311 |
| Tiempo Calidad | 0.875 | 1 | 1 | 0.991 |
De estos estadísticos descriptivos podemos destacar principalmente los siguientes hallazgos:
FORM tiene la cantidad de prima exacta para hacer sus piezas programadas, pues sus estadísticos descriptivos son iguales.
El tiempo de producción aproximado (media-mediana-moda) es de 20 horas por pedido.
FORM le invierte mínimo tiempo de calidad a su producción (1 hora o menos por pedido).
# file.choose()
bd5 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\FORM BASES DE DATOS\\FORM - Merma (2).csv")
merma <- clean_names(bd5)
summary(merma)
## fecha mes kilos
## Length:50 Length:50 Min. : 790
## Class :character Class :character 1st Qu.:3178
## Mode :character Mode :character Median :3925
## Mean :3709
## 3rd Qu.:4232
## Max. :6140
merma$kilos<-as.numeric(merma$kilos)
merma$fecha <- as.Date(merma$fecha, format = "%d/%m/%Y")
merma$mes<-as.factor(merma$mes)
summary(merma)
## fecha mes kilos
## Min. :2022-01-11 AGOSTO :11 Min. : 790
## 1st Qu.:2022-03-12 FEBRERO: 6 1st Qu.:3178
## Median :2022-05-24 MARZO : 6 Median :3925
## Mean :2022-05-25 ABRIL : 5 Mean :3709
## 3rd Qu.:2022-08-10 JULIO : 5 3rd Qu.:4232
## Max. :2022-09-21 MAYO : 5 Max. :6140
## (Other):12
write.csv(merma, file ="merma_bd_limpia.csv", row.names = FALSE)
describeData(merma,head=1,tail=1)
## n.obs = 50 of which 50 are complete cases. Number of variables = 3 of which all are numeric TRUE
## variable # n.obs type H1 T1
## fecha* 1 50 4 2022-01-11 2022-09-21
## mes* 2 50 2 ENERO SEPTIEMBRE
## kilos 3 50 1 5080 3739
La base de datos de “Merma” cuenta con 3 variables y 50 registros en cada columna, siendo 150 registros totales.
Variable_merma<-c("Fecha", "Mes", "Kilos")
Tipo_merma<-c("Cualitativa", "Cualitativa", "Cuantitativa continua")
Medida_merma <-c("NA", "NA", "Kilogramos")
tabla6<-data.frame(Variable_merma,Tipo_merma, Medida_merma)
tabla6
## Variable_merma Tipo_merma Medida_merma
## 1 Fecha Cualitativa NA
## 2 Mes Cualitativa NA
## 3 Kilos Cuantitativa continua Kilogramos
knitr::kable(tabla6)
| Variable_merma | Tipo_merma | Medida_merma |
|---|---|---|
| Fecha | Cualitativa | NA |
| Mes | Cualitativa | NA |
| Kilos | Cuantitativa continua | Kilogramos |
ggplot(merma, aes(x=mes, y=kilos)) +
geom_bar(stat="identity", fill="orange") + scale_fill_grey() +
labs(title = "Relación de los kilos de merma en el mes",
subtitle = "Merma empresa FORM",
caption = "Relación",
x = "Mes")
Se observa que el mes en el que más se genero merma fue en
Agosto, seguido por Febrero y Mayo. El mes que menos
generó merma fue Septiembre y Enero.
par(new = TRUE)
boxplot(merma$kilos,
horizontal = FALSE,
lwd = 2,
col = rgb(1, 0, 0, alpha = 0.4),
xlab = "Meses",
ylab = "Kilos de Merma",
main = "Promedio de kilos de merma producidos",
notch = TRUE,
border = "black",
outpch = 25,
outbg = "green",
whiskcol = "blue",
whisklty = 2,
lty = 1)
En esta gráfica podemos observar el promedio de merma generada en todos los meses que está aprox en los 4000 kilos. Sin embargo, han habido veces que se llegan a generar menos de 1000 kilos o hasta 6000 kilos.
media_kilos <- mean(merma$kilos)
media_kilos
## [1] 3708.52
mediana_kilos <- median(merma$kilos)
mediana_kilos
## [1] 3925
mode <- function (x) {
ux <- unique(x)
ux [which.max(tabulate(match(x,ux)))]
}
moda_kilos <- mode(merma$kilos)
moda_kilos
## [1] 3810
varianza_kilos <- var(merma$kilos)
varianza_kilos
## [1] 1048555
desviacionestandar_kilos <- sqrt(varianza_kilos)
desviacionestandar_kilos
## [1] 1023.99
Variable_merma1<-c("Kilos")
Media_merma<-c("3708.52")
Mediana_merma<-c("3925")
Moda_merma<-c("3810")
Desviacion_Estandar_merma<-c("1023.99")
tabla7<-data.frame(Variable_merma1,Media_merma,Mediana_merma,Moda_merma,Desviacion_Estandar_merma)
knitr::kable(tabla7)
| Variable_merma1 | Media_merma | Mediana_merma | Moda_merma | Desviacion_Estandar_merma |
|---|---|---|---|---|
| Kilos | 3708.52 | 3925 | 3810 | 1023.99 |
De estos estadísticos descriptivos podemos destacar principalmente los siguientes hallazgos:
bd6 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\FORM BASES DE DATOS\\FORM - Scrap.csv")
scrap <- clean_names(bd6)
summary(scrap)
## referencia fecha producto cantidad
## Length:250 Length:250 Length:250 Min. : 0.000
## Class :character Class :character Class :character 1st Qu.: 1.000
## Mode :character Mode :character Mode :character Median : 2.000
## Mean : 6.696
## 3rd Qu.: 7.000
## Max. :96.000
## unidad_de_medida ubicacion_de_origen ubicacion_de_desecho estado
## Length:250 Length:250 Length:250 Length:250
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
scrap <- subset(scrap, select = -c (referencia, producto, ubicacion_de_desecho, estado, unidad_de_medida))
scrap$cantidad<-as.numeric(scrap$cantidad)
scrap$fecha <- as.Date(scrap$fecha, format = "%d/%m/%Y")
scrap$ubicacion_de_origen<-as.factor(scrap$ubicacion_de_origen)
summary(scrap)
## fecha cantidad ubicacion_de_origen
## Min. :2022-08-01 Min. : 0.000 Calidad/Entrega de PT: 58
## 1st Qu.:2022-08-11 1st Qu.: 1.000 Post-Production : 13
## Median :2022-08-19 Median : 2.000 Pre-Production :179
## Mean :2022-08-17 Mean : 6.696
## 3rd Qu.:2022-08-25 3rd Qu.: 7.000
## Max. :2022-08-31 Max. :96.000
write.csv(scrap, file ="scrap_bd_limpia.csv", row.names = FALSE)
describeData(scrap,head=1,tail=1)
## n.obs = 250 of which 250 are complete cases. Number of variables = 3 of which all are numeric TRUE
## variable # n.obs type H1 T1
## fecha* 1 250 4 2022-08-06 2022-08-05
## cantidad 2 250 1 43 7
## ubicacion_de_origen* 3 250 2 Pre-Production Post-Production
La base de datos de “Scrap” cuenta con 3 variables y 250 registros en cada columna, siendo 750 registros totales.
Variable_scrap<-c("Fecha", "Cantidad", "Ubicación de Origen")
Tipo_scrap<-c("Cualitativa", "Cuantitativa continua", "Cualitativa")
Medida_scrap <-c("NA", "Kilogramos", "NA")
tabla8<-data.frame(Variable_scrap,Tipo_scrap, Medida_scrap)
tabla8
## Variable_scrap Tipo_scrap Medida_scrap
## 1 Fecha Cualitativa NA
## 2 Cantidad Cuantitativa continua Kilogramos
## 3 Ubicación de Origen Cualitativa NA
knitr::kable(tabla8)
| Variable_scrap | Tipo_scrap | Medida_scrap |
|---|---|---|
| Fecha | Cualitativa | NA |
| Cantidad | Cuantitativa continua | Kilogramos |
| Ubicación de Origen | Cualitativa | NA |
boxplot(scrap$cantidad ~ scrap$ubicacion_de_origen,
col = rainbow(ncol(trees)))
Con esta gráfica podemos observar que la cantidad de unidades
producidas está normalmente ubicada en “Pre-Producción” y asimismo esta
categoría es la más dispersa.
media_cantidad <- mean(scrap$cantidad)
media_cantidad
## [1] 6.696
mediana_cantidad <- median(scrap$cantidad)
mediana_cantidad
## [1] 2
mode <- function (x) {
ux <- unique(x)
ux [which.max(tabulate(match(x,ux)))]
}
moda_cantidad <- mode(scrap$cantidad)
moda_cantidad
## [1] 1
varianza_cantidad <- var(scrap$cantidad)
varianza_cantidad
## [1] 140.3952
desviacionestandar_cantidad <- sqrt(varianza_cantidad)
desviacionestandar_cantidad
## [1] 11.84885
Variable_scrap1<-c("Cantidad")
Media_scrap<-c("6.96")
Mediana_scrap<-c("2")
Moda_scrap<-c("140.39")
Desviacion_Estandar_scrap<-c("11.848")
tabla9<-data.frame(Variable_scrap1,Media_scrap,Mediana_scrap,Moda_scrap,Desviacion_Estandar_scrap)
knitr::kable(tabla9)
| Variable_scrap1 | Media_scrap | Mediana_scrap | Moda_scrap | Desviacion_Estandar_scrap |
|---|---|---|---|---|
| Cantidad | 6.96 | 2 | 140.39 | 11.848 |
De estos estadísticos descriptivos podemos destacar principalmente los siguientes hallazgos:
# file.choose()
bd8 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\EVI2\\bd externa.csv")
bd_externa <- clean_names(bd8)
summary(bd_externa)
## state_id state region industry_group_id
## Min. : 1.00 Length:24 Min. :1.000 Min. :3221
## 1st Qu.:10.75 Class :character 1st Qu.:1.000 1st Qu.:3221
## Median :18.00 Mode :character Median :2.000 Median :3221
## Mean :17.62 Mean :2.333 Mean :3221
## 3rd Qu.:25.25 3rd Qu.:3.000 3rd Qu.:3221
## Max. :31.00 Max. :4.000 Max. :3221
## industry_group economic_unit
## Length:24 Min. : 1.00
## Class :character 1st Qu.: 1.75
## Mode :character Median : 5.00
## Mean : 13.17
## 3rd Qu.: 8.75
## Max. :151.00
bd_externa$state_id<-as.numeric(bd_externa$state_id)
bd_externa$state<-as.factor(bd_externa$state)
bd_externa$region<-as.numeric(bd_externa$region)
bd_externa$industry_group_id<-as.numeric(bd_externa$industry_group_id)
bd_externa$industry_group<-as.factor(bd_externa$industry_group)
bd_externa$economic_unit<-as.numeric(bd_externa$economic_unit)
summary(bd_externa)
## state_id state region industry_group_id
## Min. : 1.00 Aguascalientes : 1 Min. :1.000 Min. :3221
## 1st Qu.:10.75 Baja California : 1 1st Qu.:1.000 1st Qu.:3221
## Median :18.00 Chihuahua : 1 Median :2.000 Median :3221
## Mean :17.62 Ciudad de Mexico : 1 Mean :2.333 Mean :3221
## 3rd Qu.:25.25 Coahuila de Zaragoza: 1 3rd Qu.:3.000 3rd Qu.:3221
## Max. :31.00 Durango : 1 Max. :4.000 Max. :3221
## (Other) :18
## industry_group economic_unit
## Fabricacion de Pulpa, Papel y Carton:24 Min. : 1.00
## 1st Qu.: 1.75
## Median : 5.00
## Mean : 13.17
## 3rd Qu.: 8.75
## Max. :151.00
##
describeData(bd_externa,head=1,tail=1)
## n.obs = 24 of which 24 are complete cases. Number of variables = 6 of which all are numeric TRUE
## variable # n.obs type H1
## state_id 1 24 1 1
## state* 2 24 2 Aguascalientes
## region 3 24 1 2
## industry_group_id 4 24 1 3221
## industry_group* 5 24 2 Fabricacion de Pulpa, Papel y Carton
## economic_unit 6 24 1 1
## T1
## state_id 31
## state* Yucatan
## region 4
## industry_group_id 3221
## industry_group* Fabricacion de Pulpa, Papel y Carton
## economic_unit 3
La base de datos externa cuenta con 6 variables y 24 registros en cada columna, siendo 144 registros totales.
Variable_carton<-c("State.ID","State","Region","Industry.Group.ID","Industry.Group", "Economic.Unit")
Tipo_carton<-c("Cualitativa", "Cualitativa","Cualitativa", "Cualitativa", "Cualitativa", "Cuantitativa (discreta)")
Medida_carton<-c("NA","NA","NA","NA","NA","Cartón producido")
tabla10<-data.frame(Variable_carton,Tipo_carton,Medida_carton)
knitr::kable(tabla10)
| Variable_carton | Tipo_carton | Medida_carton |
|---|---|---|
| State.ID | Cualitativa | NA |
| State | Cualitativa | NA |
| Region | Cualitativa | NA |
| Industry.Group.ID | Cualitativa | NA |
| Industry.Group | Cualitativa | NA |
| Economic.Unit | Cuantitativa (discreta) | Cartón producido |
prop.table(table(bd_externa$state, bd_externa$economic_unit))
##
## 1 2 3 5
## Aguascalientes 0.04166667 0.00000000 0.00000000 0.00000000
## Baja California 0.00000000 0.00000000 0.00000000 0.00000000
## Chihuahua 0.00000000 0.00000000 0.00000000 0.00000000
## Ciudad de Mexico 0.00000000 0.00000000 0.00000000 0.00000000
## Coahuila de Zaragoza 0.04166667 0.00000000 0.00000000 0.00000000
## Durango 0.00000000 0.04166667 0.00000000 0.00000000
## Estado de Mexico 0.00000000 0.00000000 0.00000000 0.00000000
## Guanajuato 0.00000000 0.00000000 0.00000000 0.00000000
## Hidalgo 0.00000000 0.00000000 0.04166667 0.00000000
## Jalisco 0.00000000 0.00000000 0.00000000 0.00000000
## Michoacan de Ocampo 0.00000000 0.00000000 0.04166667 0.00000000
## Morelos 0.04166667 0.00000000 0.00000000 0.00000000
## Nuevo Leon 0.00000000 0.00000000 0.00000000 0.00000000
## Oaxaca 0.04166667 0.00000000 0.00000000 0.00000000
## Puebla 0.00000000 0.00000000 0.00000000 0.00000000
## Queretaro 0.00000000 0.00000000 0.00000000 0.04166667
## San Luis Potosi 0.00000000 0.00000000 0.00000000 0.00000000
## Sinaloa 0.00000000 0.00000000 0.00000000 0.04166667
## Sonora 0.00000000 0.00000000 0.00000000 0.04166667
## Tabasco 0.04166667 0.00000000 0.00000000 0.00000000
## Tamaulipas 0.04166667 0.00000000 0.00000000 0.00000000
## Tlaxcala 0.00000000 0.00000000 0.04166667 0.00000000
## Veracruz de Ignacio de la Llave 0.00000000 0.00000000 0.00000000 0.00000000
## Yucatan 0.00000000 0.00000000 0.04166667 0.00000000
##
## 6 8 11 13
## Aguascalientes 0.00000000 0.00000000 0.00000000 0.00000000
## Baja California 0.00000000 0.04166667 0.00000000 0.00000000
## Chihuahua 0.04166667 0.00000000 0.00000000 0.00000000
## Ciudad de Mexico 0.00000000 0.00000000 0.00000000 0.00000000
## Coahuila de Zaragoza 0.00000000 0.00000000 0.00000000 0.00000000
## Durango 0.00000000 0.00000000 0.00000000 0.00000000
## Estado de Mexico 0.00000000 0.00000000 0.00000000 0.00000000
## Guanajuato 0.00000000 0.00000000 0.04166667 0.00000000
## Hidalgo 0.00000000 0.00000000 0.00000000 0.00000000
## Jalisco 0.00000000 0.00000000 0.00000000 0.04166667
## Michoacan de Ocampo 0.00000000 0.00000000 0.00000000 0.00000000
## Morelos 0.00000000 0.00000000 0.00000000 0.00000000
## Nuevo Leon 0.00000000 0.00000000 0.00000000 0.00000000
## Oaxaca 0.00000000 0.00000000 0.00000000 0.00000000
## Puebla 0.00000000 0.00000000 0.00000000 0.00000000
## Queretaro 0.00000000 0.00000000 0.00000000 0.00000000
## San Luis Potosi 0.04166667 0.00000000 0.00000000 0.00000000
## Sinaloa 0.00000000 0.00000000 0.00000000 0.00000000
## Sonora 0.00000000 0.00000000 0.00000000 0.00000000
## Tabasco 0.00000000 0.00000000 0.00000000 0.00000000
## Tamaulipas 0.00000000 0.00000000 0.00000000 0.00000000
## Tlaxcala 0.00000000 0.00000000 0.00000000 0.00000000
## Veracruz de Ignacio de la Llave 0.04166667 0.00000000 0.00000000 0.00000000
## Yucatan 0.00000000 0.00000000 0.00000000 0.00000000
##
## 17 20 43 151
## Aguascalientes 0.00000000 0.00000000 0.00000000 0.00000000
## Baja California 0.00000000 0.00000000 0.00000000 0.00000000
## Chihuahua 0.00000000 0.00000000 0.00000000 0.00000000
## Ciudad de Mexico 0.04166667 0.00000000 0.00000000 0.00000000
## Coahuila de Zaragoza 0.00000000 0.00000000 0.00000000 0.00000000
## Durango 0.00000000 0.00000000 0.00000000 0.00000000
## Estado de Mexico 0.00000000 0.00000000 0.04166667 0.00000000
## Guanajuato 0.00000000 0.00000000 0.00000000 0.00000000
## Hidalgo 0.00000000 0.00000000 0.00000000 0.00000000
## Jalisco 0.00000000 0.00000000 0.00000000 0.00000000
## Michoacan de Ocampo 0.00000000 0.00000000 0.00000000 0.00000000
## Morelos 0.00000000 0.00000000 0.00000000 0.00000000
## Nuevo Leon 0.00000000 0.04166667 0.00000000 0.00000000
## Oaxaca 0.00000000 0.00000000 0.00000000 0.00000000
## Puebla 0.00000000 0.00000000 0.00000000 0.04166667
## Queretaro 0.00000000 0.00000000 0.00000000 0.00000000
## San Luis Potosi 0.00000000 0.00000000 0.00000000 0.00000000
## Sinaloa 0.00000000 0.00000000 0.00000000 0.00000000
## Sonora 0.00000000 0.00000000 0.00000000 0.00000000
## Tabasco 0.00000000 0.00000000 0.00000000 0.00000000
## Tamaulipas 0.00000000 0.00000000 0.00000000 0.00000000
## Tlaxcala 0.00000000 0.00000000 0.00000000 0.00000000
## Veracruz de Ignacio de la Llave 0.00000000 0.00000000 0.00000000 0.00000000
## Yucatan 0.00000000 0.00000000 0.00000000 0.00000000
En esta tabla de frecuencia podemos obsevar que el estado que más produce cartón es Puebla (151 unidades promedio por empleado), seguido de Estado de México (43 unidades por empleado) y Nuevo León (20 unidades por empleado).
table(bd_externa$region)
##
## 1 2 3 4
## 7 6 7 4
proporciones_ext <- c(7, 6, 7, 4)
etiquetas_ext <- c("Norte", "Centro/Oeste", "Centro", "Sur")
pct_ext <- round(proporciones_ext/sum(proporciones_ext)*100)
etiquetas_ext <- paste(etiquetas_ext, pct_ext)
etiquetas_ext <- paste(etiquetas_ext,"%",sep="")
pie(proporciones_ext,labels = etiquetas_ext,
col=rainbow(length(etiquetas_ext)),
main="Porcentaje de estados en México por regiones")
En esta gráfica se puede observar que la región Norte y Centro cuentan con más estados, seguido por la región Centro/Oeste y por último la región Sur. Esto quiere decir que la probabilidad de que haya más producción por parte de las primeras dos regiones mencionadas es mayor.
table(bd_externa$economic_unit)
##
## 1 2 3 5 6 8 11 13 17 20 43 151
## 6 1 4 3 3 1 1 1 1 1 1 1
proporciones_uni <- c(6, 1, 4, 3, 3, 1, 1, 1, 1, 1, 1, 1)
etiquetas_uni <- c("1", "2", "3", "5", "6", "8", "11", "13", "17", "20", "43", "151")
pct_uni <- round(proporciones_uni/sum(proporciones_uni)*100)
etiquetas_uni <- paste(etiquetas_uni, pct_uni)
etiquetas_uni <- paste(etiquetas_uni,"%",sep="")
pie(proporciones_uni,labels = etiquetas_uni,
col=rainbow(length(etiquetas_uni)),
main="Producción de unidades promedio por empleado")
La gráfica anterior nos indica el porcentaje de la producción de unidades por promedio por empleado, por ejemplo el 25% de los empleados solo produce 1 unidad, seguido por el 17% de los empleados que producen 3 unidades, y así sucesivamente.
ggplot(data = bd_externa, mapping = aes(region, economic_unit)) + geom_point() + theme_bw()
En este caso, podemos ver que la región 3 la cual es la Centro,
cuenta con un valor atípico, el cual es Puebla con 151 unidades y es por
eso que es la región que produce más cartón en México.
boxplot(bd_externa$state_id ~ bd_externa$economic_unit, horizontal = TRUE)
En este boxplot se interpreta que muy pocos estados producen más
de 6 unidades promedio por empleado.
hist(x = bd_externa$region, main = "Estados por Región",
xlab = "Regiones", ylab = "Frecuencia",
col = "brown")
En esta gráfica de barra podemos observar que la región 1
(Norte) y región 3 (Centro) son los que más estados tienen
(teniendo 7 en total).
media_economic <- mean(bd_externa$economic_unit)
media_economic
## [1] 13.16667
mediana_economic <- median(bd_externa$economic_unit)
mediana_economic
## [1] 5
mode <- function (x) {
ux <- unique(x)
ux [which.max(tabulate(match(x,ux)))]
}
moda_economic <- mode(bd_externa$economic_unit)
moda_economic
## [1] 1
varianza_economic <- var(bd_externa$economic_unit)
varianza_economic
## [1] 946.1449
desviacionestandar_economic <- sqrt(varianza_economic)
desviacionestandar_economic
## [1] 30.75947
Variable_bdexterna<-c("Economic UnitS")
Media_bdexterna<-c("13.166")
Mediana_bdexterna<-c("5")
Moda_bdexterna<-c("1")
Desviacion_Estandar_bdexterna<-c("30.759")
tabla11<-data.frame(Variable_bdexterna,Media_bdexterna,Mediana_bdexterna,Moda_bdexterna,Desviacion_Estandar_bdexterna)
knitr::kable(tabla11)
| Variable_bdexterna | Media_bdexterna | Mediana_bdexterna | Moda_bdexterna | Desviacion_Estandar_bdexterna |
|---|---|---|---|---|
| Economic UnitS | 13.166 | 5 | 1 | 30.759 |
Realizar un programa de incentivos para los empleados con el objetivo de incrementar su PERMANENCIA en la empresa, ofreciendoles primeramente, un mejor sueldo al incrementar su rendimiento (especialmente a los ayudantes generales que son los que han reportado más bajas), o dándoles benficios adicionales como tarjetas de despensa o reconocimientos.
Estandarización y mejora del proceso de reclutamiento: Se han observado que los empleados que duran menos son los jóvenes ya que su sueldo no es muy bueno, por lo que se deberían buscar nuevos empleados que sean mayores o debería de haber un incremento de sueldo, asimismo, hablando sobre el género y estado civil, se puede observar que los empleados sin pareja son los que menos despiden (sino que suelen renunciar), deduciendo así que son los que más compromiso tienen con la empresa pues no se dan de baja en su mayoria por faltas como lo han hecho con los ex-colaboradores divorciados, casados y en unión libre. Es por esto qur FORM tiene que mejorar su proceso de selección, tomar en cuenta los insights descubiertos al reclutar e incrementar los beneficios dados a los empleados para disminuir la rotación.
FORM produce una cantidad considerable de merma en sus procesos, principalmente en la pre-producción, siendo un promedio de aprox. 3708.52 kilos por mes. Se propone implementar una mejora en este proceso para evitar la generación de tantos resiudos para de la misma manera, disminuir los gastos al aprovechar al máximo la materia prima e impactar positivamente al medio ambiente.
FORM debería prestar más atención en el tiempo de entrega con su cliente “MAHLE” principalmente, para reducir y evitar retrasos de entrega y cumplir con sus principios de “Rapidez” principalmente.
Contactar nuevos proveedores de cartón en Puebla, para diversificar la obtención de la materia prima y en caso de haber un desabasto o un icnremento de precio considerable, tener más opciones de compra.
Para próximas inversiones de nuevas plantas o sucursales de FORM, se propone invertir en lugares estratégicos, situados en estados de la región Norte y la región centro, ya que, es donde más producción de cartón existe.
Empoderamiento de los clientes sobre el seguimiento de sus pedidos, Seguimiento del producto desde el punto de partida hasta el final
Medición y mejora continua de la experiencia de los clientes.
# file.choose()
bd14 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\EVI2\\encoded-bd_prediccion.csv")
prediccion_mx <- clean_names(bd14)
summary(prediccion_mx)
## ano mes venta produccion
## Min. :2006 Min. : 1.00 Min. : 34927 Min. : 3722
## 1st Qu.:2010 1st Qu.: 3.00 1st Qu.: 78543 1st Qu.:189031
## Median :2014 Median : 6.00 Median : 88580 Median :248433
## Mean :2014 Mean : 6.42 Mean : 94178 Mean :241511
## 3rd Qu.:2018 3rd Qu.: 9.00 3rd Qu.:110134 3rd Qu.:292709
## Max. :2022 Max. :12.00 Max. :192741 Max. :382110
## NA's :2 NA's :2 NA's :2 NA's :2
## exportacion tipo_de_cambio inflacion porcentaje_ocu
## Min. : 15139 Min. :10.09 Min. :-0.250 Min. :93.58
## 1st Qu.:153219 1st Qu.:12.66 1st Qu.: 0.815 1st Qu.:95.06
## Median :209161 Median :13.56 Median : 1.480 Median :95.88
## Mean :201664 Mean :15.48 Mean : 1.951 Mean :95.76
## 3rd Qu.:243900 3rd Qu.:19.10 3rd Qu.: 2.895 3rd Qu.:96.47
## Max. :327454 Max. :24.24 Max. : 7.360 Max. :97.16
## NA's :2 NA's :2 NA's :2 NA's :2
## porcentaje_desocu conf_consumidor
## Min. :2.840 Min. :28.67
## 1st Qu.:3.527 1st Qu.:36.69
## Median :4.125 Median :38.47
## Mean :4.244 Mean :39.15
## 3rd Qu.:4.940 3rd Qu.:42.59
## Max. :6.420 Max. :47.83
## NA's :2 NA's :2
prediccion_mx <- subset(prediccion_mx, select = -c (produccion, venta))
summary(prediccion_mx)
## ano mes exportacion tipo_de_cambio
## Min. :2006 Min. : 1.00 Min. : 15139 Min. :10.09
## 1st Qu.:2010 1st Qu.: 3.00 1st Qu.:153219 1st Qu.:12.66
## Median :2014 Median : 6.00 Median :209161 Median :13.56
## Mean :2014 Mean : 6.42 Mean :201664 Mean :15.48
## 3rd Qu.:2018 3rd Qu.: 9.00 3rd Qu.:243900 3rd Qu.:19.10
## Max. :2022 Max. :12.00 Max. :327454 Max. :24.24
## NA's :2 NA's :2 NA's :2 NA's :2
## inflacion porcentaje_ocu porcentaje_desocu conf_consumidor
## Min. :-0.250 Min. :93.58 Min. :2.840 Min. :28.67
## 1st Qu.: 0.815 1st Qu.:95.06 1st Qu.:3.527 1st Qu.:36.69
## Median : 1.480 Median :95.88 Median :4.125 Median :38.47
## Mean : 1.951 Mean :95.76 Mean :4.244 Mean :39.15
## 3rd Qu.: 2.895 3rd Qu.:96.47 3rd Qu.:4.940 3rd Qu.:42.59
## Max. : 7.360 Max. :97.16 Max. :6.420 Max. :47.83
## NA's :2 NA's :2 NA's :2 NA's :2
prediccion_mx <- prediccion_mx[-c(201, 202),]
summary(prediccion_mx)
## ano mes exportacion tipo_de_cambio
## Min. :2006 Min. : 1.00 Min. : 15139 Min. :10.09
## 1st Qu.:2010 1st Qu.: 3.00 1st Qu.:153219 1st Qu.:12.66
## Median :2014 Median : 6.00 Median :209161 Median :13.56
## Mean :2014 Mean : 6.42 Mean :201664 Mean :15.48
## 3rd Qu.:2018 3rd Qu.: 9.00 3rd Qu.:243900 3rd Qu.:19.10
## Max. :2022 Max. :12.00 Max. :327454 Max. :24.24
## inflacion porcentaje_ocu porcentaje_desocu conf_consumidor
## Min. :-0.250 Min. :93.58 Min. :2.840 Min. :28.67
## 1st Qu.: 0.815 1st Qu.:95.06 1st Qu.:3.527 1st Qu.:36.69
## Median : 1.480 Median :95.88 Median :4.125 Median :38.47
## Mean : 1.951 Mean :95.76 Mean :4.244 Mean :39.15
## 3rd Qu.: 2.895 3rd Qu.:96.47 3rd Qu.:4.940 3rd Qu.:42.59
## Max. : 7.360 Max. :97.16 Max. :6.420 Max. :47.83
Variable_carton<-c("Año", "Mes", "Exportación", "Tipo de cambio", "Inflación", "porcentaje_ocu", "porcentaje_desocu", "conf_consumidor")
Tipo_variable <- c("Exploratoria", "Exploratoria", "Dependiente", "Exploratoria", "Exploratoria", "Exploratoria", "Exploratoria", "Exploratoria")
Unidad_Medición <- c("Año", "Mes", "Unidades", "Pesos Mexicanos", "Índice de Precios al Consumo", "% total de empleados", "% total de desempleados", "Perspectiva económica del consumidor")
tabla12<-data.frame(Variable_carton,Tipo_variable,Unidad_Medición)
knitr::kable(tabla12)
| Variable_carton | Tipo_variable | Unidad_Medición |
|---|---|---|
| Año | Exploratoria | Año |
| Mes | Exploratoria | Mes |
| Exportación | Dependiente | Unidades |
| Tipo de cambio | Exploratoria | Pesos Mexicanos |
| Inflación | Exploratoria | Índice de Precios al Consumo |
| porcentaje_ocu | Exploratoria | % total de empleados |
| porcentaje_desocu | Exploratoria | % total de desempleados |
| conf_consumidor | Exploratoria | Perspectiva económica del consumidor |
corrplot(cor(prediccion_mx), type="upper", order="hclust", addcoef.col="black")
summary(prediccion_mx)
## ano mes exportacion tipo_de_cambio
## Min. :2006 Min. : 1.00 Min. : 15139 Min. :10.09
## 1st Qu.:2010 1st Qu.: 3.00 1st Qu.:153219 1st Qu.:12.66
## Median :2014 Median : 6.00 Median :209161 Median :13.56
## Mean :2014 Mean : 6.42 Mean :201664 Mean :15.48
## 3rd Qu.:2018 3rd Qu.: 9.00 3rd Qu.:243900 3rd Qu.:19.10
## Max. :2022 Max. :12.00 Max. :327454 Max. :24.24
## inflacion porcentaje_ocu porcentaje_desocu conf_consumidor
## Min. :-0.250 Min. :93.58 Min. :2.840 Min. :28.67
## 1st Qu.: 0.815 1st Qu.:95.06 1st Qu.:3.527 1st Qu.:36.69
## Median : 1.480 Median :95.88 Median :4.125 Median :38.47
## Mean : 1.951 Mean :95.76 Mean :4.244 Mean :39.15
## 3rd Qu.: 2.895 3rd Qu.:96.47 3rd Qu.:4.940 3rd Qu.:42.59
## Max. : 7.360 Max. :97.16 Max. :6.420 Max. :47.83
modelo_regresion1 <- lm(exportacion~ano+mes+tipo_de_cambio+inflacion+porcentaje_ocu+porcentaje_desocu+conf_consumidor,data=prediccion_mx)
summary(modelo_regresion1)
##
## Call:
## lm(formula = exportacion ~ ano + mes + tipo_de_cambio + inflacion +
## porcentaje_ocu + porcentaje_desocu + conf_consumidor, data = prediccion_mx)
##
## Residuals:
## Min 1Q Median 3Q Max
## -223340 -17123 3169 21264 87133
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.913e+07 3.447e+06 -11.352 < 2e-16 ***
## ano 1.835e+04 1.645e+03 11.151 < 2e-16 ***
## mes 6.334e+03 1.054e+03 6.007 9.25e-09 ***
## tipo_de_cambio -1.280e+04 2.212e+03 -5.785 2.89e-08 ***
## inflacion -1.022e+04 2.390e+03 -4.275 3.01e-05 ***
## porcentaje_ocu 2.763e+04 4.394e+03 6.289 2.09e-09 ***
## porcentaje_desocu NA NA NA NA
## conf_consumidor -2.142e+03 8.735e+02 -2.452 0.0151 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 36390 on 193 degrees of freedom
## Multiple R-squared: 0.6723, Adjusted R-squared: 0.6621
## F-statistic: 65.99 on 6 and 193 DF, p-value: < 2.2e-16
effect_plot(modelo_regresion1,pred=tipo_de_cambio,interval=TRUE)
En este modelo, se pudo observar que el tipo de cambio era la variable que más impactaba a la exportación, por lo que si el peso valía más en este caso, la exportación incrementaba, teniendo esta variable una tendencia negativa, ocurriendo lo mismo con la inflación. Por otro lado, Si incrementa el % de ocupación (empleo), que tambien es una variable estadísticamente signifcativa, incrementa la exportación de vehículos, teniendo esta una tendencia positiva.
# file.choose()
bd9 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\EVI2\\us_automotive_industry.csv")
prediccion_usa <- clean_names(bd9)
summary(prediccion_usa)
## year car_production car_sales inflation_rate
## Min. :2010 Min. :1562720 Min. :3340000 Min. :0.100
## 1st Qu.:2013 1st Qu.:2676260 1st Qu.:5162500 1st Qu.:1.450
## Median :2016 Median :3005105 Median :6090000 Median :1.700
## Mean :2016 Mean :3194638 Mean :5962500 Mean :1.967
## 3rd Qu.:2018 3rd Qu.:4122460 3rd Qu.:7320000 3rd Qu.:2.175
## Max. :2021 Max. :4368840 Max. :7710000 Max. :4.700
## us_unemployment us_consumer_confidence
## Min. :3.675 Min. :67.35
## 1st Qu.:4.746 1st Qu.:77.35
## Median :5.758 Median :82.83
## Mean :6.295 Mean :84.51
## 3rd Qu.:8.079 3rd Qu.:93.70
## Max. :9.488 Max. :98.37
prediccion_usa$year<-as.numeric(prediccion_usa$year)
prediccion_usa$car_production <- as.numeric(prediccion_usa$car_production)
prediccion_usa$car_sales<-as.numeric(prediccion_usa$car_sales)
prediccion_usa$inflation_rate<-as.numeric(prediccion_usa$inflation_rate)
prediccion_usa$us_unemployment<-as.numeric(prediccion_usa$us_unemployment)
prediccion_usa$us_consumer_confidence<-as.numeric(prediccion_usa$us_consumer_confidence)
summary(prediccion_usa)
## year car_production car_sales inflation_rate
## Min. :2010 Min. :1562720 Min. :3340000 Min. :0.100
## 1st Qu.:2013 1st Qu.:2676260 1st Qu.:5162500 1st Qu.:1.450
## Median :2016 Median :3005105 Median :6090000 Median :1.700
## Mean :2016 Mean :3194638 Mean :5962500 Mean :1.967
## 3rd Qu.:2018 3rd Qu.:4122460 3rd Qu.:7320000 3rd Qu.:2.175
## Max. :2021 Max. :4368840 Max. :7710000 Max. :4.700
## us_unemployment us_consumer_confidence
## Min. :3.675 Min. :67.35
## 1st Qu.:4.746 1st Qu.:77.35
## Median :5.758 Median :82.83
## Mean :6.295 Mean :84.51
## 3rd Qu.:8.079 3rd Qu.:93.70
## Max. :9.488 Max. :98.37
Variable_usa<-c("Year", "Car Production", "Car Sales", "Inflation rate", "US Unemployement Rate", "US Consumer Confidence")
Tipo_variable_usa <- c("Exploratoria", "Dependiente", "Dependiente", "Exploratoria", "Exploratoria", "Exploratoria")
Unidad_Medición_usa <- c("Años","Unidades", "Unidades", "% Cambio de los precios", "% total de desempleados", "Perspectiva económica del consumidor")
tabla13<-data.frame(Variable_usa,Tipo_variable_usa,Unidad_Medición_usa)
knitr::kable(tabla13)
| Variable_usa | Tipo_variable_usa | Unidad_Medición_usa |
|---|---|---|
| Year | Exploratoria | Años |
| Car Production | Dependiente | Unidades |
| Car Sales | Dependiente | Unidades |
| Inflation rate | Exploratoria | % Cambio de los precios |
| US Unemployement Rate | Exploratoria | % total de desempleados |
| US Consumer Confidence | Exploratoria | Perspectiva económica del consumidor |
corrplot(cor(prediccion_usa), type="upper", order="hclust", addcoef.col="black")
modelo_regresion2 <- lm(car_sales~year+inflation_rate+us_unemployment+us_consumer_confidence,data=prediccion_usa)
summary(modelo_regresion2)
##
## Call:
## lm(formula = car_sales ~ year + inflation_rate + us_unemployment +
## us_consumer_confidence, data = prediccion_usa)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1235300 -114022 53391 445143 747117
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 868156591 193630933 4.484 0.00285 **
## year -419114 96909 -4.325 0.00346 **
## inflation_rate -755849 416783 -1.814 0.11263
## us_unemployment -982706 483278 -2.033 0.08150 .
## us_consumer_confidence -115921 102415 -1.132 0.29497
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 801800 on 7 degrees of freedom
## Multiple R-squared: 0.8283, Adjusted R-squared: 0.7302
## F-statistic: 8.442 on 4 and 7 DF, p-value: 0.008178
effect_plot(modelo_regresion2,pred=us_unemployment,interval=TRUE)
En este caso, podemos observar que el modelo si es confiable (teniendo una r2 alta) y estadísticamente signifcativo al tener las variables independientes de year y desempleo negativas, indicando que si el desempleo crece en EUA, las ventas de automoviles disminuirán. Las demás variabls también tienen una relación negativa, por lo que si la taza de inflación y la confianza del consumidor incrementan, las ventas podrían verse un poco afectadas y disminuir por igual.
b10 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\FORM BASES DE DATOS\\encoded-vehiculos_en_circulacion (2).csv")
vehiculos_circulacion <- clean_names(b10)
summary(vehiculos_circulacion)
## ano total automoviles
## Length:47 Min. : 4010430 Min. : 3950042
## Class :character 1st Qu.: 6748523 1st Qu.: 6654340
## Mode :character Median :11002046 Median :10764080
## Mean :14899354 Mean :14673142
## 3rd Qu.:22392796 3rd Qu.:22068938
## Max. :35913468 Max. :35460804
## NA's :5 NA's :5
## camiones_para_pasajeros camiones_y_camionetas_para_carga motocicletas
## Min. : 60388 Min. : 1470816 Min. : 128960
## 1st Qu.: 90931 1st Qu.: 3046906 1st Qu.: 248248
## Median :233491 Median : 5166812 Median : 295262
## Mean :226213 Mean : 5920971 Mean :1156467
## 3rd Qu.:336421 3rd Qu.: 9199181 3rd Qu.:1284405
## Max. :461089 Max. :11262666 Max. :5939262
## NA's :5 NA's :5 NA's :5
## x x_1
## Mode:logical Mode:logical
## NA's:47 NA's:47
##
##
##
##
##
vehiculos_circulacion <- subset(vehiculos_circulacion, select = -c (camiones_y_camionetas_para_carga, motocicletas, x, x_1))
vehiculos_circulacion <- vehiculos_circulacion[-c(43,44,45,46,47),]
vehiculos_circulacion$ano<-as.numeric(vehiculos_circulacion$ano)
vehiculos_circulacion$total <- as.numeric(vehiculos_circulacion$total)
vehiculos_circulacion$autmoviles$car_sales<-as.numeric(vehiculos_circulacion$automoviles)
vehiculos_circulacion$camiones_para_pasajeros<-as.numeric(vehiculos_circulacion$camiones_para_pasajeros)
summary(vehiculos_circulacion)
## ano total automoviles camiones_para_pasajeros
## Min. :1980 Min. : 4010430 Min. : 3950042 Min. : 60388
## 1st Qu.:1990 1st Qu.: 6748523 1st Qu.: 6654340 1st Qu.: 90931
## Median :2000 Median :11002046 Median :10764080 Median :233491
## Mean :2000 Mean :14899354 Mean :14673142 Mean :226213
## 3rd Qu.:2011 3rd Qu.:22392796 3rd Qu.:22068938 3rd Qu.:336421
## Max. :2021 Max. :35913468 Max. :35460804 Max. :461089
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
##
## autmoviles.Length autmoviles.Class autmoviles.Mode
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
## 42 -none- numeric
plot(vehiculos_circulacion$ano,vehiculos_circulacion$total, type="l",col="blue", lwd=1.5, xlab ="Año",ylab ="Unidades", main = "Vehiculos de motor en circulación registrados anualmente")
lines(vehiculos_circulacion$ano,vehiculos_circulacion$automoviles,col="red",lty=3)
legend("topleft", legend=c("Total de vehiculos en circulación", "Automóviles en circulación"),
col=c("blue", "red"), lty = 1:2, cex=0.8)
Podemos observar que la tendencia es casi igual, indicando que
los autos son la gran mayoría del total de vehículos en
circulación.
autoregressive_model <- arma(vehiculos_circulacion$total, order = c(1,0))
summary(autoregressive_model <- arma(vehiculos_circulacion$total, order = c(1,0)))
##
## Call:
## arma(x = vehiculos_circulacion$total, order = c(1, 0))
##
## Model:
## ARMA(1,0)
##
## Residuals:
## Min 1Q Median 3Q Max
## -964598 -203485 -37324 133579 1366807
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 1.043e+00 3.792e-03 275 <2e-16 ***
## intercept 1.595e+05 NaN NaN NaN
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 1.852e+11, Conditional Sum-of-Squares = 7.406257e+12, AIC = 1212.86
autoregressive_model_forecast<-forecast(autoregressive_model$fitted,h=5,level=c(95))
autoregressive_model_forecast
## Point Forecast Lo 95 Hi 95
## 43 37884281 35240406 40528155
## 44 39222087 34802632 43641541
## 45 40559893 34284299 46835486
## 46 41897698 33625820 50169577
## 47 43235504 32811356 53659653
plot(autoregressive_model_forecast)
En este primer modelo autoregresivo podemos observar una tendencia positiva al pronosticar la circulación de automóviles en México en los próximos años, por ejemplo, en el siguiente año se esperan 37,884,281 vehículos en circulación con un 95% de confianza, y los rangos pueden ir de 35,240,406 hasta 40,528,155.
En el segundo año, se pronostican 39,222,087, de igual manera con un 95% de confianza, y por último, en el tercer año, se preveen 40,559,893 vehículos en circulación.
El incremento de vehículos en circulación en México es un dato que puede ser beneficioso para FORM, ya que al haber más vehículos en circulación, se implica una mayor producción de los mismos, y por ende, las empresas automotrices necesitarán más de los servicios de empaque ofrecidos por FORM.
b12 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\EVI2\\vehicle_sales_usa.csv")
vehicle_sales <- clean_names(b12)
summary(vehicle_sales)
## years new_passanger_car_sales new_light_truck_sales
## Min. :2005 Min. :2510874 Min. :3540000
## 1st Qu.:2009 1st Qu.:4479484 1st Qu.:6140000
## Median :2013 Median :4981183 Median :7193087
## Mean :2013 Mean :4847454 Mean :7074063
## 3rd Qu.:2017 3rd Qu.:5711630 3rd Qu.:8502487
## Max. :2021 Max. :6182000 Max. :9311251
## used_vehicle_sales total x x_1
## Min. :35491762 Min. :43538762 Mode:logical Mode:logical
## 1st Qu.:36911180 1st Qu.:48140008 NA's:17 NA's:17
## Median :38602466 Median :50386196
## Mean :38645158 Mean :50566675
## 3rd Qu.:40232959 3rd Qu.:53310170
## Max. :44138263 Max. :57630263
## x_2 x_3 x_4
## Mode:logical Mode:logical Mode:logical
## NA's:17 NA's:17 NA's:17
##
##
##
##
vehicle_sales <- subset(vehicle_sales, select = -c (x, x_1, x_2, x_3, x_4))
summary(vehicle_sales)
## years new_passanger_car_sales new_light_truck_sales
## Min. :2005 Min. :2510874 Min. :3540000
## 1st Qu.:2009 1st Qu.:4479484 1st Qu.:6140000
## Median :2013 Median :4981183 Median :7193087
## Mean :2013 Mean :4847454 Mean :7074063
## 3rd Qu.:2017 3rd Qu.:5711630 3rd Qu.:8502487
## Max. :2021 Max. :6182000 Max. :9311251
## used_vehicle_sales total
## Min. :35491762 Min. :43538762
## 1st Qu.:36911180 1st Qu.:48140008
## Median :38602466 Median :50386196
## Mean :38645158 Mean :50566675
## 3rd Qu.:40232959 3rd Qu.:53310170
## Max. :44138263 Max. :57630263
vehicle_sales$years<-as.numeric(vehicle_sales$years)
vehicle_sales$new_passanger_car_sales <- as.numeric(vehicle_sales$new_passanger_car_sales)
vehicle_sales$new_light_truck_sales<-as.numeric(vehicle_sales$new_light_truck_sales)
vehicle_sales$used_vehicle_sales<-as.numeric(vehicle_sales$used_vehicle_sales)
vehicle_sales$total<-as.numeric(vehicle_sales$total)
summary(vehicle_sales)
## years new_passanger_car_sales new_light_truck_sales
## Min. :2005 Min. :2510874 Min. :3540000
## 1st Qu.:2009 1st Qu.:4479484 1st Qu.:6140000
## Median :2013 Median :4981183 Median :7193087
## Mean :2013 Mean :4847454 Mean :7074063
## 3rd Qu.:2017 3rd Qu.:5711630 3rd Qu.:8502487
## Max. :2021 Max. :6182000 Max. :9311251
## used_vehicle_sales total
## Min. :35491762 Min. :43538762
## 1st Qu.:36911180 1st Qu.:48140008
## Median :38602466 Median :50386196
## Mean :38645158 Mean :50566675
## 3rd Qu.:40232959 3rd Qu.:53310170
## Max. :44138263 Max. :57630263
plot(vehicle_sales$years,vehicle_sales$total, type="l",col="blue", lwd=1.5, xlab ="Año",ylab ="Unidades", main = "Venta de vehículos en Estados Unidos")
lines(vehicle_sales$years,vehicle_sales$used_vehicle_sales,col="red",lty=3)
legend("topleft", legend=c("Total de vehiculos en circulación", "Venta de vehiculos usados"),
col=c("blue", "red"), lty = 1:2, cex=0.6)
mam_sales <- arma(vehicle_sales$total,order = c(1,1))
summary(mam_sales <- arma(vehicle_sales$total,order = c(1,1)))
##
## Call:
## arma(x = vehicle_sales$total, order = c(1, 1))
##
## Model:
## ARMA(1,1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5431072 -1035522 928147 1352337 1840355
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 6.260e-01 1.285e-02 48.715 <2e-16 ***
## ma1 3.641e-01 2.757e-01 1.321 0.187
## intercept 1.848e+07 NaN NaN NaN
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 4.356e+12, Conditional Sum-of-Squares = 6.534569e+13, AIC = 548.99
mam_sales_forecast <- forecast(mam_sales$fitted,h=5,level=c(95))
mam_sales_forecast
## Point Forecast Lo 95 Hi 95
## 18 48665257 43635276 53695238
## 19 48665257 41654979 55675535
## 20 48665257 40118351 57212163
## 21 48665257 38815502 58515012
## 22 48665257 37663057 59667457
plot(mam_sales_forecast)
Con esta técnica podemos ver que en Estados Unidos se pronostica para los próximos años la misma cantidad de unidades de vehículos vendidas, siendo esta de 48,665,257 unidades en los próximos 5 años.
Con esta información podemos decir que bien, al FORM querer entrar a la industria automotriz en Estados Unidos si podría generar una ventaja, sin embargo para los próximos años, puede que la industria automotriz no tenga un crecimiento signifcativo de ventas de carros y por ende producción de los mismos.
# file.choose()
b11 <- read.csv("C:\\Users\\maria\\Documents\\performance_bd_limpia.csv")
perf_pronosticos <- clean_names(b11)
summary(perf_pronosticos)
## fecha printel mahle magna varroc
## Length:324 Min. :0.0000 Min. :-11.650 Min. :0 Min. :0
## Class :character 1st Qu.:0.0000 1st Qu.: 2.000 1st Qu.:0 1st Qu.:0
## Mode :character Median :0.0000 Median : 3.000 Median :0 Median :0
## Mean :0.4077 Mean : 2.413 Mean :0 Mean :0
## 3rd Qu.:0.9625 3rd Qu.: 3.100 3rd Qu.:0 3rd Qu.:0
## Max. :4.4000 Max. : 20.000 Max. :0 Max. :0
## retraso
## Min. :-10.450
## 1st Qu.: 2.000
## Median : 3.000
## Mean : 2.821
## 3rd Qu.: 3.652
## Max. : 20.000
autoregressive_model_performance <- arma(perf_pronosticos$retraso, order = c(1,0))
summary(autoregressive_model_performance <- arma(perf_pronosticos$retraso, order = c(1,0)))
##
## Call:
## arma(x = perf_pronosticos$retraso, order = c(1, 0))
##
## Model:
## ARMA(1,0)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11.0051 -0.7200 0.1366 0.8392 17.8326
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 0.23199 0.05404 4.293 1.76e-05 ***
## intercept 2.16743 0.19055 11.374 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 4.25, Conditional Sum-of-Squares = 1368.55, AIC = 1392.28
autoregressive_model_performance_forecast<-forecast(autoregressive_model_performance$fitted,h=5,level=c(95))
summary(autoregressive_model_performance_forecast)
##
## Forecast method: ETS(A,N,N)
##
## Model Information:
## ETS(A,N,N)
##
## Call:
## ets(y = object, lambda = lambda, biasadj = biasadj, allow.multiplicative.trend = allow.multiplicative.trend)
##
## Smoothing parameters:
## alpha = 0.0561
##
## Initial states:
## l = 3.0264
##
## sigma: 0.4746
##
## AIC AICc BIC
## 1388.785 1388.860 1400.117
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -0.01361886 0.4731736 0.2759066 0.8752139 15.02225 0.840378
## ACF1
## Training set 0.1245646
##
## Forecasts:
## Point Forecast Lo 95 Hi 95
## 325 2.779647 1.849359 3.709934
## 326 2.779647 1.847897 3.711397
## 327 2.779647 1.846437 3.712856
## 328 2.779647 1.844979 3.714314
## 329 2.779647 1.843524 3.715769
ggplot(perf_pronosticos,aes(x=fecha,y=retraso))+
geom_point(size=2,shape=23)
plot(autoregressive_model_performance_forecast)
Con este modelo autoregresivo, se pronostica con un 95% de confianza en los próximos años un tiempo de retraso lineal, es decir, no se puede observar una tendencia ni negativa o positiva como podemos ver en la gráfica de dispersión, arrojando así un retraso de entrega de 2.773 minutos en los próximos años.
Este pronóstico es bueno para FORM, pues indica que su tiempo de entrega no incerementará en atrasos, sin embargo, puede crear estartegias para cambiar este pronóstico y lograr que se disminuya lo más posible en un futuro.
# file.choose()
b13 <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\EVI2\\scrap_bd_limpia.csv")
scrap_pronosticos <- clean_names(b13)
summary(scrap_pronosticos)
## fecha cantidad ubicacion_de_origen
## Length:250 Min. : 0.000 Length:250
## Class :character 1st Qu.: 1.000 Class :character
## Mode :character Median : 2.000 Mode :character
## Mean : 6.696
## 3rd Qu.: 7.000
## Max. :96.000
scrap_pronosticos$fecha <- as.Date(scrap_pronosticos$fecha, format = "%d/%m/%Y")
scrap_pronosticos$ubicacion_de_origen <- as.factor(scrap_pronosticos$ubicacion_de_origen)
scrap_pronosticos$cantidad <- as.numeric(scrap_pronosticos$cantidad)
summary(scrap_pronosticos)
## fecha cantidad ubicacion_de_origen
## Min. :NA Min. : 0.000 Calidad/Entrega de PT: 58
## 1st Qu.:NA 1st Qu.: 1.000 Post-Production : 13
## Median :NA Median : 2.000 Pre-Production :179
## Mean :NaN Mean : 6.696
## 3rd Qu.:NA 3rd Qu.: 7.000
## Max. :NA Max. :96.000
## NA's :250
mam_scrap <- arma(scrap_pronosticos$cantidad,order = c(1,1))
summary(mam_scrap <- arma(scrap_pronosticos$cantidad,order = c(1,1)))
##
## Call:
## arma(x = scrap_pronosticos$cantidad, order = c(1, 1))
##
## Model:
## ARMA(1,1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -33.3119 -2.9832 -1.6561 -0.1724 86.7286
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 0.90165 0.03352 26.900 <2e-16 ***
## ma1 -0.63209 0.05502 -11.489 <2e-16 ***
## intercept 0.54097 0.31757 1.703 0.0885 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 93.63, Conditional Sum-of-Squares = 23223.87, AIC = 1850.32
mam_scrap_forecast <- forecast(mam_scrap$fitted,h=5,level=c(95))
mam_scrap_forecast
## Point Forecast Lo 95 Hi 95
## 251 2.877502 0.8671930 4.887811
## 252 3.079049 0.0635478 6.094550
## 253 3.280596 -0.6423603 7.203552
## 254 3.482143 -1.3266521 8.290938
## 255 3.683690 -2.0186251 9.386005
plot(mam_scrap_forecast)
En el caso de este modelo MAM, se pronostica con un 95% de confianza que habrá un aumento en la producción de scrap dentro de los procesos de FORM, habiendo así un pronóstico de 2.877 kilos para el siguiente año, seguido por 3.079 kg para el siguiente periodo y despues de 3.280 kg. Este crecimiento no es para nada drástico, sin embargo, aunque el crecimiento de los desperdicios no es algo que busca FORM, este puede indicar que la producción también estará creciendo, pues el scrap se produce en su mayoría en la etapa de pre-producción.
En la gráfica podemos ver un comportamiento positivo, demostrando así el pronóstico de crecimiento muy leve para los siguientes años.
En este caso, FORM deberá crear estrategias para evitar el crecimiento de su scrap y aprovechar al máximo su materia prima.
bajas <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\EVI2\\FORM - Recursos Humanos - BAJAS evidencia).csv")
bajas <- clean_names(bajas)
summary(bajas)
## apellidos nombre fecha_de_nacimiento edad
## Length:237 Length:237 Length:237 Min. :19.00
## Class :character Class :character Class :character 1st Qu.:23.00
## Mode :character Mode :character Mode :character Median :29.00
## Mean :31.09
## 3rd Qu.:37.00
## Max. :61.00
## NA's :3
## genero rfc fecha_de_alta motivo_de_baja
## Length:237 Length:237 Length:237 Length:237
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## no_dias baja puesto departamento
## Min. : 0.00 Length:237 Length:237 Length:237
## 1st Qu.: 9.00 Class :character Class :character Class :character
## Median : 19.00 Mode :character Mode :character Mode :character
## Mean : 79.47
## 3rd Qu.: 48.75
## Max. :1966.00
## NA's :23
## no_seguro_social salario_diario_imss factor_cred_infonavit
## Length:237 Min. :144.4 Length:237
## Class :character 1st Qu.:180.7 Class :character
## Mode :character Median :180.7 Mode :character
## Mean :178.0
## 3rd Qu.:180.7
## Max. :500.0
## NA's :1
## n_credito_infonavit lugar_de_nacimiento curp calle
## Length:237 Length:237 Length:237 Length:237
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## numero_interno colonia codigo_postal municipio
## Length:237 Length:237 Length:237 Length:237
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## estado estado_civil tarjeta_cuenta
## Length:237 Length:237 Length:237
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
#Técnica 1:
#Borrar columnas.
bajas <- subset(bajas, select = -c(apellidos, nombre, fecha_de_nacimiento,rfc, fecha_de_alta, baja, departamento, no_seguro_social, factor_cred_infonavit, n_credito_infonavit, lugar_de_nacimiento, curp, calle, numero_interno, colonia, codigo_postal, municipio, estado, tarjeta_cuenta))
#Técnica 2:
#Reemplezar NAs con el promedio en la columna de "Edad", "Salario Diario" y "Número de días".
bajas$edad[is.na(bajas$edad)]<-mean(bajas$edad, na.rm = TRUE)
bajas$salario_diario_imss[is.na(bajas$salario_diario_imss)]<-mean(bajas$salario_diario_imss, na.rm = TRUE)
bajas$no_dias[is.na(bajas$no_dias)]<-mean(bajas$no_dias, na.rm = TRUE)
summary (bajas)
## edad genero motivo_de_baja no_dias
## Min. :19.00 Length:237 Length:237 Min. : 0.00
## 1st Qu.:23.00 Class :character Class :character 1st Qu.: 9.00
## Median :29.00 Mode :character Mode :character Median : 23.00
## Mean :31.09 Mean : 79.47
## 3rd Qu.:37.00 3rd Qu.: 79.47
## Max. :61.00 Max. :1966.00
## puesto salario_diario_imss estado_civil
## Length:237 Min. :144.4 Length:237
## Class :character 1st Qu.:180.7 Class :character
## Mode :character Median :180.7 Mode :character
## Mean :178.0
## 3rd Qu.:180.7
## Max. :500.0
#Técnica 3:
#Convertir las variables como factor o número
bajas$edad<-as.numeric(bajas$edad)
bajas$genero<-as.factor(bajas$genero)
bajas$motivo_de_baja<-as.factor(bajas$motivo_de_baja)
bajas$no_dias<-as.numeric(bajas$no_dias)
bajas$puesto<-as.factor(bajas$puesto)
bajas$salario_diario_imss<-as.numeric(bajas$salario_diario_imss)
bajas$estado_civil<-as.factor(bajas$estado_civil)
summary (bajas)
## edad genero motivo_de_baja
## Min. :19.00 CAPJ000926597: 1 ABANDONO : 1
## 1st Qu.:23.00 FEMENINO :139 BAJA POR FALTAS :141
## Median :29.00 MASCULINO : 97 JUBILACION : 1
## Mean :31.09 RENUNCIA VOLUNTARIA: 86
## 3rd Qu.:37.00 TERMINO DE CONTRATO: 8
## Max. :61.00
##
## no_dias puesto salario_diario_imss
## Min. : 0.00 AYUDANTE GENERAL :179 Min. :144.4
## 1st Qu.: 9.00 COSTURERA : 11 1st Qu.:180.7
## Median : 23.00 SOLDADOR : 11 Median :180.7
## Mean : 79.47 AYUDANTE DE EMBARQUES: 7 Mean :178.0
## 3rd Qu.: 79.47 MONTACARGUISTA : 5 3rd Qu.:180.7
## Max. :1966.00 INSPECTOR CALIDAD : 4 Max. :500.0
## (Other) : 20
## estado_civil
## : 2
## CASADO : 64
## DIVORCIADO : 3
## SOLTERO :108
## UNION LIBRE: 60
##
##
#Exportar base de datos limpia
write.csv(bajas, file="bajas_bd_limpia.csv", row.names = FALSE)
edad <-bajas
edad<- subset(bajas,select = -c(genero, motivo_de_baja, puesto, salario_diario_imss, estado_civil))
#Normalizar variables
edad_norm<-scale(edad[1:2])
#Función fviz para la visualización de un Elbow Plot y así determinar el número de clusters.
fviz_nbclust(edad_norm, kmeans, method="wss")+
geom_vline(xintercept=4, linetype=2)+
labs(subtitle = "Elbow method")
Con esta gráfica podemos visualizar que el número óptimo de clústers son 4 (optimización).
#Visualizar clusters
edad_cluster<-kmeans(edad_norm,4)
edad_cluster
## K-means clustering with 4 clusters of sizes 80, 4, 45, 108
##
## Cluster means:
## edad no_dias
## 1 0.1895854 -0.06199477
## 2 1.0620936 6.70675123
## 3 1.6004444 -0.10126073
## 4 -0.8466223 -0.16028417
##
## Clustering vector:
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 1 1 4 4 1 3 1 1 3 4 4 1 4 1 1 4 4 4 4 4
## 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
## 1 2 4 1 3 4 1 4 4 4 1 4 4 4 1 4 4 1 1 4
## 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
## 4 1 4 4 4 4 4 4 3 3 3 2 4 3 4 4 3 4 4 4
## 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
## 4 4 1 4 4 3 4 3 1 4 4 4 1 4 1 4 3 4 4 3
## 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
## 2 1 3 4 4 4 3 4 4 4 1 3 3 4 4 4 1 3 1 4
## 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
## 1 4 4 3 1 4 4 1 2 1 1 4 1 1 4 1 1 1 3 3
## 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
## 3 4 4 4 4 4 1 4 1 3 4 1 4 3 4 1 1 1 3 1
## 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
## 3 1 1 3 3 3 4 1 1 1 1 4 4 4 1 3 3 4 1 4
## 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## 1 3 3 3 3 1 3 4 4 1 4 4 3 1 3 4 3 1 1 3
## 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
## 1 1 4 4 4 1 3 1 1 4 4 1 1 1 1 1 1 1 4 1
## 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
## 1 1 1 4 1 3 1 4 4 4 3 4 4 4 1 1 4 4 1 1
## 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
## 1 3 4 4 1 4 4 4 4 3 1 3 4 4 4 4 4
##
## Within cluster sum of squares by cluster:
## [1] 34.04210 16.13273 21.75900 16.53795
## (between_SS / total_SS = 81.3 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
#Visualizar resultados:
fviz_cluster(edad_cluster,data=edad_norm)
Los más jóvenes son los que menos días de trabajo laboran. Así como que los que más días laborales tienen, son los adultos desde los 27 años hasta los 61.
edad_salario <-bajas
edad_salario<- subset(bajas,select = -c(genero,estado_civil,motivo_de_baja, puesto, no_dias))
#Normalizar variables
edad_salario_norm<-scale(edad_salario[1:2])
edad_salario_norm <- na.omit(edad_salario_norm)
summary(edad_salario_norm)
## edad salario_diario_imss
## Min. :-1.2638 Min. :-1.4439
## 1st Qu.:-0.8457 1st Qu.: 0.1171
## Median :-0.2184 Median : 0.1171
## Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.6178 3rd Qu.: 0.1171
## Max. : 3.1266 Max. :13.8750
#Función fviz para la visualización de un Elbow Plot y así determinar el número de clusters.
fviz_nbclust(edad_salario_norm, kmeans, method="wss")+
geom_vline(xintercept=4, linetype=2)+
labs(subtitle = "Elbow method")
Con esta gráfica podemos visualizar que el número óptimo de clústers son 4 (optimización).
#Visualizar clusters:
edad_salario_cluster<-kmeans(edad_salario_norm,4)
edad_salario_cluster
## K-means clustering with 4 clusters of sizes 76, 1, 45, 115
##
## Cluster means:
## edad salario_diario_imss
## 1 0.24407169 -0.03948540
## 2 0.09515287 13.87503094
## 3 1.67245680 -0.06024275
## 4 -0.81656658 -0.07098449
##
## Clustering vector:
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 2 1 4 4 1 3 1 1 3 4 4 1 4 1 1 4 4 4 4 4
## 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
## 1 3 4 1 3 4 1 4 4 4 1 4 4 4 1 4 4 4 1 4
## 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
## 4 1 4 4 4 4 4 4 3 3 3 3 4 3 4 4 3 4 4 4
## 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
## 4 4 1 4 4 3 4 3 4 4 4 4 1 4 1 4 1 4 4 3
## 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
## 4 4 3 4 4 4 3 4 4 4 1 3 3 4 4 4 1 3 1 4
## 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
## 1 4 4 3 1 4 4 1 4 1 1 4 1 1 4 1 1 1 3 3
## 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
## 3 4 4 4 4 4 1 4 1 3 4 1 4 3 4 4 4 1 3 1
## 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
## 3 1 1 1 3 3 4 1 1 1 1 4 4 4 1 3 3 4 1 4
## 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## 1 3 3 3 3 1 3 4 4 1 4 4 3 1 3 4 3 1 1 3
## 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
## 1 1 4 4 4 1 3 1 1 4 4 1 1 1 1 1 1 1 4 1
## 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
## 1 1 1 4 1 3 1 4 4 4 3 4 4 4 1 1 4 4 1 1
## 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
## 1 3 4 4 1 4 4 4 4 3 1 3 4 4 4 4 4
##
## Within cluster sum of squares by cluster:
## [1] 20.84343 0.00000 18.68350 32.00903
## (between_SS / total_SS = 84.8 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
#Visualizar resultados:
fviz_cluster(edad_salario_cluster,data=edad_salario_norm)
La edad no tiene mucha influencia en el salario. Pues los colaboradores que se han dado de baja tienen un salario muy similar independientemente de su edad.
dias_salario <-bajas
dias_salario<- subset(bajas,select = -c(genero,estado_civil,motivo_de_baja, puesto, edad))
#Normalizar variables:
dias_salario_norm<-scale(dias_salario[1:2])
#Función fviz para la visualización de un Elbow Plot y así determinar el número de clusters.
fviz_nbclust(dias_salario_norm, kmeans, method="wss")+
geom_vline(xintercept=4, linetype=2)+
labs(subtitle = "Elbow method")
Con esta gráfica podemos visualizar que el número óptimo de clústers son 4 (optimización).
#Visualizar clusters:
dias_salario_cluster<-kmeans(dias_salario_norm,4)
dias_salario_cluster
## K-means clustering with 4 clusters of sizes 159, 5, 43, 30
##
## Cluster means:
## no_dias salario_diario_imss
## 1 -0.2906680 0.11501794
## 2 5.8798242 2.45410205
## 3 0.2579630 0.08136604
## 4 0.1908225 -1.13523673
##
## Clustering vector:
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 2 4 4 4 4 4 4 4 4 3 4 4 1 1 4 4 4 4 4 4
## 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
## 4 2 4 4 1 1 1 1 1 1 1 1 1 1 1 1 4 3 1 1
## 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
## 3 3 1 1 1 1 1 1 1 1 1 2 3 1 1 1 1 1 1 4
## 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
## 1 1 1 1 1 1 1 4 3 4 1 1 1 1 1 1 1 1 1 1
## 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
## 2 4 4 4 4 3 1 1 1 1 1 1 1 1 1 1 1 4 4 3
## 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
## 3 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1
## 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
## 1 1 3 1 1 1 1 1 1 1 1 1 1 4 3 3 3 3 1 1
## 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1
## 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## 1 1 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
## 3 3 3 3 3 3 3 3 3 3 3 3 3 1 3 3 3 3 3 3
## 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
## 3 3 3 3 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1
## 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
## 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##
## Within cluster sum of squares by cluster:
## [1] 1.009803 184.768864 12.851574 11.956632
## (between_SS / total_SS = 55.4 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
#Visualizar resultados:
fviz_cluster(dias_salario_cluster,data=dias_salario_norm)
promedio_dias <- mean(bajas$no_dias)
promedio_dias
## [1] 79.47196
En este clúster podemos observar que por más antigüedad o días que labores en FORM, no hay mucha posibilidad de crecimiento laboral (económicamente hablando), pues según el cluster realizado, no influyen los días laborados con el salario diario.
Decidimos usar el Cluster 2 para generar la clasificación de variables y poder comparar con datos cualitativos.
#Añadir a la base de datos la columna de Clusters y su clasificación:
bajas1<-bajas
#Eliminar renglones que tengan número de días en 0 para que las bases de datos tengan los mismos registros
bajas1$Clusters <- edad_salario_cluster$cluster
str(bajas)
## 'data.frame': 237 obs. of 7 variables:
## $ edad : num 32 36 24 21 30 46 29 31 50 19 ...
## $ genero : Factor w/ 3 levels "CAPJ000926597",..: 3 2 2 2 2 2 2 3 3 3 ...
## $ motivo_de_baja : Factor w/ 5 levels "ABANDONO","BAJA POR FALTAS",..: 4 4 4 4 4 2 2 2 2 4 ...
## $ no_dias : num 628 60 59 59 51 37 37 31 18 224 ...
## $ puesto : Factor w/ 22 levels "ANALISTA DE NOMINAS /AUX DE R.H.",..: 9 5 5 5 5 5 5 5 5 5 ...
## $ salario_diario_imss: num 500 152 152 152 152 ...
## $ estado_civil : Factor w/ 5 levels "","CASADO","DIVORCIADO",..: 4 5 2 4 4 4 5 5 4 4 ...
#Identificamos la clasificación de las distintas edades de los colaboradores.
bajas2<-bajas1 %>% group_by(Clusters) %>% dplyr::summarise(edad=max(edad)) %>% arrange(desc(edad))
bajas1$Cluster_Names<-factor(bajas1$Clusters,levels = c(1,2,3,4),
labels=c("Outlier", "Joven", "Avanzada", "Adulta"))
bajas3 <- bajas1 %>% group_by(Cluster_Names) %>% dplyr::summarize(edad_años=max(edad), salario_imss=mean(salario_diario_imss),Count=n())
clusters<-as.data.frame(bajas3)
clusters
## Cluster_Names edad_años salario_imss Count
## 1 Outlier 40 177.0462 76
## 2 Joven 32 500.0000 1
## 3 Avanzada 61 176.5644 45
## 4 Adulta 28 176.3151 115
#Se realizó una gráfica para analizar el número de registros por cada segmento:
ggplot(bajas3,aes(x=reorder(Cluster_Names,Count),y=Count,fill=Cluster_Names)) +
geom_bar(stat="identity")
Los colaboradores que más bajas han presentado según la gráfica anterior son jóvenes, seguido por los adultos y después los colaboradores de edad avanzada.
#Visualizar la edad por cada segmento:
ggplot(bajas3, aes(x=Cluster_Names,y=edad_años,fill= Cluster_Names,label=round(edad_años,digits=2))) +
geom_col() +
geom_text()
Visualización de los máximos de cada segmento: Jóvenes (hasta los 28), Avanzada (Hasta los 61), Adulta (Hasta los 40) y el Outlier de 32.
ggplot(bajas1, aes(factor(Cluster_Names), fill = factor(genero))) +
geom_bar(position = position_dodge2(preserve = "single"))
Este gráfico nos dice que de cada segmento, hay más mujeres que se han dado de baja.
ggplot(bajas1, aes(factor(Cluster_Names), fill = factor(estado_civil))) +
geom_bar(position = position_dodge2(preserve = "single"))
Podemos visualizar que de de los jóvenes, la mayoría eran solteros, de los adultos había la misma cantidad de casados, soleros y en unión libre y en avanzados eran más solteros y casados. Más sin embargo, hay muy pocos colaboradores que se han dado de baja divorciados.
ggplot(bajas1, aes(factor(Cluster_Names), fill = factor(motivo_de_baja))) +
geom_bar(position = position_dodge2(preserve = "single"))
Podemos observar que en el segmento de colaboradores jovenes, adultos y de edad avanzada, la mayor parte se ha dado de baja por faltas, siguiendo así por renuncia voluntaria.
La mayor parte de los ex-colaboradores de Form eran Ayudantes generales (76%).
bajas1<-bajas1[-c(17),]
bajas5 <-bajas1 %>% filter(Clusters==4 | Clusters==3) %>% arrange(Clusters)
ggplot(as.data.frame(bajas5),
aes(y=salario_diario_imss, axis1= genero, axis2=estado_civil)) +
geom_alluvium(aes(fill=Cluster_Names), width = 1/12) +
geom_stratum(width = 1/12, fill = "black", color = "grey") +
geom_label(stat = "stratum", aes(label = after_stat(stratum))) +
scale_x_discrete(limits = c("Género", "Estado civil"), expand = c(.05, .05)) +
scale_fill_brewer(type = "qual", palette = "Set1") +
ggtitle("FORM's Salario Diario por Género y Estado Civil")
En este caso podemos observar que los colaboradores que se han dado de baja y ganan más son en su mayoría mujeres de las cuales la que más ganaba era adulta casada; y las que menos ganaban eran jóvenes en unión libre. Por el otro lado, los hombres que más ganaban eran jovenes solteros y los que menos ganaban eran adultos en unión libre de edad adulta.
# file.choose()
nueva_bd_rh <- read.csv("C:\\Users\\maria\\Documents\\ITESM LAET\\Semestre 7\\Reto\\EVI2\\rh_unida.csv")
summary(nueva_bd_rh)
## edad genero antiguedad puesto
## Min. :18.00 Length:349 Min. : 0.0000 Length:349
## 1st Qu.:24.00 Class :character 1st Qu.: 0.0000 Class :character
## Median :30.00 Mode :character Median : 0.0000 Mode :character
## Mean :32.69 Mean : 0.5501
## 3rd Qu.:40.00 3rd Qu.: 0.0000
## Max. :73.00 Max. :12.0000
## salario_diario estado_civil motivo_de_baja dv_bajas
## Min. :144.4 Length:349 Length:349 Min. :0.0000
## 1st Qu.:176.7 Class :character Class :character 1st Qu.:0.0000
## Median :180.7 Mode :character Mode :character Median :1.0000
## Mean :178.3 Mean :0.6762
## 3rd Qu.:180.7 3rd Qu.:1.0000
## Max. :500.0 Max. :1.0000
nueva_bd_rh$edad <- as.numeric(nueva_bd_rh$edad)
nueva_bd_rh$genero <- as.factor(nueva_bd_rh$genero)
nueva_bd_rh$antiguedad <- as.numeric(nueva_bd_rh$antiguedad)
nueva_bd_rh$puesto<- as.factor(nueva_bd_rh$puesto)
nueva_bd_rh$salario_diario <- as.numeric(nueva_bd_rh$salario_diario)
nueva_bd_rh$estado_civil<- as.factor(nueva_bd_rh$estado_civil)
nueva_bd_rh$dv_bajas <- as.numeric(nueva_bd_rh$dv_bajas)
nueva_bd_rh$motivo_de_baja<- as.factor(nueva_bd_rh$motivo_de_baja)
summary(nueva_bd_rh)
## edad genero antiguedad puesto
## Min. :18.00 FEMENINO :200 Min. : 0.0000 AYUDANTE GENERAL :246
## 1st Qu.:24.00 MASCULINO:149 1st Qu.: 0.0000 COSTURERA : 21
## Median :30.00 Median : 0.0000 SOLDADOR : 16
## Mean :32.69 Mean : 0.5501 AYUDANTE DE EMBARQUES: 7
## 3rd Qu.:40.00 3rd Qu.: 0.0000 RESIDENTE : 7
## Max. :73.00 Max. :12.0000 CHOFER : 6
## (Other) : 46
## salario_diario estado_civil motivo_de_baja dv_bajas
## Min. :144.4 CASADO :108 ABANDONO : 1 Min. :0.0000
## 1st Qu.:176.7 DIVORCIADO : 6 BAJA POR FALTAS :141 1st Qu.:0.0000
## Median :180.7 SOLTERO :154 JUBILACION : 1 Median :1.0000
## Mean :178.3 UNION LIBRE: 81 RENUNCIA VOLUNTARIA: 85 Mean :0.6762
## 3rd Qu.:180.7 TERMINO DE CONTRATO: 8 3rd Qu.:1.0000
## Max. :500.0 NA's :113 Max. :1.0000
##
nueva_bd_rh$dv_bajas<-as.factor(nueva_bd_rh$dv_bajas)
nueva_bd_rh$dv_bajas<-fct_recode(nueva_bd_rh$dv_bajas, "BAJA"="1","NO BAJA"="0")
tapply(nueva_bd_rh$salario_diario,
list(nueva_bd_rh$genero,nueva_bd_rh$estado_civil), mean)
## CASADO DIVORCIADO SOLTERO UNION LIBRE
## FEMENINO 179.1338 180.68 175.5099 177.2578
## MASCULINO 180.2972 178.70 180.7174 177.3359
En esta tabla podemos observar el promedio de salario por estado civil y género, donde en este caso, el segmento que mas gana son los hombres solteros, segudios por las mujeres divorciadas y después los hombres casados.
set.seed(123)
training<-nueva_bd_rh$dv_bajas %>%
createDataPartition(p=0.75,list=FALSE)
train.data<-nueva_bd_rh[training, ]
test.data<-nueva_bd_rh[-training, ]
model<-glm(dv_bajas~salario_diario+estado_civil, data=train.data, family=binomial(link='logit'))
summary(model)
##
## Call:
## glm(formula = dv_bajas ~ salario_diario + estado_civil, family = binomial(link = "logit"),
## data = train.data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.7407 -1.3222 0.7341 0.8478 1.2579
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.914582 0.898918 1.017 0.3090
## salario_diario -0.003212 0.004794 -0.670 0.5028
## estado_civilDIVORCIADO -0.336367 0.847835 -0.397 0.6916
## estado_civilSOLTERO 0.504169 0.307234 1.641 0.1008
## estado_civilUNION LIBRE 0.839215 0.373550 2.247 0.0247 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 330.20 on 261 degrees of freedom
## Residual deviance: 323.16 on 257 degrees of freedom
## AIC: 333.16
##
## Number of Fisher Scoring iterations: 4
En este modelo de regresión podemos interpretar que los estados civiles de soltero y unión libre son un factor que aumentan la probabilidad de ocasionar una baja de un colaborador. Por el otro lado, el estado civil de divorciado, cuenta con una tendencia negativa, lo que indica que si los colaboradores divorciados aumentan, las bajas disminuirán.
ggplot(nueva_bd_rh,aes(x=salario_diario, y=as.numeric(dv_bajas) - 1)) +
geom_point(alpha=.5) +
stat_smooth(method="glm", se=FALSE, fullrange=TRUE, method.args = list(family=binomial)) +
ylab("Probability") + xlim(100,500)+
labs(
title = "Logistic Regression Model",
x = "Salario Diario",
y = "Probabilidad de Bajas"
)
Con esta gráfica podemos deducir que hay una tendencia negativa de bajas, ya que entre más incrementa el salario diario, es decir, entre más salario se les pague a los colaboradores, menos bajas se registrarán. Por lo que podemos observar una acumulación de bajas de colaboradores que ganan menos de $200 al día, teniendo solo un outlier que gana $500.
FORM produce en promedio 3708.52 kilos de merma por mes.
Se produjo una mayor cantidad de piezas en el mes de agosto.
A un tiempo mayor de producción, FORM le invierte menos horas de calidad en las unidades producidas.
FORM tiene ubicada la mayor parte de su scrap en pre-producción.
Las unidades vendidas de carros aumentaron los últimos 5-10 años y se pronostica que haya un crecimiento positivo de los vehículos en circulación con el paso del tiempo.
El tipo de cambio es la variable que más afecta e impacta la exportación de vehículos ligeros. Entre menos valga el peso (aumente el TC), habrá menos exportaciones.
Si incrementa el empleo en México, se predice que las ventas de vehículos ligeros incrementarán también.
La mayor cantidad de bajas que FORM ha presentado son de colaboradores jóvenes (entre los 20-30 años en su mayoría), siendo el principal motivo la “Baja por Faltas” (59%), hay una mayoría de mujeres y la mayor parte de los ex-colaboradores de Form eran Ayudantes generales (76%).
Actualmente FORM cuenta casi con la misma cantidad de colaboradores femeninos y masculinos y con un rango de edades entre los 18 y los 73 años. Asimismo el promedio de salario ganado es de 170 pesos diarios y los hombres casados y las mujeres solteras son los que ganan más.
Los clientes más importantes para FORM (que más piezas programadas tienen) son Yanfeng, Stabilus 1 y Varroc.
Los clientes con los que FORM presenta más horas de retraso en entregas es con Mahle y Printel (teniendo hasta 20h), clientes que no ordenan muchas piezas. Lo que puede significar que los clientes importantes son prioritarios para FORM y es por eso que con ellos no sufren retrasos.
Hay una tendencia negativa entre el salario y las bajas de colaboradores, si este incrementa, las bajas disminuirán.
Se pronostica que en los próximos años no habrá un incremento en el tiempo de retrasos de entrega de pedidos en los procesos de FORM, sino que se mantendrá estable independientemente del incremento de scrap que se espera en los próximos años, lo cual va de la mano con el incremento de la producción.
Principalmente se sugiere que FORM cuente con una estandarización de sus bases de datos, que bien, cambien el formato de las variables, solo pongan información que necesiten, que utilicen la misma tipografía, colores y sean ordenados con donde ponen la información. Esto se puede resolver mediante la dedicación de horas de calidad y la utilización de filtros para verificar que los datos cumplan con ciertas métricas y se puedan analizar más adelante, o bien, tomando cursos externos (o contratación de expertos en analítica) para la corrección óptima de sus bases de datos.
Asimismo al estar usando las bases de datos varios colaboradores en conjunto y actualizarlas al día, se suelen cometer varios errores, pues como no es su principal enfoque, lo pueden hacer sin cuidado y sin ponerle atención a los detalles. Por lo que se popone, crear un departamento de analítica de datos en FORM y que esta esté encargada de capturar toda la información para así evitar errores de dedo y hacerlo adecuadamente.
Por último, al FORM ser una empresa chica/mediana sin un departamento de analítica de datos, se sugiere que la empresa se incursione en una plataforma inteligente la cual sistematice la captura de datos y visualización de los mismos, o bien, en un departamento de analítica como se mencionó anteriormente y que este sea capaz de generar reportes con visualizaciones, cumplimiento de metaas y hallazgos relevantes para que los datos registrados sean útiles y se puedan crear nuevas estrategias de mejora.
Business Analytics es un método o una solución que las empresas emplean en sus procesos tomando en cuenta su información interna y externa. Personalamente pienso que sus principales funciones consisten en limpiar y transformar sus datos. Sin embargo, algunos de sus principales objetivos son ¨determinar qué conjuntos de datos son útiles, clasificarlos dependiendo de las relaciones existentes entre las variables, organizarlos, filtrarlos, limpiarlos y examinarlos.
El depto. de Business Analytics colabora con el de Business Intelligence, ósea, ya que los colaboradores tienen la información limpia y transformada (BA), estos pueden tomar decisiones más inteligentes basadas en los datos analizados al utilizar diferentes herramientas como el análisis estadístico y predictivo, haciendo estartegias arraigadas principalmente a los objetivos específicos de la empresa, como puede ser el aumentar los ingresos, la productividad, la eficiencia y el rendimiento organizacional (BI).
Para ser mas claros, la relación entre el “Business Intelligence” y el “Business Analytics” es que un experto en Business Intelligence, toma y procesa la información generada por los expertos en Business Analytics y la convierte en decisiones estratégicas para su negocio.
Un “Key Performance Indicator” es una métrica utilizada en las empresas para medir el desempeño de un área específica. Estas analizan si sus acciones están teniendo los resultados esperados, para después poder tomar decisiones y crear estrategias inteligentes basadas en sus datos.
Asimismo, los KPI´s deben de tener ciertas características para ser información valiosa y útil para las empresas. Estos deben de ser: específicos, continuos y periódicos (medir sobre un cierto periodo de tiempo), objetivos, cuantificables, medibles, realistas, concisos, coherentes y relevantes.
Algunos ejemplos de KPIs comúnmente utilizados en empresas son: - Número de seguidores. - Retorno de la inversión. - Número de ventas mensuales. - Ratio de liquidez.
Tomando en cuenta el análisis planteado para el socioformador FORM, se propone que implemente las siguientes métricas (KPI´s) para medir sus resultados y generar estrategias:
Tasa de rotación de colaboradores: Para el departamento de Recursos Humanos esta métrica puede ser sumamante enriquecedora pues permite conocer el % de altas y bajas en relación al número de empleados. Con esta información, el departamento puede conocer las causas, periodos de tiempo o características específicas por las cuales la retención de colaboradores esta fallando y proponer estrategias para su solución.
Takt time: Esta métrica es ideal para medir el desempeño de las áreas de producción, delivery performance y plan de FORM, pues bien este KPI consiste en medir el tiempo máximo que se puede dedicar a fabricar un producto para cumplir con los plazos de tiempo planeados. Este ayuda a planificar pedidos y decidir si se acepta o no el encargo de un cliente para así evitar horas de retraso.
Tasa de deserción de clientes: Este KPI es escencial para el área comercial y de servicio al cliente de FORM, pues bien al ser FORM una empresa con un segmento muy específico, la retención de sus clientes es sumamente importante, por lo que esta métrica mide la fidelidad calculando la proporción de clientes perdidos y, por lo tanto, ayuda a medir la satisfacción de los clientes.
Cera, C. (2021). 32 KPI comerciales para ventas. appvizer.es. Recuperado 21 de octubre de 2022, de https://www.appvizer.es/revista/relacion-cliente/software-crm/kpi-comerciales
Insightsoftware. (2022). Ejemplos de los 30 mejores KPI y métricas de producción para la creación de informes en 2021. insightsoftware Spain. Recuperado 21 de octubre de 2022, de https://insightsoftware.com/es/blog/30-manufacturing-kpis-and-metric-examples/
Galiana, P. (2022). Qué es Business Analytics: definición,tipos y diferencias. Thinking for Innovation. Recuperado 21 de octubre de 2022, de https://www.iebschool.com/blog/que-es-business-analytics-definiciontipos-y-diferencias-big-data/
Bureau of Labor Statistics. (2022). United States: Inflation rate from 1990 to 2022. Statista. Recuperado 21 de octubre de 2022, de https://0-www-statista-com.biblioteca-ils.tec.mx/statistics/191077/inflation-rate-in-the-usa-since-1990/
INEGI. (2022). Venta, producción y exportación de vehículos ligeros. Recuperado 21 de octubre de 2022, de https://www.inegi.org.mx/app/tabulados/default.html?nc=100100090_a
International Trade Administration. (2022). Number of new passenger vehicles and light trucks exported from the United States to China from 2006 to 2021. Statista. https://0-www-statista-com.biblioteca-ils.tec.mx/statistics/244488/vehicle-exports-from-the-united-states-to-china/
TRADING ECONOMICS. (2022). Estados Unidos - PIB | 1960-2021 Datos | 2022-2024 Expectativa. Recuperado 21 de octubre de 2022, de https://es.tradingeconomics.com/united-states/gdp
BEA. (2022). U.S. car sales from 1951 to 2021. Statista. Recuperado 21 de octubre de 2022, de https://0-www-statista-com.biblioteca-ils.tec.mx/statistics/199974/us-car-sales-since-1951/