FORM es una empresa experta en el diseño de empaque y gestión de ahorro dentro de la industria automotriz, su principal objetivo es desarrollar soluciones de empaque con un valor agregado enfocado en la cadena de suministro de sus clientes, ofreciendo protección en los productos, y considerando las necesidades productivas, operativas y de almacenaje, mientras que reducen costos, mejoran la eficiencia corporativa y protegiendo al medio ambiente.
rh_colaboradores <- read.csv("C:\\Users\\ximen\\Downloads\\FORM - Recursos Humanos - colaboradores.csv")
rh_bajas <- read.csv("C:\\Users\\ximen\\Downloads\\FORM - Recursos Humanos - BAJAS BUENA (1).csv")
plan <- read.csv("C:\\Users\\ximen\\Downloads\\Delivery Plan FINAL - EQUIPO 4 .csv")
delivery_performance <- read.csv("C:\\Users\\ximen\\Downloads\\FORM - Delivery Performance BD BUENA.csv")
bd_produccion <- read.csv("C:\\Users\\ximen\\Downloads\\EMI_CARTON.csv")
bd_merma <- read.csv("C:\\Users\\ximen\\OneDrive\\Escritorio\\merma.csv")
bd_scrap <- read.csv("C:\\Users\\ximen\\Downloads\\FORM - Scrap (1).csv")
prediccion_mx <- read.csv("C:\\Users\\ximen\\Downloads\\encoded-bd_prediccion.csv")
pronostico_mx <- read.csv("C:\\Users\\ximen\\Downloads\\encoded-vehiculos_en_circulacion (2).csv")
bd_externa <- read.csv("C:\\Users\\ximen\\OneDrive\\Escritorio\\Producción de cartón en México.csv")
pronostico_usa <- read.csv("C:\\Users\\ximen\\Downloads\\vehicle_sales_usa.csv")
prediccion_usa <- read.csv("C:\\Users\\ximen\\Downloads\\encoded-prediccion_usa (3).csv")
scrap <- read.csv("C:\\Users\\ximen\\OneDrive\\Escritorio\\scrap_bd_limpia.csv")
bd_performance <- read.csv("C:\\Users\\ximen\\OneDrive\\Escritorio\\performance_bd_limpia.csv")
bajas_clusters <- read.csv("C:\\Users\\ximen\\Downloads\\FORM - Recursos Humanos - BAJAS evidencia).csv")
rh_logistic <- read.csv("C:\\Users\\ximen\\Downloads\\encoded-rh_logistic (2).csv")
#install.packages("foreign")
library(foreign)
#install.packages("dplyr")
library(dplyr)
#install.packages("ggplot2")
library(ggplot2)
#install.packages("lattice")
library(lattice)
#install.packages("psych")
library(psych)
#install.packages("corrplot")
library(corrplot)
#install.packages("jtools")
library(jtools)
#install.packages("lmtest")
library(lmtest)
#install.packages("car")
library(car)
#install.packages("factoextra")
library(factoextra)
#install.packages("ggfortify")
library(ggfortify)
#install.packages("ggalluvial")
library(ggalluvial)
#install.packages("janitor")
library(janitor)
#install.packages("tidyr")
library(tidyr)
#install.packages("data.table")
library(data.table)
#install.packages("plyr")
library(plyr)
#install.packages("naniar")
library(naniar)
#install.packages("Hmisc")
library(Hmisc)
#install.packages("tidyverse")
library(tidyverse)
#install.packages("tseries")
library(tseries)
#install.packages("forecast")
library(forecast)
#install.packages("astsa")
library(astsa)
#install.packages("olsrr")
library(olsrr)
#install.packages("corrplot")
library(corrplot)
#install.packages("viridis")
library(viridis)
#install.packages("scales")
library(scales)
#install.packages("caret")
library(caret)
#install.packages("lubridate")
library(lubridate)
Limpieza, Transformación y Organización de datos
colaboradores <- clean_names(rh_colaboradores)
summary(colaboradores)
## no_empleado nombre_completo edad genero
## Min. : 1 Length:113 Min. :18.00 Length:113
## 1st Qu.: 29 Class :character 1st Qu.:26.00 Class :character
## Median : 57 Mode :character Median :34.00 Mode :character
## Mean : 57 Mean :36.06
## 3rd Qu.: 85 3rd Qu.:45.00
## Max. :113 Max. :73.00
##
## fecha_alta antiguedad puesto mano_de_obra
## Length:113 Min. : 0.000 Length:113 Length:113
## Class :character 1st Qu.: 0.000 Class :character Class :character
## Mode :character Median : 0.000 Mode :character Mode :character
## Mean : 1.425
## 3rd Qu.: 2.000
## Max. :12.000
##
## salario_diario estado_civil
## Min. :144.4 Length:113
## 1st Qu.:176.7 Class :character
## Median :180.7 Mode :character
## Mean :179.1
## 3rd Qu.:180.7
## Max. :337.1
## NA's :2
colaboradores <- subset(colaboradores, select = -c(no_empleado, nombre_completo, fecha_alta, mano_de_obra))
Con esta técnica se logran eliminar las columnas que no son necesarias para el análisis.
colaboradores$salario_diario[is.na(colaboradores$salario_diario)]<-mean(colaboradores$salario_diario, na.rm = TRUE)
summary (colaboradores)
## edad genero antiguedad puesto
## Min. :18.00 Length:113 Min. : 0.000 Length:113
## 1st Qu.:26.00 Class :character 1st Qu.: 0.000 Class :character
## Median :34.00 Mode :character Median : 0.000 Mode :character
## Mean :36.06 Mean : 1.425
## 3rd Qu.:45.00 3rd Qu.: 2.000
## Max. :73.00 Max. :12.000
## salario_diario estado_civil
## Min. :144.4 Length:113
## 1st Qu.:176.7 Class :character
## Median :180.7 Mode :character
## Mean :179.1
## 3rd Qu.:180.7
## Max. :337.1
Esta técnica se realizó con el fin de que no quedaran espacios en blanco y no eliminar por completo las filas que tienen contenido importante.
write.csv(colaboradores, file = "colaboradores_limpia_bd.csv", row.names = FALSE)
str(colaboradores)
## 'data.frame': 113 obs. of 6 variables:
## $ edad : int 67 43 73 32 57 38 55 26 27 37 ...
## $ genero : chr "MASCULINO" "FEMENINO" "MASCULINO" "FEMENINO" ...
## $ antiguedad : int 12 11 11 9 8 8 7 6 5 5 ...
## $ puesto : chr "SUPERVISOR DE MAQUINA" "SUPERVISOR DE PEGADO" "EXTERNO" "SUPERVISORA" ...
## $ salario_diario: num 177 177 177 337 179 ...
## $ estado_civil : chr "Soltero" "Soltero" "Soltero" "Casado" ...
Dentro de la base de datos de colaboradores se encuentran 6 variables con 113 registros.
Variable<-c("Edad", "Genero", "Antiguedad", "Puesto", "Salario_diario_imss", "Estado_civil")
Type<-c("Cuantitativa (discreta)", "Cualitativa", "Cuantitativa (discreta)", "Cualitativa", "Cuantitativa (continua)", "Cualitativa")
Measurement <-c("Años", "NA", "Años", "NA", "Pesos", "NA")
table<-data.frame(Variable,Type, Measurement)
knitr::kable(table)
| Variable | Type | Measurement |
|---|---|---|
| Edad | Cuantitativa (discreta) | Años |
| Genero | Cualitativa | NA |
| Antiguedad | Cuantitativa (discreta) | Años |
| Puesto | Cualitativa | NA |
| Salario_diario_imss | Cuantitativa (continua) | Pesos |
| Estado_civil | Cualitativa | NA |
bajas <- clean_names(rh_bajas)
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))
summary(bajas)
## edad genero motivo_de_baja no_dias
## Min. :19.00 Length:236 Length:236 Min. : 0.00
## 1st Qu.:23.00 Class :character Class :character 1st Qu.: 9.00
## Median :29.00 Mode :character Mode :character Median : 19.00
## Mean :31.08 Mean : 79.76
## 3rd Qu.:37.00 3rd Qu.: 49.00
## Max. :61.00 Max. :1966.00
## NA's :3 NA's :23
## puesto salario_diario_imss estado_civil
## 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
##
Al igual que en la base de datos anterior, estas columnas se eliminan, ya que, no muestran información relevante en el siguiente análisis.
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)
summary(bajas)
## edad genero motivo_de_baja no_dias
## Min. :19.00 Length:236 Length:236 Min. : 0.00
## 1st Qu.:23.00 Class :character Class :character 1st Qu.: 9.00
## Median :29.00 Mode :character Mode :character Median : 19.00
## Mean :31.08 Mean : 73.84
## 3rd Qu.:37.00 3rd Qu.: 42.50
## Max. :61.00 Max. :1966.00
## puesto salario_diario_imss estado_civil
## 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
La mediana en no_días se utiliza porque la variabilidad en esta variable no es tan significativa, sin embargo, se usa el promedio en edad porque hay rangos muy distintos entre los datos de esta misma variable.
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
str(bajas)
## 'data.frame': 236 obs. of 7 variables:
## $ edad : num 32 36 24 21 30 46 29 31 50 19 ...
## $ genero : Factor w/ 2 levels "FEMENINO","MASCULINO": 2 1 1 1 1 1 1 2 2 2 ...
## $ 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/ 21 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/ 4 levels "CASADO","DIVORCIADO",..: 3 4 1 3 3 3 4 4 3 3 ...
Dentro de la base de datos de bajas, se encuentran 7 variables con 236 registros.
Variable<-c("Edad", "Genero", "Motivo_de_baja", "No_dias", "Puesto", "Salario_diario_imss", "Estado_civil")
Type<-c("Cuantitativa (discreta)","Cualitativa", "Cualitativa", "Cuantitativa (discreta)", "Cualitativa", "Cuantitativa (continua)", "Cualitativa")
Measurement <-c("Años", "NA", "NA", "Dias", "NA", "Pesos", "NA")
table<-data.frame(Variable,Type, Measurement)
knitr::kable(table)
| Variable | Type | Measurement |
|---|---|---|
| Edad | Cuantitativa (discreta) | Años |
| Genero | Cualitativa | NA |
| Motivo_de_baja | Cualitativa | NA |
| No_dias | Cuantitativa (discreta) | Dias |
| Puesto | Cualitativa | NA |
| Salario_diario_imss | Cuantitativa (continua) | Pesos |
| Estado_civil | Cualitativa | NA |
delivery_plan <- clean_names(plan)
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=feb_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" "V_mar_23"
## [26] "mar_23" "total_meses"
Esta técnica se realizó para que los meses salgan en orden de tiempo, es decir, desde el más antiguo, hasta el más reciente, y no alfabéticamente.
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 ...
## $ V_mar_23 : int [1:2310] 0 0 0 0 0 0 0 0 0 0 ...
## $ 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 ...
Con esta técnica se crean 2 nuevas columnas, y a la vez se disminuye el total de columnas.
delivery_plan1 <- filter(delivery_plan, Unidades>0)
Estatécnica sirve para eliminar rengoles/clientes sin registros.
delivery_plan2 <- delivery_plan1
delivery_plan2 <- subset (delivery_plan1, 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, mar_23, total_meses))
summary(delivery_plan2)
## cliente Mes Unidades
## Length:590 Length:590 Min. : 1.0
## Class :character Class :character 1st Qu.: 30.0
## Mode :character Mode :character Median : 80.0
## Mean : 358.4
## 3rd Qu.: 300.0
## Max. :13120.0
Se dejan solamente las variables consideradas necesarias, es decir, las variables Cliente, Fecha, y Unidades
write.csv(delivery_plan2, file = "bd_deliveryplan_limpia.csv", row.names = FALSE)
str(delivery_plan2)
## tibble [590 × 3] (S3: tbl_df/tbl/data.frame)
## $ cliente : chr [1:590] "STB3" "STB3" "STB3" "STB3" ...
## $ Mes : chr [1:590] "B_jul_21" "C_ago_21" "E_oct_21" "G_dic_21" ...
## $ Unidades: int [1:590] 140 530 200 150 230 500 184 125 55 55 ...
La base de datos contiene 3 variables con 590 registros.
Variable<-c("Cliente", "Mes", "Unidades")
Type<-c("Cualitativa", "Cuantitativa (discreta)", "Cuantitativa discreta")
Measurement <-c("NA", "Mes", "Unidades")
table<-data.frame(Variable,Type, Measurement)
knitr::kable(table)
| Variable | Type | Measurement |
|---|---|---|
| Cliente | Cualitativa | NA |
| Mes | Cuantitativa (discreta) | Mes |
| Unidades | Cuantitativa discreta | Unidades |
performance <- clean_names(delivery_performance)
performance <- subset(performance, select = -c(x, x_1, x_2, x_3))
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
## Min. :0
## 1st Qu.:0
## Median :0
## Mean :0
## 3rd Qu.:0
## Max. :0
## NA's :25
Se eliminan columnas innecesarias y sin información.
performance$fecha <- as.Date(performance$fecha, format = "%d/%m/%Y")
tibble(performance)
## # A tibble: 324 × 5
## fecha printel mahle magna varroc
## <date> <dbl> <dbl> <dbl> <dbl>
## 1 2021-07-22 0 2.65 0 0
## 2 2021-07-25 1.8 2.85 0 0
## 3 2021-07-26 1.1 2.5 0 0
## 4 2021-07-27 0.5 2.5 0 0
## 5 2021-07-28 0.5 2.55 0 0
## 6 2021-07-29 1 2.65 0 0
## 7 2021-08-01 1 2.51 0 0
## 8 2021-08-02 1 3 0 0
## 9 2021-08-03 0 3 0 0
## 10 2021-08-04 1.2 3.05 0 0
## # … with 314 more rows
Facilita el análisis y las visualizaciones próximas.
performance$printel <- substr(performance$printel, start = 1, stop = 2)
performance$printel <- as.numeric(performance$printel)
performance$mahle <- substr(performance$mahle, start = 1, stop = 2)
performance$mahle <- as.numeric(performance$mahle)
performance$magna <- substr(performance$magna, start = 1, stop = 2)
performance$magna <- as.numeric(performance$magna)
performance$varroc <- substr(performance$varroc, start = 1, stop = 2)
performance$varroc <- as.numeric(performance$varroc)
str(performance)
## 'data.frame': 324 obs. of 5 variables:
## $ fecha : Date, format: "2021-07-22" "2021-07-25" ...
## $ printel: num 0 1 1 0 0 1 1 1 0 1 ...
## $ mahle : num 2 2 2 2 2 2 2 3 3 3 ...
## $ magna : num 0 0 0 0 0 0 0 0 0 0 ...
## $ varroc : num 0 0 0 0 0 0 0 0 0 0 ...
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 varroc
## Min. :2021-07-22 Min. :0.0000 Min. :-9.00 Min. :0 Min. :0
## 1st Qu.:2021-10-20 1st Qu.:0.0000 1st Qu.: 2.00 1st Qu.:0 1st Qu.:0
## Median :2022-02-07 Median :0.0000 Median : 3.00 Median :0 Median :0
## Mean :2022-01-30 Mean :0.3395 Mean : 2.21 Mean :0 Mean :0
## 3rd Qu.:2022-04-27 3rd Qu.:0.2500 3rd Qu.: 3.00 3rd Qu.:0 3rd Qu.:0
## Max. :2022-07-23 Max. :4.0000 Max. :20.00 Max. :0 Max. :0
Con el fin de no tener espacios en blanco.
write.csv(performance, file="bd_performance_limpia.csv", row.names = FALSE)
str(performance)
## 'data.frame': 324 obs. of 5 variables:
## $ fecha : Date, format: "2021-07-22" "2021-07-25" ...
## $ printel: num 0 1 1 0 0 1 1 1 0 1 ...
## $ mahle : num 2 2 2 2 2 2 2 3 3 3 ...
## $ magna : num 0 0 0 0 0 0 0 0 0 0 ...
## $ varroc : num 0 0 0 0 0 0 0 0 0 0 ...
Delivery performance tiene una base de datos de 5 variables con 324 registros.
Variable<-c("Fecha", "Printel", "Mahle", "Magna", "Varroc")
Type<-c("Cuantitativa continua ", "Cuantitativa (discreta)", "Cuantitativa (discreta)", "Cuantitativa (discreta)", "Cuantitativa (discreta)")
Measurement <-c("Dia", "minutos", "minutos", "minutos", "minutos")
table<-data.frame(Variable,Type, Measurement)
knitr::kable(table)
| Variable | Type | Measurement |
|---|---|---|
| Fecha | Cuantitativa continua | Dia |
| Printel | Cuantitativa (discreta) | minutos |
| Mahle | Cuantitativa (discreta) | minutos |
| Magna | Cuantitativa (discreta) | minutos |
| Varroc | Cuantitativa (discreta) | minutos |
produccion <- clean_names(bd_produccion)
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))
summary(produccion)
## fecha cliente piezas_prog tmo_min
## Length:3988 Length:3988 Length:3988 Length:3988
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## estacion_arranque laminas_procesadas tiempo_calidad
## Length:3988 Min. : 0 Length:3988
## Class :character 1st Qu.: 0 Class :character
## Mode :character Median : 51 Mode :character
## Mean : 102
## 3rd Qu.: 184
## Max. :1263
Se eliminan variables que no se necesitan en el análisis.
produccion$piezas_prog<-as.numeric(produccion$piezas_prog)
## Warning: NAs introducidos por coerción
produccion$tmo_min<-as.numeric(produccion$tmo_min)
## Warning: NAs introducidos por coerción
produccion$laminas_procesadas<-as.numeric(produccion$laminas_procesadas)
produccion$tiempo_calidad<-as.numeric(produccion$tiempo_calidad)
## Warning: NAs introducidos por coerción
produccion$fecha <- as.Date(produccion$fecha, format = "%d/%m/%Y")
summary(produccion)
## fecha cliente piezas_prog tmo_min
## Min. :2022-07-15 Length:3988 Min. : 1.0 Min. : 0.00
## 1st Qu.:2022-08-03 Class :character 1st Qu.: 100.0 1st Qu.: 15.00
## Median :2022-08-20 Mode :character Median : 153.5 Median : 20.00
## Mean :2022-08-19 Mean : 180.3 Mean : 22.37
## 3rd Qu.:2022-09-06 3rd Qu.: 200.0 3rd Qu.: 25.00
## Max. :2022-09-21 Max. :2000.0 Max. :150.00
## NA's :180 NA's :824
## estacion_arranque laminas_procesadas tiempo_calidad
## Length:3988 Min. : 0 Min. : 0.0000
## Class :character 1st Qu.: 0 1st Qu.: 0.0000
## Mode :character Median : 51 Median : 1.0000
## Mean : 102 Mean : 0.8631
## 3rd Qu.: 184 3rd Qu.: 1.0000
## Max. :1263 Max. :22.0000
## NA's :346
produccion$piezas_prog <- str_replace(produccion$piezas_prog, "[aeiouLAM=NbBsS]", "")
produccion$piezas_prog <- as.integer(produccion$laminas_procesadas)
Los datos deben ser númericos.
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 Length:3988 Min. : 0 Min. : 0.00
## 1st Qu.:2022-08-03 Class :character 1st Qu.: 0 1st Qu.: 15.00
## Median :2022-08-20 Mode :character Median : 51 Median : 20.00
## Mean :2022-08-19 Mean : 102 Mean : 21.88
## 3rd Qu.:2022-09-06 3rd Qu.: 184 3rd Qu.: 25.00
## Max. :2022-09-21 Max. :1263 Max. :150.00
## estacion_arranque laminas_procesadas tiempo_calidad
## Length:3988 Min. : 0 Min. : 0.000
## Class :character 1st Qu.: 0 1st Qu.: 1.000
## Mode :character Median : 51 Median : 1.000
## Mean : 102 Mean : 0.875
## 3rd Qu.: 184 3rd Qu.: 1.000
## Max. :1263 Max. :22.000
Para no tener espacios vacíos.
write.csv(produccion, file="bd_produccion_limpia.csv", row.names = FALSE)
str(produccion)
## 'data.frame': 3988 obs. of 7 variables:
## $ fecha : Date, format: "2022-07-16" "2022-07-22" ...
## $ cliente : chr "TRMX" "STABILUS 3" "STABILUS 3" "TRMX" ...
## $ piezas_prog : int 3 2 2 1 1 1 0 3 0 0 ...
## $ tmo_min : num 10 10 10 10 10 10 20 10 10 10 ...
## $ estacion_arranque : chr "C1Y2" "C1Y2" "C1Y2" "C1" ...
## $ laminas_procesadas: num 3 2 2 1 1 1 0 3 0 0 ...
## $ tiempo_calidad : num 1 1 2 1 1 1 0 1 0 0 ...
Esta base de datos consta de 7 variables con 3988 registros.
Variable<-c("Fecha","Cliente", "Piezas_prog", "Tmo_min", "estacion_arranque","Laminas_procesadas.", "Tiempo_calidad")
Type<-c("Cuantitativa (continua)","cualitativa", "cuantitativa discreta", "cuantitativa continua ", "Cualitativa","cuantitativa discreta", "cuantitativa continua ")
Measurement <-c("Dia","NA", "unidades", "minutos", "NA","unidades", "hora")
table<-data.frame(Variable,Type, Measurement)
knitr::kable(table)
| Variable | Type | Measurement |
|---|---|---|
| Fecha | Cuantitativa (continua) | Dia |
| Cliente | cualitativa | NA |
| Piezas_prog | cuantitativa discreta | unidades |
| Tmo_min | cuantitativa continua | minutos |
| estacion_arranque | Cualitativa | NA |
| Laminas_procesadas. | cuantitativa discreta | unidades |
| Tiempo_calidad | cuantitativa continua | hora |
merma <- clean_names(bd_merma)
summary(merma)
## fecha mes kilos
## Length:60 Length:60 Length:60
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
merma1<- merma[-c(5,12,19,25,31,36,42,54,59,60),]
Se eliminan filas innecesarias.
merma1$kilos <- as.integer(merma1$kilos)
merma$fecha <- as.Date(merma$fecha, format = "%d/%m/%Y")
merma$mes<-as.factor(merma$mes)
summary(merma1)
## 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
write.csv(merma1, file ="merma_bd_limpia.csv", row.names = FALSE)
str(merma1)
## 'data.frame': 50 obs. of 3 variables:
## $ fecha: chr "01/11/2022" "01/11/2022" "1/22/2022" "1/22/2022" ...
## $ mes : chr "ENERO" "ENERO" "ENERO" "ENERO" ...
## $ kilos: int 5080 3810 2990 2680 3650 4380 3870 3590 3410 3930 ...
Merma tiene una base de datos de 3 variables con 50 variables.
Variable<-c("Fecha", "Mes", "Kilos")
Type<-c("Cuantitativa continua ", "Cualitativa", "Cuantitativa discreta")
Measurement <-c("Dia", "NA", "Cantidad")
table<-data.frame(Variable,Type, Measurement)
knitr::kable(table)
| Variable | Type | Measurement |
|---|---|---|
| Fecha | Cuantitativa continua | Dia |
| Mes | Cualitativa | NA |
| Kilos | Cuantitativa discreta | Cantidad |
scrap <- clean_names(bd_scrap)
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
##
##
##
scrap1 <- scrap [-1,]
scrap1 <- subset(scrap1, select = -c (referencia, producto, unidad_de_medida, ubicacion_de_desecho, estado))
summary(scrap1)
## fecha cantidad ubicacion_de_origen
## Length:249 Min. : 0.00 Length:249
## Class :character 1st Qu.: 1.00 Class :character
## Mode :character Median : 2.00 Mode :character
## Mean : 6.55
## 3rd Qu.: 7.00
## Max. :96.00
scrap1$cantidad <- as.integer(scrap1$cantidad)
str(scrap1)
## 'data.frame': 249 obs. of 3 variables:
## $ fecha : chr "05/08/2022" "26/08/2022" "29/08/2022" "27/08/2022" ...
## $ cantidad : int 6 2 51 12 19 6 12 20 11 15 ...
## $ ubicacion_de_origen: chr "Calidad/Entrega de PT" "Calidad/Entrega de PT" "Pre-Production" "Pre-Production" ...
write.csv(scrap1, file ="scrap_bd_limpia.csv", row.names = FALSE)
str(scrap1)
## 'data.frame': 249 obs. of 3 variables:
## $ fecha : chr "05/08/2022" "26/08/2022" "29/08/2022" "27/08/2022" ...
## $ cantidad : int 6 2 51 12 19 6 12 20 11 15 ...
## $ ubicacion_de_origen: chr "Calidad/Entrega de PT" "Calidad/Entrega de PT" "Pre-Production" "Pre-Production" ...
Scrap cuenta con una base de datos de 3 variables con 249 registros.
variable <- c("Fecha","Cantidad", "`Ubicacion de origen`")
tipo <- c("cuantitativa (continua)","cuantitativa (discreto)", "cualitativa")
measurement <-c("Dia", "Cantidad", "NA")
table <- data.frame (variable, tipo, measurement)
knitr::kable(table)
| variable | tipo | measurement |
|---|---|---|
| Fecha | cuantitativa (continua) | Dia |
| Cantidad | cuantitativa (discreto) | Cantidad |
Ubicacion de origen |
cualitativa | NA |
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")
Esta gráfica nos dice la relación entre las piezas programadas y las fechas, por ejemplo, se puede destacar que a finales de Julio fue el pico más alto en cuanto a piezas programadas, que van más allá de las mil piezas.
ggplot(scrap1, aes(x=ubicacion_de_origen, y=cantidad)) +
geom_bar(stat="identity", fill="brown") + scale_fill_grey() + # Add bars to the plot
labs(title = "Donde se encuentra la merma", # Add a title
subtitle = "RH empresa FORM", # Add a subtitle
caption = "Relación", # Add a caption
x = "Ubicación")
La gráfica anterior permite observar en que parte se encuentra la merma, y en que cantidad, se puede ver que en donde se encuentra la mayor parte de la merma es en la “Pre-producción”, seguido por la “Calidad/Entrega de PT” y finalmente la “Post-produccion”
ggplot(delivery_plan2, aes(Mes,Unidades)) +
geom_bar(stat = "identity") +
scale_fill_brewer(palette = "Set2") + ggtitle("Unidades vendidas por Mes")
Lo que nos permite ver esta gráfica son las unidades vendidas por mes, y
se puede notar que Marzo del 2022 fue un gran mes para Form, ya que, se
vendieron más de 35,000 unidades. De igual forma, Julio del 2021, tiene
una cifra por arriba de las 30,000 unidades vendidas, aún siendo Junio
del 2021 su mes con menos ventas.
hist(colaboradores$edad, freq=TRUE, col="purple", main="Edad en años de los Colaboradores actuales")
Actualmente, dentro de Form, hay colaboradores de todas las edades, sin
embargo, predominan más los colaboradores que tienen entre 25-30 años,
seguido por los colaboradores de entre 20-25 años, esto quiere decir que
hay más empleados jovenes y adultos jovenes según el análisis de esta
gráfica.
table(bajas$motivo_de_baja)
##
## ABANDONO BAJA POR FALTAS JUBILACION RENUNCIA VOLUNTARIA
## 1 141 1 85
## TERMINO DE CONTRATO
## 8
proporciones <- c(1, 141, 1, 85, 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")
El principal motivo entre las bajas de los colaboradores, es la baja por
faltas, por lo tanto, sería necesario estar al pendiente del por qué de
esas faltas, si se deben a la distancia para llegar a la empresa, o si
es por otras razones, y de esa manera es muy probable que haya menos
rotación de empleados.
pie(prop.table(table(scrap1$ubicacion_de_origen)),col=c("#BFEFFF","#FFEC8B","#FFA07A"),main="Ubicacion de origen",las=1)
Esta gráfica nos muestra la misma información pero de una forma más
sencilla de visualizar e interpretar, nuevamente, podemos observar que
donde más hay merma es en la “Pre-produccion”.
ggplot(produccion, aes(x=piezas_prog, y=cliente)) +
geom_point()
Lo que se logra observar a través de este gráfico, es la cantidad de piezas programadas por cada cliente de FORM, como se puede observar, el cliente “YANFENG” es el que más piezas programadas tiene por parte de FORM, mientras que “HANON SYSTEMS” es el que menos tiene.
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")
Esta gráfica interpreta las horas de retraso por cliente que tiene la
empresa FORM, aquí se puede observar que con predomina el cliente MAHLE
con más horas de retraso, mientras que MAGNA y VARROC tienen muy pocas
horas de retraso por parte de FORM.
ggplot(data=colaboradores, mapping = aes(edad, salario_diario)) + geom_point(aes(color = genero)) + theme_bw()
Se puede observar a través de este gráfico, que en su mayoría, existe un
salario muy equitativo, tanto para mujeres como para hombres, también,
otro dato importante es que la edad tampoco influye mucho en el salario.
Por otro lado, la mayoría del salario es menor a $200 pesos MXN, con
excepción de 6 personas.
La primer propuesta para FORM va enfocada al área de Recursos Humanos, y la idea principal, es que se haga una mejora al momento de contratar gente, analizando a través de los datos obtenidos, si la persona tiene probabilidades de estar dentro del porcentaje de bajas por faltas, y la razón, ya sea porque viven lejos, por el transporte, porque tienen hijos, por enfermedad, etc. Es importante conocer a los empleados y ofrecerles estrategias que le permitan sentirse bien dentro de la empresa y así evitar que exista tanta rotación de empleados.
La segunda propuesta es mejorar la estrategia de producción, sobre todo con clientes en específico, con los que el retraso puede extenderse demasiado. La idea es implementar mejor organización y funcionamiento del proceso de producción, y de ser necesario, incluir más empleados en la producción que se dirige hacia clientes como MAHLE, y así lograrán de igual forma optimizar el tiempo.
sapply(bd_externa, function(x) sum(is.na(x)))
## State.ID State Region Industry.Group.ID
## 975 0 975 975
## Industry.Group Economic.Unit
## 0 975
bd_externa <- na.omit(bd_externa)
bd_externa
## State.ID State Region Industry.Group.ID
## 1 1 Aguascalientes 2 3221
## 2 2 Baja California 1 3221
## 3 5 Coahuila de Zaragoza 1 3221
## 4 8 Chihuahua 1 3221
## 5 9 Ciudad de Mexico 3 3221
## 6 10 Durango 2 3221
## 7 11 Guanajuato 2 3221
## 8 13 Hidalgo 3 3221
## 9 14 Jalisco 2 3221
## 10 15 Estado de Mexico 3 3221
## 11 16 Michoacan de Ocampo 2 3221
## 12 17 Morelos 3 3221
## 13 19 Nuevo Leon 1 3221
## 14 20 Oaxaca 4 3221
## 15 21 Puebla 3 3221
## 16 22 Queretaro 3 3221
## 17 24 San Luis Potosi 2 3221
## 18 25 Sinaloa 1 3221
## 19 26 Sonora 1 3221
## 20 27 Tabasco 4 3221
## 21 28 Tamaulipas 1 3221
## 22 29 Tlaxcala 3 3221
## 23 30 Veracruz de Ignacio de la Llave 4 3221
## 24 31 Yucatan 4 3221
## Industry.Group Economic.Unit
## 1 Fabricacion de Pulpa, Papel y Carton 1
## 2 Fabricacion de Pulpa, Papel y Carton 8
## 3 Fabricacion de Pulpa, Papel y Carton 1
## 4 Fabricacion de Pulpa, Papel y Carton 6
## 5 Fabricacion de Pulpa, Papel y Carton 17
## 6 Fabricacion de Pulpa, Papel y Carton 2
## 7 Fabricacion de Pulpa, Papel y Carton 11
## 8 Fabricacion de Pulpa, Papel y Carton 3
## 9 Fabricacion de Pulpa, Papel y Carton 13
## 10 Fabricacion de Pulpa, Papel y Carton 43
## 11 Fabricacion de Pulpa, Papel y Carton 3
## 12 Fabricacion de Pulpa, Papel y Carton 1
## 13 Fabricacion de Pulpa, Papel y Carton 20
## 14 Fabricacion de Pulpa, Papel y Carton 1
## 15 Fabricacion de Pulpa, Papel y Carton 151
## 16 Fabricacion de Pulpa, Papel y Carton 5
## 17 Fabricacion de Pulpa, Papel y Carton 6
## 18 Fabricacion de Pulpa, Papel y Carton 5
## 19 Fabricacion de Pulpa, Papel y Carton 5
## 20 Fabricacion de Pulpa, Papel y Carton 1
## 21 Fabricacion de Pulpa, Papel y Carton 1
## 22 Fabricacion de Pulpa, Papel y Carton 3
## 23 Fabricacion de Pulpa, Papel y Carton 6
## 24 Fabricacion de Pulpa, Papel y Carton 3
Variable<-c("State.ID","State","Region","Industry.Group.ID","Industry.Group", "Economic.Unit")
Type<-c("qualitative", "qualitative","qualitative", "qualitative", "qualitative", "quantitative (discreta)")
Measurement<-c("NA","NA","NA","NA","NA","cartón producido")
table<-data.frame(Variable,Type,Measurement)
knitr::kable(table)
| Variable | Type | Measurement |
|---|---|---|
| State.ID | qualitative | NA |
| State | qualitative | NA |
| Region | qualitative | NA |
| Industry.Group.ID | qualitative | NA |
| Industry.Group | qualitative | NA |
| Economic.Unit | quantitative (discreta) | cartón producido |
bd1 <- bd_externa
bd1 <- subset (bd1,select = -c(Industry.Group.ID))
summary(bd1)
## State.ID State Region Industry.Group
## Min. : 1.00 Length:24 Min. :1.000 Length:24
## 1st Qu.:10.75 Class :character 1st Qu.:1.000 Class :character
## Median :18.00 Mode :character Median :2.000 Mode :character
## Mean :17.62 Mean :2.333
## 3rd Qu.:25.25 3rd Qu.:3.000
## Max. :31.00 Max. :4.000
## Economic.Unit
## Min. : 1.00
## 1st Qu.: 1.75
## Median : 5.00
## Mean : 13.17
## 3rd Qu.: 8.75
## Max. :151.00
bd_limpia <- bd1
write.csv(bd_limpia, file = "Produccion_limpia", row.names = FALSE)
summary(bd_limpia)
## State.ID State Region Industry.Group
## Min. : 1.00 Length:24 Min. :1.000 Length:24
## 1st Qu.:10.75 Class :character 1st Qu.:1.000 Class :character
## Median :18.00 Mode :character Median :2.000 Mode :character
## Mean :17.62 Mean :2.333
## 3rd Qu.:25.25 3rd Qu.:3.000
## Max. :31.00 Max. :4.000
## Economic.Unit
## Min. : 1.00
## 1st Qu.: 1.75
## Median : 5.00
## Mean : 13.17
## 3rd Qu.: 8.75
## Max. :151.00
describe.by(bd_limpia)
## Warning: describe.by is deprecated. Please use the describeBy function
## Warning in describeBy(x = x, group = group, mat = mat, type = type, ...): no
## grouping variable requested
## vars n mean sd median trimmed mad min max range skew
## State.ID 1 24 17.62 8.98 18.0 17.95 11.12 1 31 30 -0.22
## State* 2 24 12.50 7.07 12.5 12.50 8.90 1 24 23 0.00
## Region 3 24 2.33 1.09 2.0 2.30 1.48 1 4 3 0.12
## Industry.Group* 4 24 1.00 0.00 1.0 1.00 0.00 1 1 0 NaN
## Economic.Unit 5 24 13.17 30.76 5.0 6.00 5.19 1 151 150 3.76
## kurtosis se
## State.ID -1.18 1.83
## State* -1.35 1.44
## Region -1.39 0.22
## Industry.Group* NaN 0.00
## Economic.Unit 13.85 6.28
table(bd_limpia$State, bd_limpia$Economic.Unit)
##
## 1 2 3 5 6 8 11 13 17 20 43 151
## Aguascalientes 1 0 0 0 0 0 0 0 0 0 0 0
## Baja California 0 0 0 0 0 1 0 0 0 0 0 0
## Chihuahua 0 0 0 0 1 0 0 0 0 0 0 0
## Ciudad de Mexico 0 0 0 0 0 0 0 0 1 0 0 0
## Coahuila de Zaragoza 1 0 0 0 0 0 0 0 0 0 0 0
## Durango 0 1 0 0 0 0 0 0 0 0 0 0
## Estado de Mexico 0 0 0 0 0 0 0 0 0 0 1 0
## Guanajuato 0 0 0 0 0 0 1 0 0 0 0 0
## Hidalgo 0 0 1 0 0 0 0 0 0 0 0 0
## Jalisco 0 0 0 0 0 0 0 1 0 0 0 0
## Michoacan de Ocampo 0 0 1 0 0 0 0 0 0 0 0 0
## Morelos 1 0 0 0 0 0 0 0 0 0 0 0
## Nuevo Leon 0 0 0 0 0 0 0 0 0 1 0 0
## Oaxaca 1 0 0 0 0 0 0 0 0 0 0 0
## Puebla 0 0 0 0 0 0 0 0 0 0 0 1
## Queretaro 0 0 0 1 0 0 0 0 0 0 0 0
## San Luis Potosi 0 0 0 0 1 0 0 0 0 0 0 0
## Sinaloa 0 0 0 1 0 0 0 0 0 0 0 0
## Sonora 0 0 0 1 0 0 0 0 0 0 0 0
## Tabasco 1 0 0 0 0 0 0 0 0 0 0 0
## Tamaulipas 1 0 0 0 0 0 0 0 0 0 0 0
## Tlaxcala 0 0 1 0 0 0 0 0 0 0 0 0
## Veracruz de Ignacio de la Llave 0 0 0 0 1 0 0 0 0 0 0 0
## Yucatan 0 0 1 0 0 0 0 0 0 0 0 0
prop.table(table(bd_limpia$State, bd_limpia$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
table(bd_limpia$Region)
##
## 1 2 3 4
## 7 6 7 4
proporciones <- c(7, 6, 7, 4)
etiquetas <- c("Norte", "Centro/Oeste", "Centro", "Sur")
pct <- round(proporciones/sum(proporciones)*100)
etiquetas <- paste(etiquetas, pct)
etiquetas <- paste(etiquetas,"%",sep="")
pie(proporciones,labels = etiquetas,
col=rainbow(length(etiquetas)),
main="Porcentaje de estados en México por regiones")
En este gráfico se observa que las regiones que tienen más estados, son la región Centro y la región Norte con 7 estados cada una, seguido por la región Centro/Oeste que cuenta con 6 estados, y por último, la región Sur con 4 estados.
hist(x = bd_externa$Region, main = "# de Estados por región",
xlab = "Región", ylab = "# de estados",
col = "orange")
Gráfica que indica el número de estados por región.
table(bd_limpia$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 <- c(6, 1, 4, 3, 3, 1, 1, 1, 1, 1, 1, 1)
etiquetas <- c("1", "2", "3", "5", "6", "8", "11", "13", "17", "20", "43", "151")
pct <- round(proporciones/sum(proporciones)*100)
etiquetas <- paste(etiquetas, pct)
etiquetas <- paste(etiquetas,"%",sep="")
pie(proporciones,labels = etiquetas,
col=rainbow(length(etiquetas)),
main="Producción de unidades promedio por empleado")
Esta gráfica nos indica que el 25% de los empleados solo produce una unidad, que el 17% de los empleados produce 3 unidades, que el 12% de los empleados produce 5 y 6 unidades,y así sucesivamente.
ggplot(data = bd_limpia, mapping = aes(Region, Economic.Unit)) + geom_point() + theme_bw()
Gráfico de dispersión que indica las unidades producidas por empleado en las diferentes regiones.
boxplot(bd_limpia$State.ID ~ bd_limpia$Economic.Unit, horizontal = TRUE)
Gráfico de dispersión que indica las unidades producidas por empleado en los diferentes estados, graficados por el ID del estado.
Estadísticos descriptivos de cada variable para cada base de datos.
describe.by(colaboradores)
## Warning: describe.by is deprecated. Please use the describeBy function
## Warning in describeBy(x = x, group = group, mat = mat, type = type, ...): no
## grouping variable requested
## vars n mean sd median trimmed mad min max range
## edad 1 113 36.06 12.85 34.00 35.21 13.34 18.00 73.00 55.0
## genero* 2 113 1.46 0.50 1.00 1.45 0.00 1.00 2.00 1.0
## antiguedad 3 113 1.42 2.52 0.00 0.81 0.00 0.00 12.00 12.0
## puesto* 4 113 6.25 7.13 2.00 4.79 0.00 1.00 25.00 24.0
## salario_diario 5 113 179.10 24.28 180.68 177.05 0.00 144.45 337.05 192.6
## estado_civil* 6 113 2.37 1.17 3.00 2.34 1.48 1.00 4.00 3.0
## skew kurtosis se
## edad 0.55 -0.61 1.21
## genero* 0.16 -1.99 0.05
## antiguedad 2.37 5.51 0.24
## puesto* 1.48 0.63 0.67
## salario_diario 3.42 17.62 2.28
## estado_civil* -0.09 -1.59 0.11
A pesar de que en las gráficas nos muestran que la mayoría de los trabajadores tienen entre 20-30 años, podemos observar que el promedio de la edad de los colaboradores es de 36 años.
describe.by(bajas)
## Warning: describe.by is deprecated. Please use the describeBy function
## Warning in describeBy(x = x, group = group, mat = mat, type = type, ...): no
## grouping variable requested
## vars n mean sd median trimmed mad min max
## edad 1 236 31.08 9.58 29.00 30.10 10.38 19.00 61
## genero* 2 236 1.41 0.49 1.00 1.39 0.00 1.00 2
## motivo_de_baja* 3 236 2.82 1.04 2.00 2.74 0.00 1.00 5
## no_dias 4 236 73.84 214.44 19.00 28.91 17.79 0.00 1966
## puesto* 5 236 6.76 4.53 5.00 5.61 0.00 1.00 21
## salario_diario_imss 6 236 177.96 23.26 180.68 179.14 0.00 144.45 500
## estado_civil* 7 236 2.70 1.13 3.00 2.75 1.48 1.00 4
## range skew kurtosis se
## edad 42.00 0.80 -0.21 0.62
## genero* 1.00 0.36 -1.88 0.03
## motivo_de_baja* 4.00 0.52 -1.49 0.07
## no_dias 1966.00 5.97 40.15 13.96
## puesto* 20.00 2.20 3.60 0.30
## salario_diario_imss 355.55 11.05 152.94 1.51
## estado_civil* 3.00 -0.54 -1.14 0.07
Otro dato interesante, es que el salario promedio de colaboradores con baja es de 177.96 pesos MXN, no muy distinto al de los colaboradores. Esto tal vez nos pueda decir que el salario no es un factor significativo por el cual se den de baja los empleados.
describe.by(delivery_plan2)
## Warning: describe.by is deprecated. Please use the describeBy function
## Warning in describeBy(x = x, group = group, mat = mat, type = type, ...): no
## grouping variable requested
## vars n mean sd median trimmed mad min max range skew
## cliente* 1 590 15.36 6.08 18 16.10 1.48 1 23 22 -1.23
## Mes* 2 590 5.83 2.79 6 5.87 2.97 1 10 9 -0.11
## Unidades 3 590 358.37 1002.83 80 153.49 103.78 1 13120 13119 7.48
## kurtosis se
## cliente* 0.07 0.25
## Mes* -1.18 0.12
## Unidades 72.07 41.29
En promedio, se entregan 358 unidades por mes.
describe.by(performance)
## Warning: describe.by is deprecated. Please use the describeBy function
## Warning in FUN(newX[, i], ...): ningún argumento finito para min; retornando Inf
## Warning in FUN(newX[, i], ...): ningun argumento finito para max; retornando
## -Inf
## Warning in describeBy(x = x, group = group, mat = mat, type = type, ...): no
## grouping variable requested
## vars n mean sd median trimmed mad min max range skew kurtosis se
## fecha 1 324 NaN NA NA NaN NA Inf -Inf -Inf NA NA NA
## printel 2 324 0.34 0.66 0 0.19 0 0 4 4 2.15 4.85 0.04
## mahle 3 324 2.21 1.71 3 2.28 0 -9 20 29 2.43 40.19 0.09
## magna 4 324 0.00 0.00 0 0.00 0 0 0 0 NaN NaN 0.00
## varroc 5 324 0.00 0.00 0 0.00 0 0 0 0 NaN NaN 0.00
Esta tabla nos dice que quien tiene más retrasos por parte de FORM es el cliente MAHLE.
describe.by(produccion)
## Warning: describe.by is deprecated. Please use the describeBy function
## Warning in FUN(newX[, i], ...): ningún argumento finito para min; retornando Inf
## Warning in FUN(newX[, i], ...): ningun argumento finito para max; retornando
## -Inf
## Warning in describeBy(x = x, group = group, mat = mat, type = type, ...): no
## grouping variable requested
## vars n mean sd median trimmed mad min max range
## fecha 1 3988 NaN NA NA NaN NA Inf -Inf -Inf
## cliente* 2 3987 7.21 2.94 7 7.15 2.97 1 13 12
## piezas_prog 3 3988 102.01 134.37 51 76.99 75.61 0 1263 1263
## tmo_min 4 3988 21.88 11.97 20 19.91 7.41 0 150 150
## estacion_arranque* 5 3988 18.69 8.54 22 19.24 8.90 1 29 28
## laminas_procesadas 6 3988 102.01 134.37 51 76.99 75.61 0 1263 1263
## tiempo_calidad 7 3988 0.87 0.99 1 0.83 0.00 0 22 22
## skew kurtosis se
## fecha NA NA NA
## cliente* 0.24 -0.09 0.05
## piezas_prog 2.70 13.12 2.13
## tmo_min 2.75 13.49 0.19
## estacion_arranque* -0.38 -1.20 0.14
## laminas_procesadas 2.70 13.12 2.13
## tiempo_calidad 9.23 140.24 0.02
El promedio de las piezas programadas por día es de 102, mientras que el promedio de las laminas procesadas, es el mismo, 102.
describe.by(merma1)
## Warning: describe.by is deprecated. Please use the describeBy function
## Warning in describeBy(x = x, group = group, mat = mat, type = type, ...): no
## grouping variable requested
## vars n mean sd median trimmed mad min max range skew
## fecha* 1 50 21.42 12.18 19.5 21.45 14.83 1 42 41 0.04
## mes* 2 50 4.60 2.60 4.0 4.53 2.97 1 9 8 0.21
## kilos 3 50 3708.52 1023.99 3925.0 3798.65 541.15 790 6140 5350 -0.94
## kurtosis se
## fecha* -1.18 1.72
## mes* -1.35 0.37
## kilos 1.65 144.81
Mensualmente, hay aproximadamente 3708 kilos de merma en promedio.
describe.by(scrap1)
## Warning: describe.by is deprecated. Please use the describeBy function
## Warning in describeBy(x = x, group = group, mat = mat, type = type, ...): no
## grouping variable requested
## vars n mean sd median trimmed mad min max range
## fecha* 1 249 15.31 7.05 16 15.60 7.41 1 26 25
## cantidad 2 249 6.55 11.65 2 3.87 1.48 0 96 96
## ubicacion_de_origen* 3 249 2.48 0.85 3 2.60 0.00 1 3 2
## skew kurtosis se
## fecha* -0.30 -0.99 0.45
## cantidad 4.28 22.80 0.74
## ubicacion_de_origen* -1.09 -0.72 0.05
La cantidad promedio de scrap que hay por fecha es de 6.5 unidades.
ggplot(produccion, aes(x=tmo_min, y=laminas_procesadas)) +
geom_bar(stat="identity", fill="grey") + scale_fill_grey() +
labs(title = "Grafico de barras de las piezas programadas dentro del tiempo minimo",
x = "tiempo minimo", y = "laminas procesadas")
Este gráfico muestra las laminas que se han procesado en cierto tiempo,
a partir de las piezas programadas.
ggplot(produccion,aes(x=reorder(tmo_min, piezas_prog), y=piezas_prog,fill=cliente)) +
geom_bar(stat="identity")
En este gráfico podemos observar las piezas programadas, y el tiempo en minutos que se tardan en hacer, por clientes, por ejemplo, podemos ver que STABILUS 1 es un cliente que programa muchaspiezas ya que el color del cliente es el que está más presente en la gráfica.
ggplot(merma1, aes(x=mes, y=kilos)) +
geom_bar(stat="identity", fill="orange") + scale_fill_grey() + # Add bars to the plot
labs(title = "Relación de los kilos de merma en el mes", # Add a title
subtitle = "Merma empresa FORM", # Add a subtitle
caption = "Relación", # Add a caption
x = "mes")
En el mes de Agosto fue donde más merma se generó, ya que estaba por arriba de los 30,000 kilos, por otro lado, Enero fue el mes en el que menos se generó merma.
ggplot(colaboradores, aes(x=genero, y=salario_diario, fill=genero)) +
geom_bar(stat="identity") +
facet_grid(~estado_civil) + scale_fill_brewer(palette = "Set2")
Lo que podemos observar aquí, es que las mujeres solteras son las que ganan un poco más, seguido por los hombres casados. Sin embargo, los que menos ganan, o al menos en la suma de los salarios el resultado apunta a que los divorciados con menos, y los que menos ganan.
ggplot(data=scrap1, mapping = aes(ubicacion_de_origen, cantidad)) + geom_point() + theme_bw()
En esta gráfica se observa de otra forma, la cantidad de scrap que hay
en cada parte del proceso de la producción, como se mencionó
anteriormente, la mayoría se sitúa en la Pre-producción.
ggplot(delivery_plan2, aes(x = Mes, y = Unidades)) +
geom_point(shape=19, size=3) +
labs(title = "Relación entre Unidades y Meses",caption ="FORM Merma",x="Mes", y="Unidades") +
theme_classic()
Este gráfico nos muestra las unidades distriuidas por mes, y se observa
que tanto julio como marzo son buenos meses para la empresa, ya quw
tienen más pedidos.
ggplot(delivery_plan2,aes(x=Mes, y=Unidades,color=cliente))+
geom_line()+
labs(x="Mes",y="Unidades", color="Legend")+
ggtitle("Relación entre unidades y meses por cliente")
Esta es otra forma de ver la relación entre unidades y meses, pero por
cliente.
summary(prediccion_mx)
## Año Mes Venta Producción
## 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
## Exportación Tipo.de.cambio Inflación 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
str(prediccion_mx)
## 'data.frame': 202 obs. of 10 variables:
## $ Año : int 2006 2006 2006 2006 2006 2006 2006 2006 2006 2006 ...
## $ Mes : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Venta : int 96227 89079 96871 77879 86462 87084 83069 90937 92083 97469 ...
## $ Producción : int 155291 166830 192643 132212 171557 194327 118602 179527 164577 179897 ...
## $ Exportación : int 112165 121001 153877 115798 131578 156008 85752 136114 125918 132470 ...
## $ Tipo.de.cambio : num 10.6 10.5 10.7 11 11.1 ...
## $ Inflación : num 0.59 0.74 0.87 1.01 0.56 0.65 0.93 1.44 2.47 2.91 ...
## $ porcentaje_ocu : num 96.5 96.2 96.7 96.8 97.2 ...
## $ porcentaje_desocu: num 3.48 3.75 3.31 3.2 2.84 3.26 4.01 3.87 4 3.82 ...
## $ conf_consumidor : num 43.9 43.9 45.6 44.8 44.7 ...
prediccion_mx1 <- subset(prediccion_mx, select = -c (Producción))
prediccion_mx1
## Año Mes Venta Exportación Tipo.de.cambio Inflación porcentaje_ocu
## 1 2006 1 96227 112165 10.56964 0.59 96.52
## 2 2006 2 89079 121001 10.48426 0.74 96.25
## 3 2006 3 96871 153877 10.69772 0.87 96.69
## 4 2006 4 77879 115798 11.02994 1.01 96.80
## 5 2006 5 86462 131578 11.07152 0.56 97.16
## 6 2006 6 87084 156008 11.38702 0.65 96.74
## 7 2006 7 83069 85752 11.03922 0.93 95.99
## 8 2006 8 90937 136114 10.87617 1.44 96.13
## 9 2006 9 92083 125918 10.97558 2.47 96.00
## 10 2006 10 97469 132470 10.91245 2.91 96.18
## 11 2006 11 102201 152396 10.87905 3.45 96.50
## 12 2006 12 140375 113718 10.87084 4.05 96.68
## 13 2007 1 97675 88915 10.93192 0.52 95.95
## 14 2007 2 86060 111084 10.98198 0.80 95.95
## 15 2007 3 96487 138877 11.12237 1.02 96.27
## 16 2007 4 75020 110462 10.99081 0.96 96.49
## 17 2007 5 84756 140387 10.83582 0.46 96.85
## 18 2007 6 80462 153243 10.83519 0.58 96.72
## 19 2007 7 83105 129581 10.79959 1.01 96.21
## 20 2007 8 88573 168210 11.04243 1.42 96.17
## 21 2007 9 86547 156237 11.03762 2.21 96.24
## 22 2007 10 97182 144970 10.84063 2.61 96.23
## 23 2007 11 97694 149964 10.85821 3.33 96.65
## 24 2007 12 126329 121383 10.85206 3.76 96.89
## 25 2008 1 96846 118416 10.91741 0.46 95.88
## 26 2008 2 86997 140501 10.78461 0.76 96.11
## 27 2008 3 80119 129405 10.73085 1.49 96.39
## 28 2008 4 83106 144234 10.52556 1.72 96.52
## 29 2008 5 85827 150514 10.45804 1.61 96.71
## 30 2008 6 81424 153345 10.32862 2.03 96.63
## 31 2008 7 85324 122144 10.23761 2.60 95.87
## 32 2008 8 86119 143464 10.09196 3.20 95.94
## 33 2008 9 76620 144454 10.60434 3.90 95.86
## 34 2008 10 83307 167497 12.48947 4.61 95.83
## 35 2008 11 78555 138439 13.09469 5.80 95.68
## 36 2008 12 101300 109206 13.37363 6.53 95.98
## 37 2009 1 69664 51061 13.86394 0.23 94.99
## 38 2009 2 61579 77833 14.50219 0.45 94.76
## 39 2009 3 64242 101830 14.72083 1.03 95.34
## 40 2009 4 51395 85121 13.47903 1.38 94.94
## 41 2009 5 53440 83910 13.25065 1.09 94.77
## 42 2009 6 55974 84934 13.34374 1.28 95.02
## 43 2009 7 56443 90872 13.36679 1.55 94.18
## 44 2009 8 58926 111273 13.01394 1.79 93.85
## 45 2009 9 58505 117433 13.40757 2.30 93.58
## 46 2009 10 67882 145761 13.25259 2.61 94.33
## 47 2009 11 64914 134873 13.13145 3.15 94.89
## 48 2009 12 91961 138432 12.85556 3.57 95.27
## 49 2010 1 64064 114193 12.83263 1.09 94.24
## 50 2010 2 59518 153148 12.96185 1.67 94.72
## 51 2010 3 65414 163641 12.60465 2.39 95.26
## 52 2010 4 60432 133406 12.26208 2.07 94.65
## 53 2010 5 61632 145909 12.68247 1.42 95.00
## 54 2010 6 59910 177575 12.71818 1.39 95.08
## 55 2010 7 61960 143521 12.83341 1.61 94.41
## 56 2010 8 66931 175904 12.72952 1.89 94.58
## 57 2010 9 65934 169507 12.86421 2.43 94.34
## 58 2010 10 74095 166931 12.45569 3.06 94.52
## 59 2010 11 75582 168226 12.31381 3.89 94.83
## 60 2010 12 104941 147551 12.40058 4.40 95.06
## 61 2011 1 68767 165045 12.15321 0.49 94.66
## 62 2011 2 66990 155808 12.07712 0.86 94.66
## 63 2011 3 75125 192783 12.01917 1.06 95.36
## 64 2011 4 65246 141334 11.75536 1.05 94.87
## 65 2011 5 68634 176951 11.65234 0.30 94.82
## 66 2011 6 68366 188223 11.80157 0.30 94.60
## 67 2011 7 68533 196835 11.67069 0.78 94.52
## 68 2011 8 75681 170086 12.20000 0.94 94.29
## 69 2011 9 73998 193590 13.08912 1.19 94.57
## 70 2011 10 75748 192244 13.46868 1.87 95.01
## 71 2011 11 83107 199665 13.63712 2.97 95.04
## 72 2011 12 115698 171319 13.74813 3.82 95.49
## 73 2012 1 75297 156417 13.48802 0.71 95.12
## 74 2012 2 74704 197600 12.80356 0.91 94.72
## 75 2012 3 83574 226555 12.75781 0.97 95.48
## 76 2012 4 69890 180545 13.02576 0.65 95.14
## 77 2012 5 80268 184302 13.53816 0.34 95.33
## 78 2012 6 78508 229089 13.97611 0.80 95.25
## 79 2012 7 76378 208151 13.39195 1.36 95.01
## 80 2012 8 83326 188392 13.18333 1.67 94.67
## 81 2012 9 79961 193350 13.00449 2.12 95.09
## 82 2012 10 83172 216576 12.86915 2.63 94.97
## 83 2012 11 91966 219864 12.86915 3.33 94.95
## 84 2012 12 110998 154724 12.87298 3.57 95.60
## 85 2013 1 84403 178562 12.71282 0.40 94.59
## 86 2013 2 80285 175338 12.71638 0.90 95.25
## 87 2013 3 82860 204475 12.40242 1.64 95.52
## 88 2013 4 83647 185548 12.21560 1.70 95.04
## 89 2013 5 87638 191205 12.23945 1.37 95.09
## 90 2013 6 83858 225753 12.95020 1.30 95.00
## 91 2013 7 86760 192940 12.76920 1.27 94.87
## 92 2013 8 88586 226893 12.88348 1.56 94.82
## 93 2013 9 78555 215962 13.08974 1.94 94.69
## 94 2013 10 88416 240316 13.02170 2.43 94.99
## 95 2013 11 100571 224873 13.06409 3.38 95.52
## 96 2013 12 119519 161208 13.00105 3.97 95.73
## 97 2014 1 85614 177928 13.20104 0.89 94.93
## 98 2014 2 80037 197504 13.29067 1.15 95.34
## 99 2014 3 85767 230772 13.21485 1.43 95.20
## 100 2014 4 76941 202328 13.07712 1.24 95.15
## 101 2014 5 88388 234629 12.95623 0.91 95.06
## 102 2014 6 84207 230410 12.97570 1.09 95.18
## 103 2014 7 96366 231934 12.97300 1.37 94.53
## 104 2014 8 103994 226757 13.15002 1.73 94.81
## 105 2014 9 89313 220239 13.21131 2.18 94.91
## 106 2014 10 101090 257382 13.47454 2.74 95.22
## 107 2014 11 111837 237923 13.59030 3.57 95.47
## 108 2014 12 133411 195091 14.45304 4.08 96.24
## 109 2015 1 103805 204907 14.67395 -0.09 95.49
## 110 2015 2 97659 222351 14.90437 0.10 95.67
## 111 2015 3 105034 261256 15.20997 0.51 96.14
## 112 2015 4 94953 233515 15.22746 0.25 95.69
## 113 2015 5 102156 240709 15.25361 -0.25 95.55
## 114 2015 6 107097 242720 15.45056 -0.09 95.59
## 115 2015 7 111863 226511 15.87623 0.06 95.28
## 116 2015 8 112307 234668 16.50888 0.27 95.32
## 117 2015 9 111705 216587 16.83229 0.65 95.50
## 118 2015 10 120214 245224 16.59932 1.16 95.45
## 119 2015 11 126750 223797 16.63219 1.72 96.04
## 120 2015 12 160901 206651 17.01278 2.13 96.04
## 121 2016 1 119833 213244 17.94565 0.38 95.74
## 122 2016 2 111126 219670 18.45920 0.82 95.86
## 123 2016 3 117252 224184 17.67208 0.97 96.25
## 124 2016 4 118754 197020 17.48096 0.65 96.20
## 125 2016 5 121879 226240 18.05380 0.20 95.99
## 126 2016 6 134913 247005 18.62127 0.31 96.08
## 127 2016 7 132109 225530 18.58811 0.57 96.00
## 128 2016 8 134388 262673 18.46011 0.86 96.02
## 129 2016 9 131888 235612 19.11921 1.47 95.88
## 130 2016 10 137503 255115 18.97319 2.09 96.33
## 131 2016 11 154779 245330 19.96946 2.89 96.50
## 132 2016 12 192741 216645 20.54282 3.36 96.62
## 133 2017 1 123447 219061 21.39550 1.70 96.40
## 134 2017 2 118193 248288 20.35246 2.29 96.66
## 135 2017 3 137245 305403 19.41648 2.92 96.81
## 136 2017 4 114938 240141 18.78122 3.04 96.53
## 137 2017 5 123429 269067 18.79971 2.92 96.45
## 138 2017 6 127752 287979 18.20815 3.18 96.71
## 139 2017 7 122678 258557 17.85459 3.57 96.58
## 140 2017 8 125985 276108 17.80650 4.08 96.48
## 141 2017 9 116716 286400 17.80554 4.41 96.41
## 142 2017 10 123602 303514 18.71362 5.06 96.49
## 143 2017 11 141724 290569 18.98973 6.15 96.59
## 144 2017 12 159234 268772 19.10129 6.77 96.85
## 145 2018 1 109445 231088 19.02896 0.53 96.64
## 146 2018 2 109846 271228 18.61594 0.91 96.83
## 147 2018 3 119127 317398 18.65489 1.24 97.06
## 148 2018 4 109748 271048 18.34659 0.90 96.61
## 149 2018 5 115155 288659 19.45515 0.73 96.78
## 150 2018 6 120298 315130 20.31281 1.12 96.63
## 151 2018 7 115047 247367 19.09664 1.66 96.53
## 152 2018 8 119487 322779 18.80423 2.26 96.54
## 153 2018 9 114888 306009 19.03592 2.69 96.42
## 154 2018 10 117602 313471 19.09212 3.22 96.73
## 155 2018 11 134143 291018 20.25495 4.10 96.75
## 156 2018 12 142300 275962 20.15294 4.83 96.64
## 157 2019 1 111514 243652 19.22744 0.09 96.44
## 158 2019 2 104009 273173 19.18334 0.06 96.71
## 159 2019 3 117529 325703 19.24878 0.44 96.78
## 160 2019 4 98366 288756 19.01630 0.50 96.50
## 161 2019 5 102422 309017 19.09191 0.21 96.50
## 162 2019 6 106782 327454 19.26678 0.27 96.43
## 163 2019 7 106104 276818 19.06189 0.65 96.26
## 164 2019 8 108074 286075 19.58659 0.63 96.29
## 165 2019 9 100757 286806 19.60990 0.89 96.22
## 166 2019 10 107110 259158 19.36886 1.44 96.31
## 167 2019 11 124804 274845 19.30748 2.26 96.58
## 168 2019 12 130460 236848 19.16932 2.83 97.09
## 169 2020 1 104852 238749 18.81445 0.48 96.22
## 170 2020 2 104338 273634 18.77705 0.90 96.47
## 171 2020 3 87541 295199 21.97384 0.85 97.09
## 172 2020 4 34927 31183 24.23988 -0.17 95.31
## 173 2020 5 42034 15139 23.58032 0.22 95.81
## 174 2020 6 62861 198084 22.26918 0.76 94.51
## 175 2020 7 72921 264520 22.48030 1.43 94.65
## 176 2020 8 77120 264478 22.23107 1.82 94.74
## 177 2020 9 77808 257562 21.60516 2.06 94.87
## 178 2020 10 84351 280474 21.38085 2.68 95.29
## 179 2020 11 95707 287703 20.53330 2.76 95.65
## 180 2020 12 105603 275081 19.97817 3.15 96.21
## 181 2021 1 81657 223533 19.90262 0.86 95.30
## 182 2021 2 82863 213987 20.29248 1.50 95.60
## 183 2021 3 96319 256119 20.76205 2.34 96.13
## 184 2021 4 84287 234584 20.10944 2.67 95.35
## 185 2021 5 86710 242020 20.05320 2.88 96.01
## 186 2021 6 88688 234394 20.04272 3.43 95.98
## 187 2021 7 82157 202021 19.98552 4.04 95.62
## 188 2021 8 78235 212687 20.05125 4.24 95.67
## 189 2021 9 76930 195294 19.99092 4.88 95.82
## 190 2021 10 76640 224535 20.47244 5.76 96.05
## 191 2021 11 82829 240341 20.78256 6.97 96.34
## 192 2021 12 97420 227465 20.98530 7.36 96.49
## 193 2022 1 78585 216630 20.48354 0.59 96.29
## 194 2022 2 79598 201868 20.48437 1.43 96.26
## 195 2022 3 95199 262494 20.60089 2.43 97.03
## 196 2022 4 83459 241286 20.04452 2.98 96.97
## 197 2022 5 91215 244643 20.11331 3.17 96.73
## 198 2022 6 90368 237674 19.96650 4.04 96.65
## 199 2022 7 83137 210170 20.53081 4.81 96.57
## 200 2022 8 91124 248704 20.12613 5.54 96.47
## 201 NA NA NA NA NA NA NA
## 202 NA NA NA NA NA NA NA
## porcentaje_desocu conf_consumidor
## 1 3.48 43.9415
## 2 3.75 43.9100
## 3 3.31 45.6029
## 4 3.20 44.7854
## 5 2.84 44.6508
## 6 3.26 44.2339
## 7 4.01 44.8674
## 8 3.87 45.0383
## 9 4.00 45.0604
## 10 3.82 44.3016
## 11 3.50 43.1883
## 12 3.32 44.7871
## 13 4.05 42.7412
## 14 4.05 42.3778
## 15 3.73 43.5677
## 16 3.51 43.4415
## 17 3.15 43.7534
## 18 3.28 43.0694
## 19 3.79 42.9629
## 20 3.83 43.9863
## 21 3.76 43.0238
## 22 3.77 41.2666
## 23 3.35 40.8568
## 24 3.11 42.8202
## 25 4.12 42.1822
## 26 3.89 41.2208
## 27 3.61 41.8964
## 28 3.48 40.1531
## 29 3.29 38.9120
## 30 3.37 37.6903
## 31 4.13 36.7035
## 32 4.06 37.2616
## 33 4.14 36.6558
## 34 4.17 34.2078
## 35 4.32 34.9500
## 36 4.02 34.9987
## 37 5.01 34.4084
## 38 5.24 33.4023
## 39 4.66 33.4728
## 40 5.06 34.6003
## 41 5.23 33.1933
## 42 4.98 34.2256
## 43 5.82 36.0502
## 44 6.15 34.5306
## 45 6.42 34.4993
## 46 5.67 32.6096
## 47 5.11 33.1707
## 48 4.73 33.9865
## 49 5.76 34.8020
## 50 5.28 34.2586
## 51 4.74 34.6691
## 52 5.35 35.0361
## 53 5.00 35.5938
## 54 4.92 36.7799
## 55 5.59 36.9279
## 56 5.42 37.2006
## 57 5.66 38.3303
## 58 5.48 37.4086
## 59 5.17 37.1774
## 60 4.94 38.1767
## 61 5.34 38.4624
## 62 5.34 38.4413
## 63 4.64 38.3233
## 64 5.13 37.6265
## 65 5.18 37.3597
## 66 5.40 38.7674
## 67 5.48 39.7537
## 68 5.71 38.9023
## 69 5.43 38.4823
## 70 4.99 37.7094
## 71 4.96 37.4238
## 72 4.51 37.7149
## 73 4.88 39.3604
## 74 5.28 38.9804
## 75 4.52 38.8750
## 76 4.86 40.2245
## 77 4.67 39.7323
## 78 4.75 39.7133
## 79 4.99 41.1478
## 80 5.33 40.7832
## 81 4.91 39.3550
## 82 5.03 39.6293
## 83 5.05 39.1214
## 84 4.40 41.1395
## 85 5.41 41.6134
## 86 4.75 39.6882
## 87 4.48 39.9339
## 88 4.96 39.8361
## 89 4.91 39.4471
## 90 5.00 38.7706
## 91 5.13 40.6562
## 92 5.18 40.5308
## 93 5.31 39.1825
## 94 5.01 38.0775
## 95 4.48 36.9465
## 96 4.27 37.3707
## 97 5.07 35.5508
## 98 4.66 35.7346
## 99 4.80 37.1351
## 100 4.85 37.6101
## 101 4.94 37.7513
## 102 4.82 37.9049
## 103 5.47 37.5518
## 104 5.19 37.4502
## 105 5.09 38.2199
## 106 4.78 37.6935
## 107 4.53 38.4760
## 108 3.76 38.6914
## 109 4.51 38.0625
## 110 4.33 37.4911
## 111 3.86 38.5052
## 112 4.31 37.8429
## 113 4.45 38.0317
## 114 4.41 39.1119
## 115 4.72 38.1319
## 116 4.68 37.3836
## 117 4.50 37.4490
## 118 4.55 37.8131
## 119 3.96 38.1829
## 120 3.96 38.3685
## 121 4.26 38.1815
## 122 4.14 36.7321
## 123 3.75 36.8144
## 124 3.80 36.7139
## 125 4.01 37.4848
## 126 3.92 38.3491
## 127 4.00 36.5060
## 128 3.98 35.6554
## 129 4.12 34.7550
## 130 3.67 35.0319
## 131 3.50 34.8752
## 132 3.38 35.4784
## 133 3.60 28.6679
## 134 3.34 31.5156
## 135 3.19 33.7951
## 136 3.47 34.9345
## 137 3.55 35.8733
## 138 3.29 36.0104
## 139 3.42 36.4886
## 140 3.52 36.5055
## 141 3.59 36.7879
## 142 3.51 36.4370
## 143 3.41 36.7168
## 144 3.15 36.3155
## 145 3.36 34.8018
## 146 3.17 34.1893
## 147 2.94 34.3367
## 148 3.39 35.6116
## 149 3.22 36.6479
## 150 3.37 37.1483
## 151 3.47 43.3411
## 152 3.46 43.0057
## 153 3.58 42.1327
## 154 3.27 42.5330
## 155 3.25 41.6750
## 156 3.36 44.8654
## 157 3.56 45.9299
## 158 3.29 47.8261
## 159 3.22 46.3411
## 160 3.50 45.4850
## 161 3.50 44.3235
## 162 3.57 43.6658
## 163 3.74 43.3177
## 164 3.71 43.8192
## 165 3.78 45.2995
## 166 3.69 44.0597
## 167 3.42 43.8407
## 168 2.91 43.7574
## 169 3.78 44.1205
## 170 3.53 43.3299
## 171 2.91 42.0593
## 172 4.69 32.2235
## 173 4.19 31.0682
## 174 5.49 31.9572
## 175 5.35 34.4173
## 176 5.26 35.0648
## 177 5.13 36.2820
## 178 4.71 37.8912
## 179 4.35 37.0767
## 180 3.79 38.7487
## 181 4.70 39.2114
## 182 4.40 38.6401
## 183 3.87 40.5816
## 184 4.65 42.5091
## 185 3.99 42.4227
## 186 4.02 44.3477
## 187 4.38 44.2934
## 188 4.33 42.4746
## 189 4.18 43.3421
## 190 3.95 43.8431
## 191 3.66 45.9354
## 192 3.51 44.8964
## 193 3.71 43.5909
## 194 3.74 42.9401
## 195 2.97 43.5603
## 196 3.03 44.3017
## 197 3.27 43.7823
## 198 3.35 43.2086
## 199 3.43 41.2699
## 200 3.53 40.2979
## 201 NA NA
## 202 NA NA
Esta columna se eliminará porque solo se usarán como variables dependientes Ventas y Exportación, y como variables independientes la confianza del consumidor, el tipo de cambio, la inflación, el porcentaje de personas ocupadas, y el porcentaje de personas desocupadas, es decir, sin trabajo.
prediccion_mx2 <- prediccion_mx1[-c(201, 202),]
prediccion_mx2
## Año Mes Venta Exportación Tipo.de.cambio Inflación porcentaje_ocu
## 1 2006 1 96227 112165 10.56964 0.59 96.52
## 2 2006 2 89079 121001 10.48426 0.74 96.25
## 3 2006 3 96871 153877 10.69772 0.87 96.69
## 4 2006 4 77879 115798 11.02994 1.01 96.80
## 5 2006 5 86462 131578 11.07152 0.56 97.16
## 6 2006 6 87084 156008 11.38702 0.65 96.74
## 7 2006 7 83069 85752 11.03922 0.93 95.99
## 8 2006 8 90937 136114 10.87617 1.44 96.13
## 9 2006 9 92083 125918 10.97558 2.47 96.00
## 10 2006 10 97469 132470 10.91245 2.91 96.18
## 11 2006 11 102201 152396 10.87905 3.45 96.50
## 12 2006 12 140375 113718 10.87084 4.05 96.68
## 13 2007 1 97675 88915 10.93192 0.52 95.95
## 14 2007 2 86060 111084 10.98198 0.80 95.95
## 15 2007 3 96487 138877 11.12237 1.02 96.27
## 16 2007 4 75020 110462 10.99081 0.96 96.49
## 17 2007 5 84756 140387 10.83582 0.46 96.85
## 18 2007 6 80462 153243 10.83519 0.58 96.72
## 19 2007 7 83105 129581 10.79959 1.01 96.21
## 20 2007 8 88573 168210 11.04243 1.42 96.17
## 21 2007 9 86547 156237 11.03762 2.21 96.24
## 22 2007 10 97182 144970 10.84063 2.61 96.23
## 23 2007 11 97694 149964 10.85821 3.33 96.65
## 24 2007 12 126329 121383 10.85206 3.76 96.89
## 25 2008 1 96846 118416 10.91741 0.46 95.88
## 26 2008 2 86997 140501 10.78461 0.76 96.11
## 27 2008 3 80119 129405 10.73085 1.49 96.39
## 28 2008 4 83106 144234 10.52556 1.72 96.52
## 29 2008 5 85827 150514 10.45804 1.61 96.71
## 30 2008 6 81424 153345 10.32862 2.03 96.63
## 31 2008 7 85324 122144 10.23761 2.60 95.87
## 32 2008 8 86119 143464 10.09196 3.20 95.94
## 33 2008 9 76620 144454 10.60434 3.90 95.86
## 34 2008 10 83307 167497 12.48947 4.61 95.83
## 35 2008 11 78555 138439 13.09469 5.80 95.68
## 36 2008 12 101300 109206 13.37363 6.53 95.98
## 37 2009 1 69664 51061 13.86394 0.23 94.99
## 38 2009 2 61579 77833 14.50219 0.45 94.76
## 39 2009 3 64242 101830 14.72083 1.03 95.34
## 40 2009 4 51395 85121 13.47903 1.38 94.94
## 41 2009 5 53440 83910 13.25065 1.09 94.77
## 42 2009 6 55974 84934 13.34374 1.28 95.02
## 43 2009 7 56443 90872 13.36679 1.55 94.18
## 44 2009 8 58926 111273 13.01394 1.79 93.85
## 45 2009 9 58505 117433 13.40757 2.30 93.58
## 46 2009 10 67882 145761 13.25259 2.61 94.33
## 47 2009 11 64914 134873 13.13145 3.15 94.89
## 48 2009 12 91961 138432 12.85556 3.57 95.27
## 49 2010 1 64064 114193 12.83263 1.09 94.24
## 50 2010 2 59518 153148 12.96185 1.67 94.72
## 51 2010 3 65414 163641 12.60465 2.39 95.26
## 52 2010 4 60432 133406 12.26208 2.07 94.65
## 53 2010 5 61632 145909 12.68247 1.42 95.00
## 54 2010 6 59910 177575 12.71818 1.39 95.08
## 55 2010 7 61960 143521 12.83341 1.61 94.41
## 56 2010 8 66931 175904 12.72952 1.89 94.58
## 57 2010 9 65934 169507 12.86421 2.43 94.34
## 58 2010 10 74095 166931 12.45569 3.06 94.52
## 59 2010 11 75582 168226 12.31381 3.89 94.83
## 60 2010 12 104941 147551 12.40058 4.40 95.06
## 61 2011 1 68767 165045 12.15321 0.49 94.66
## 62 2011 2 66990 155808 12.07712 0.86 94.66
## 63 2011 3 75125 192783 12.01917 1.06 95.36
## 64 2011 4 65246 141334 11.75536 1.05 94.87
## 65 2011 5 68634 176951 11.65234 0.30 94.82
## 66 2011 6 68366 188223 11.80157 0.30 94.60
## 67 2011 7 68533 196835 11.67069 0.78 94.52
## 68 2011 8 75681 170086 12.20000 0.94 94.29
## 69 2011 9 73998 193590 13.08912 1.19 94.57
## 70 2011 10 75748 192244 13.46868 1.87 95.01
## 71 2011 11 83107 199665 13.63712 2.97 95.04
## 72 2011 12 115698 171319 13.74813 3.82 95.49
## 73 2012 1 75297 156417 13.48802 0.71 95.12
## 74 2012 2 74704 197600 12.80356 0.91 94.72
## 75 2012 3 83574 226555 12.75781 0.97 95.48
## 76 2012 4 69890 180545 13.02576 0.65 95.14
## 77 2012 5 80268 184302 13.53816 0.34 95.33
## 78 2012 6 78508 229089 13.97611 0.80 95.25
## 79 2012 7 76378 208151 13.39195 1.36 95.01
## 80 2012 8 83326 188392 13.18333 1.67 94.67
## 81 2012 9 79961 193350 13.00449 2.12 95.09
## 82 2012 10 83172 216576 12.86915 2.63 94.97
## 83 2012 11 91966 219864 12.86915 3.33 94.95
## 84 2012 12 110998 154724 12.87298 3.57 95.60
## 85 2013 1 84403 178562 12.71282 0.40 94.59
## 86 2013 2 80285 175338 12.71638 0.90 95.25
## 87 2013 3 82860 204475 12.40242 1.64 95.52
## 88 2013 4 83647 185548 12.21560 1.70 95.04
## 89 2013 5 87638 191205 12.23945 1.37 95.09
## 90 2013 6 83858 225753 12.95020 1.30 95.00
## 91 2013 7 86760 192940 12.76920 1.27 94.87
## 92 2013 8 88586 226893 12.88348 1.56 94.82
## 93 2013 9 78555 215962 13.08974 1.94 94.69
## 94 2013 10 88416 240316 13.02170 2.43 94.99
## 95 2013 11 100571 224873 13.06409 3.38 95.52
## 96 2013 12 119519 161208 13.00105 3.97 95.73
## 97 2014 1 85614 177928 13.20104 0.89 94.93
## 98 2014 2 80037 197504 13.29067 1.15 95.34
## 99 2014 3 85767 230772 13.21485 1.43 95.20
## 100 2014 4 76941 202328 13.07712 1.24 95.15
## 101 2014 5 88388 234629 12.95623 0.91 95.06
## 102 2014 6 84207 230410 12.97570 1.09 95.18
## 103 2014 7 96366 231934 12.97300 1.37 94.53
## 104 2014 8 103994 226757 13.15002 1.73 94.81
## 105 2014 9 89313 220239 13.21131 2.18 94.91
## 106 2014 10 101090 257382 13.47454 2.74 95.22
## 107 2014 11 111837 237923 13.59030 3.57 95.47
## 108 2014 12 133411 195091 14.45304 4.08 96.24
## 109 2015 1 103805 204907 14.67395 -0.09 95.49
## 110 2015 2 97659 222351 14.90437 0.10 95.67
## 111 2015 3 105034 261256 15.20997 0.51 96.14
## 112 2015 4 94953 233515 15.22746 0.25 95.69
## 113 2015 5 102156 240709 15.25361 -0.25 95.55
## 114 2015 6 107097 242720 15.45056 -0.09 95.59
## 115 2015 7 111863 226511 15.87623 0.06 95.28
## 116 2015 8 112307 234668 16.50888 0.27 95.32
## 117 2015 9 111705 216587 16.83229 0.65 95.50
## 118 2015 10 120214 245224 16.59932 1.16 95.45
## 119 2015 11 126750 223797 16.63219 1.72 96.04
## 120 2015 12 160901 206651 17.01278 2.13 96.04
## 121 2016 1 119833 213244 17.94565 0.38 95.74
## 122 2016 2 111126 219670 18.45920 0.82 95.86
## 123 2016 3 117252 224184 17.67208 0.97 96.25
## 124 2016 4 118754 197020 17.48096 0.65 96.20
## 125 2016 5 121879 226240 18.05380 0.20 95.99
## 126 2016 6 134913 247005 18.62127 0.31 96.08
## 127 2016 7 132109 225530 18.58811 0.57 96.00
## 128 2016 8 134388 262673 18.46011 0.86 96.02
## 129 2016 9 131888 235612 19.11921 1.47 95.88
## 130 2016 10 137503 255115 18.97319 2.09 96.33
## 131 2016 11 154779 245330 19.96946 2.89 96.50
## 132 2016 12 192741 216645 20.54282 3.36 96.62
## 133 2017 1 123447 219061 21.39550 1.70 96.40
## 134 2017 2 118193 248288 20.35246 2.29 96.66
## 135 2017 3 137245 305403 19.41648 2.92 96.81
## 136 2017 4 114938 240141 18.78122 3.04 96.53
## 137 2017 5 123429 269067 18.79971 2.92 96.45
## 138 2017 6 127752 287979 18.20815 3.18 96.71
## 139 2017 7 122678 258557 17.85459 3.57 96.58
## 140 2017 8 125985 276108 17.80650 4.08 96.48
## 141 2017 9 116716 286400 17.80554 4.41 96.41
## 142 2017 10 123602 303514 18.71362 5.06 96.49
## 143 2017 11 141724 290569 18.98973 6.15 96.59
## 144 2017 12 159234 268772 19.10129 6.77 96.85
## 145 2018 1 109445 231088 19.02896 0.53 96.64
## 146 2018 2 109846 271228 18.61594 0.91 96.83
## 147 2018 3 119127 317398 18.65489 1.24 97.06
## 148 2018 4 109748 271048 18.34659 0.90 96.61
## 149 2018 5 115155 288659 19.45515 0.73 96.78
## 150 2018 6 120298 315130 20.31281 1.12 96.63
## 151 2018 7 115047 247367 19.09664 1.66 96.53
## 152 2018 8 119487 322779 18.80423 2.26 96.54
## 153 2018 9 114888 306009 19.03592 2.69 96.42
## 154 2018 10 117602 313471 19.09212 3.22 96.73
## 155 2018 11 134143 291018 20.25495 4.10 96.75
## 156 2018 12 142300 275962 20.15294 4.83 96.64
## 157 2019 1 111514 243652 19.22744 0.09 96.44
## 158 2019 2 104009 273173 19.18334 0.06 96.71
## 159 2019 3 117529 325703 19.24878 0.44 96.78
## 160 2019 4 98366 288756 19.01630 0.50 96.50
## 161 2019 5 102422 309017 19.09191 0.21 96.50
## 162 2019 6 106782 327454 19.26678 0.27 96.43
## 163 2019 7 106104 276818 19.06189 0.65 96.26
## 164 2019 8 108074 286075 19.58659 0.63 96.29
## 165 2019 9 100757 286806 19.60990 0.89 96.22
## 166 2019 10 107110 259158 19.36886 1.44 96.31
## 167 2019 11 124804 274845 19.30748 2.26 96.58
## 168 2019 12 130460 236848 19.16932 2.83 97.09
## 169 2020 1 104852 238749 18.81445 0.48 96.22
## 170 2020 2 104338 273634 18.77705 0.90 96.47
## 171 2020 3 87541 295199 21.97384 0.85 97.09
## 172 2020 4 34927 31183 24.23988 -0.17 95.31
## 173 2020 5 42034 15139 23.58032 0.22 95.81
## 174 2020 6 62861 198084 22.26918 0.76 94.51
## 175 2020 7 72921 264520 22.48030 1.43 94.65
## 176 2020 8 77120 264478 22.23107 1.82 94.74
## 177 2020 9 77808 257562 21.60516 2.06 94.87
## 178 2020 10 84351 280474 21.38085 2.68 95.29
## 179 2020 11 95707 287703 20.53330 2.76 95.65
## 180 2020 12 105603 275081 19.97817 3.15 96.21
## 181 2021 1 81657 223533 19.90262 0.86 95.30
## 182 2021 2 82863 213987 20.29248 1.50 95.60
## 183 2021 3 96319 256119 20.76205 2.34 96.13
## 184 2021 4 84287 234584 20.10944 2.67 95.35
## 185 2021 5 86710 242020 20.05320 2.88 96.01
## 186 2021 6 88688 234394 20.04272 3.43 95.98
## 187 2021 7 82157 202021 19.98552 4.04 95.62
## 188 2021 8 78235 212687 20.05125 4.24 95.67
## 189 2021 9 76930 195294 19.99092 4.88 95.82
## 190 2021 10 76640 224535 20.47244 5.76 96.05
## 191 2021 11 82829 240341 20.78256 6.97 96.34
## 192 2021 12 97420 227465 20.98530 7.36 96.49
## 193 2022 1 78585 216630 20.48354 0.59 96.29
## 194 2022 2 79598 201868 20.48437 1.43 96.26
## 195 2022 3 95199 262494 20.60089 2.43 97.03
## 196 2022 4 83459 241286 20.04452 2.98 96.97
## 197 2022 5 91215 244643 20.11331 3.17 96.73
## 198 2022 6 90368 237674 19.96650 4.04 96.65
## 199 2022 7 83137 210170 20.53081 4.81 96.57
## 200 2022 8 91124 248704 20.12613 5.54 96.47
## porcentaje_desocu conf_consumidor
## 1 3.48 43.9415
## 2 3.75 43.9100
## 3 3.31 45.6029
## 4 3.20 44.7854
## 5 2.84 44.6508
## 6 3.26 44.2339
## 7 4.01 44.8674
## 8 3.87 45.0383
## 9 4.00 45.0604
## 10 3.82 44.3016
## 11 3.50 43.1883
## 12 3.32 44.7871
## 13 4.05 42.7412
## 14 4.05 42.3778
## 15 3.73 43.5677
## 16 3.51 43.4415
## 17 3.15 43.7534
## 18 3.28 43.0694
## 19 3.79 42.9629
## 20 3.83 43.9863
## 21 3.76 43.0238
## 22 3.77 41.2666
## 23 3.35 40.8568
## 24 3.11 42.8202
## 25 4.12 42.1822
## 26 3.89 41.2208
## 27 3.61 41.8964
## 28 3.48 40.1531
## 29 3.29 38.9120
## 30 3.37 37.6903
## 31 4.13 36.7035
## 32 4.06 37.2616
## 33 4.14 36.6558
## 34 4.17 34.2078
## 35 4.32 34.9500
## 36 4.02 34.9987
## 37 5.01 34.4084
## 38 5.24 33.4023
## 39 4.66 33.4728
## 40 5.06 34.6003
## 41 5.23 33.1933
## 42 4.98 34.2256
## 43 5.82 36.0502
## 44 6.15 34.5306
## 45 6.42 34.4993
## 46 5.67 32.6096
## 47 5.11 33.1707
## 48 4.73 33.9865
## 49 5.76 34.8020
## 50 5.28 34.2586
## 51 4.74 34.6691
## 52 5.35 35.0361
## 53 5.00 35.5938
## 54 4.92 36.7799
## 55 5.59 36.9279
## 56 5.42 37.2006
## 57 5.66 38.3303
## 58 5.48 37.4086
## 59 5.17 37.1774
## 60 4.94 38.1767
## 61 5.34 38.4624
## 62 5.34 38.4413
## 63 4.64 38.3233
## 64 5.13 37.6265
## 65 5.18 37.3597
## 66 5.40 38.7674
## 67 5.48 39.7537
## 68 5.71 38.9023
## 69 5.43 38.4823
## 70 4.99 37.7094
## 71 4.96 37.4238
## 72 4.51 37.7149
## 73 4.88 39.3604
## 74 5.28 38.9804
## 75 4.52 38.8750
## 76 4.86 40.2245
## 77 4.67 39.7323
## 78 4.75 39.7133
## 79 4.99 41.1478
## 80 5.33 40.7832
## 81 4.91 39.3550
## 82 5.03 39.6293
## 83 5.05 39.1214
## 84 4.40 41.1395
## 85 5.41 41.6134
## 86 4.75 39.6882
## 87 4.48 39.9339
## 88 4.96 39.8361
## 89 4.91 39.4471
## 90 5.00 38.7706
## 91 5.13 40.6562
## 92 5.18 40.5308
## 93 5.31 39.1825
## 94 5.01 38.0775
## 95 4.48 36.9465
## 96 4.27 37.3707
## 97 5.07 35.5508
## 98 4.66 35.7346
## 99 4.80 37.1351
## 100 4.85 37.6101
## 101 4.94 37.7513
## 102 4.82 37.9049
## 103 5.47 37.5518
## 104 5.19 37.4502
## 105 5.09 38.2199
## 106 4.78 37.6935
## 107 4.53 38.4760
## 108 3.76 38.6914
## 109 4.51 38.0625
## 110 4.33 37.4911
## 111 3.86 38.5052
## 112 4.31 37.8429
## 113 4.45 38.0317
## 114 4.41 39.1119
## 115 4.72 38.1319
## 116 4.68 37.3836
## 117 4.50 37.4490
## 118 4.55 37.8131
## 119 3.96 38.1829
## 120 3.96 38.3685
## 121 4.26 38.1815
## 122 4.14 36.7321
## 123 3.75 36.8144
## 124 3.80 36.7139
## 125 4.01 37.4848
## 126 3.92 38.3491
## 127 4.00 36.5060
## 128 3.98 35.6554
## 129 4.12 34.7550
## 130 3.67 35.0319
## 131 3.50 34.8752
## 132 3.38 35.4784
## 133 3.60 28.6679
## 134 3.34 31.5156
## 135 3.19 33.7951
## 136 3.47 34.9345
## 137 3.55 35.8733
## 138 3.29 36.0104
## 139 3.42 36.4886
## 140 3.52 36.5055
## 141 3.59 36.7879
## 142 3.51 36.4370
## 143 3.41 36.7168
## 144 3.15 36.3155
## 145 3.36 34.8018
## 146 3.17 34.1893
## 147 2.94 34.3367
## 148 3.39 35.6116
## 149 3.22 36.6479
## 150 3.37 37.1483
## 151 3.47 43.3411
## 152 3.46 43.0057
## 153 3.58 42.1327
## 154 3.27 42.5330
## 155 3.25 41.6750
## 156 3.36 44.8654
## 157 3.56 45.9299
## 158 3.29 47.8261
## 159 3.22 46.3411
## 160 3.50 45.4850
## 161 3.50 44.3235
## 162 3.57 43.6658
## 163 3.74 43.3177
## 164 3.71 43.8192
## 165 3.78 45.2995
## 166 3.69 44.0597
## 167 3.42 43.8407
## 168 2.91 43.7574
## 169 3.78 44.1205
## 170 3.53 43.3299
## 171 2.91 42.0593
## 172 4.69 32.2235
## 173 4.19 31.0682
## 174 5.49 31.9572
## 175 5.35 34.4173
## 176 5.26 35.0648
## 177 5.13 36.2820
## 178 4.71 37.8912
## 179 4.35 37.0767
## 180 3.79 38.7487
## 181 4.70 39.2114
## 182 4.40 38.6401
## 183 3.87 40.5816
## 184 4.65 42.5091
## 185 3.99 42.4227
## 186 4.02 44.3477
## 187 4.38 44.2934
## 188 4.33 42.4746
## 189 4.18 43.3421
## 190 3.95 43.8431
## 191 3.66 45.9354
## 192 3.51 44.8964
## 193 3.71 43.5909
## 194 3.74 42.9401
## 195 2.97 43.5603
## 196 3.03 44.3017
## 197 3.27 43.7823
## 198 3.35 43.2086
## 199 3.43 41.2699
## 200 3.53 40.2979
Dentro de la base de datos había dos renglones sin contenido, por lo tanto, se decicdió eliminarlo.
Para ambos modelos de regresión, se usa una base de datos que contiene 2 variables dependientes, y 5 variables exploratorias, sin contar año y mes.
variable<-c("Ventas", "Exportación", "Tipo de cambio", "Inflación", "porcentaje_ocu", "porcentaje_desocu", "conf_consumidor")
tipo_variable <- c("Dependiente", "Dependiente", "Exploratoria", "Exploratoria", "Exploratoria", "Exploratoria", "Exploratoria")
unidad_medicion <- c("Unidades", "Unidades", "Pesos Mexicanos", "Índice de Precios al Consumo", "% total de empleados", "% total de desempleados", "Perspectiva económica del consumidor")
tabla_variables<-data.frame(variable,tipo_variable,unidad_medicion)
knitr::kable(tabla_variables)
| variable | tipo_variable | unidad_medicion |
|---|---|---|
| Ventas | Dependiente | Unidades |
| 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_mx2), type="upper",order="hclust",addcoef.col="black")
## Warning in text.default(pos.xlabel[, 1], pos.xlabel[, 2], newcolnames, srt =
## tl.srt, : "addcoef.col" is not a graphical parameter
## Warning in text.default(pos.ylabel[, 1], pos.ylabel[, 2], newrownames, col =
## tl.col, : "addcoef.col" is not a graphical parameter
## Warning in title(title, ...): "addcoef.col" is not a graphical parameter
summary(prediccion_mx2)
## Año Mes Venta Exportación
## Min. :2006 Min. : 1.00 Min. : 34927 Min. : 15139
## 1st Qu.:2010 1st Qu.: 3.00 1st Qu.: 78543 1st Qu.:153219
## Median :2014 Median : 6.00 Median : 88580 Median :209161
## Mean :2014 Mean : 6.42 Mean : 94178 Mean :201664
## 3rd Qu.:2018 3rd Qu.: 9.00 3rd Qu.:110134 3rd Qu.:243900
## Max. :2022 Max. :12.00 Max. :192741 Max. :327454
## Tipo.de.cambio Inflación porcentaje_ocu porcentaje_desocu
## Min. :10.09 Min. :-0.250 Min. :93.58 Min. :2.840
## 1st Qu.:12.66 1st Qu.: 0.815 1st Qu.:95.06 1st Qu.:3.527
## Median :13.56 Median : 1.480 Median :95.88 Median :4.125
## Mean :15.48 Mean : 1.951 Mean :95.76 Mean :4.244
## 3rd Qu.:19.10 3rd Qu.: 2.895 3rd Qu.:96.47 3rd Qu.:4.940
## Max. :24.24 Max. : 7.360 Max. :97.16 Max. :6.420
## conf_consumidor
## Min. :28.67
## 1st Qu.:36.69
## Median :38.47
## Mean :39.15
## 3rd Qu.:42.59
## Max. :47.83
Primeramente, se realizo un plot de correlación, con el fin de observar si las variables podrían tener relación entre las mismas variables y las demás, y lo que se puede notar, es que todos tienen el 100% de relación, y también se puede analizar que año y tipo de cambio también es relevante, así como, mes e inflación, venta y porcentaje de personas ocupadas, la exportación y el año, seguido por el tipo de cambio y de la expotación, entre otros.
modelo_regresion1 <- lm(Exportación~Tipo.de.cambio+Inflación+porcentaje_ocu+porcentaje_desocu+conf_consumidor,data=prediccion_mx2)
summary(modelo_regresion1)
##
## Call:
## lm(formula = Exportación ~ Tipo.de.cambio + Inflación + porcentaje_ocu +
## porcentaje_desocu + conf_consumidor, data = prediccion_mx2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -252440 -22951 4494 31209 84657
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -693919.2 473470.2 -1.466 0.1444
## Tipo.de.cambio 10277.3 980.5 10.482 <2e-16 ***
## Inflación 312.6 2231.8 0.140 0.8887
## porcentaje_ocu 6816.5 5197.2 1.312 0.1912
## porcentaje_desocu NA NA NA NA
## conf_consumidor 2124.4 1026.6 2.069 0.0398 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 47200 on 195 degrees of freedom
## Multiple R-squared: 0.4431, Adjusted R-squared: 0.4316
## F-statistic: 38.78 on 4 and 195 DF, p-value: < 2.2e-16
En este modelo, primero se realizó sin la variable año y mes, y se pudo observar que el tipo de cambio era la variable que más impactaba a la exportación, lo cual tiene sentido sabiendo que el tipo de cambio afecta a México y de igual manera al mundo, al devaluarse la moneda mexicana, es por eso que México es un gran exportador. Por otro lado, al agregarle la variable año y mes, la mayoría de las variables, con excepción de porcentaje de personas desocupadas tenían los 3 asteriscos, por lo tanto se consideran variables impactantes.
effect_plot(modelo_regresion1,pred=Tipo.de.cambio,interval=TRUE)
## Warning in predict.lm(model, newdata = pm, se.fit = interval, interval =
## int.type[1], : prediction from a rank-deficient fit may be misleading
Como se puede observar en la gráfica, la tendencia que sigue es negativa, esto quiere decir, que entre más cueste un dolar en pesos Méxicanos o que el tipo de cambio sea más bajo, menos se exportan vehículos ligeros.
modelo_regresion2 <- lm(Venta~Tipo.de.cambio+Inflación+porcentaje_ocu+porcentaje_desocu+conf_consumidor,data=prediccion_mx2)
summary(modelo_regresion2)
##
## Call:
## lm(formula = Venta ~ Tipo.de.cambio + Inflación + porcentaje_ocu +
## porcentaje_desocu + conf_consumidor, data = prediccion_mx2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -65349 -9980 -304 9815 72511
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1669878.4 183280.3 -9.111 < 2e-16 ***
## Tipo.de.cambio 764.6 379.5 2.014 0.04534 *
## Inflación 1503.1 863.9 1.740 0.08346 .
## porcentaje_ocu 18703.8 2011.8 9.297 < 2e-16 ***
## porcentaje_desocu NA NA NA NA
## conf_consumidor -1065.7 397.4 -2.682 0.00795 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 18270 on 195 degrees of freedom
## Multiple R-squared: 0.4258, Adjusted R-squared: 0.414
## F-statistic: 36.15 on 4 and 195 DF, p-value: < 2.2e-16
En este modelo de regresión, en lugar de exportaciones, se tomaron en cuenta las ventas de vehiculos, y de igual forma se grafico dos veces, la primera sin año y mes, lo cual nos daba como variable significativa la de porcentaje de población ocupada, y después agregando las variables año y mes, la mayoría de las variables tuvieron sentido con los 3 asteriscos, a excepción del porcentaje de población desocupada y el tipo de cambio.
effect_plot(modelo_regresion2,pred=porcentaje_ocu,interval=TRUE)
## Warning in predict.lm(model, newdata = pm, se.fit = interval, interval =
## int.type[1], : prediction from a rank-deficient fit may be misleading
Aquí se observa que la tendencia de la gráfica es positiva, y lo que se
graficó fueron las ventas y la variable significativa que fue porcentaje
de población ocupada. Para interpretar de forma general, la gráfica
quiere decir que entre más porcentaje de población cuente con trabajo,
más ventas habrá.
summary(prediccion_usa)
## Año Export ventas PIB
## Min. :2007 Min. : 12046 Min. :3340000 Min. :14474
## 1st Qu.:2010 1st Qu.:107211 1st Qu.:5355000 1st Qu.:15324
## Median :2014 Median :155337 Median :6090000 Median :17551
## Mean :2014 Mean :159746 Mean :6085333 Mean :17813
## 3rd Qu.:2018 3rd Qu.:241385 3rd Qu.:7390000 3rd Qu.:20003
## Max. :2021 Max. :314580 Max. :7710000 Max. :22996
## US_Unemployment US_Consumer_Confidence US_Min_Hour_Wage
## Min. :3.680 Min. :63.75 Min. :5.50
## 1st Qu.:4.750 1st Qu.:74.19 1st Qu.:7.25
## Median :5.800 Median :81.54 Median :7.25
## Mean :6.359 Mean :81.98 Mean :7.04
## 3rd Qu.:8.085 3rd Qu.:92.39 3rd Qu.:7.25
## Max. :9.610 Max. :98.37 Max. :7.25
str(prediccion_usa)
## 'data.frame': 15 obs. of 7 variables:
## $ Año : int 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 ...
## $ Export : num 12046 23896 25065 89066 125356 ...
## $ ventas : num 7560000 6770000 5400000 5640000 6090000 7250000 7590000 7710000 7530000 6880000 ...
## $ PIB : num 14474 14770 14478 15049 15600 ...
## $ US_Unemployment : num 4.62 5.8 9.28 9.61 8.93 8.08 7.36 6.16 5.28 4.88 ...
## $ US_Consumer_Confidence: num 85.6 63.8 66.3 71.8 67.3 ...
## $ US_Min_Hour_Wage : num 5.5 6.2 6.9 7.25 7.25 7.25 7.25 7.25 7.25 7.25 ...
Para ambos modelos de regresión, se usa una base de datos que contiene 2 variables dependientes, y 5 variables exploratorias, sin contar año y mes.
variable1<-c("Ventas", "Exportación", "PIB", "US_Min_Hour_Wage", "US_Consumer_Confidence", "US_Unemployment")
tipo_variable1 <- c("Dependiente", "Dependiente", "Exploratoria", "Exploratoria", "Exploratoria", "Exploratoria")
unidad_medicion1 <- c("Unidades", "Unidades", "Dólares", "Dólares (Salario mínimo por hora)", "% de confianza del consumidor", "% de desempleo")
tabla_variables1<-data.frame(variable1,tipo_variable1,unidad_medicion1)
knitr::kable(tabla_variables1)
| variable1 | tipo_variable1 | unidad_medicion1 |
|---|---|---|
| Ventas | Dependiente | Unidades |
| Exportación | Dependiente | Unidades |
| PIB | Exploratoria | Dólares |
| US_Min_Hour_Wage | Exploratoria | Dólares (Salario mínimo por hora) |
| US_Consumer_Confidence | Exploratoria | % de confianza del consumidor |
| US_Unemployment | Exploratoria | % de desempleo |
corrplot(cor(prediccion_usa), type="upper",order="hclust",addcoef.col="black")
## Warning in text.default(pos.xlabel[, 1], pos.xlabel[, 2], newcolnames, srt =
## tl.srt, : "addcoef.col" is not a graphical parameter
## Warning in text.default(pos.ylabel[, 1], pos.ylabel[, 2], newrownames, col =
## tl.col, : "addcoef.col" is not a graphical parameter
## Warning in title(title, ...): "addcoef.col" is not a graphical parameter
Lo que podemos observar en este gráfico de correlación, es la fuerte relación que existe entre el año y el PIB, seguido por la relación entre las exportaciones y el salario mínimo por horas que se trabajan.
modelo_regresion_usa <- lm(Export~PIB+US_Unemployment+US_Consumer_Confidence+US_Min_Hour_Wage,data=prediccion_usa)
summary(modelo_regresion_usa)
##
## Call:
## lm(formula = Export ~ PIB + US_Unemployment + US_Consumer_Confidence +
## US_Min_Hour_Wage, data = prediccion_usa)
##
## Residuals:
## Min 1Q Median 3Q Max
## -86554 -28225 -514 16734 108147
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -8.088e+05 2.535e+05 -3.191 0.00964 **
## PIB -1.252e+01 9.631e+00 -1.300 0.22280
## US_Unemployment -2.192e+04 1.762e+04 -1.244 0.24177
## US_Consumer_Confidence 2.194e+03 2.621e+03 0.837 0.42220
## US_Min_Hour_Wage 1.635e+05 5.179e+04 3.157 0.01021 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 57420 on 10 degrees of freedom
## Multiple R-squared: 0.7315, Adjusted R-squared: 0.6241
## F-statistic: 6.811 on 4 and 10 DF, p-value: 0.006499
Lo que podemos interpretar de este modelo de regresión, es que la variable más significativa y en consecuencia, la que se debe elegir, es la variable de US_Min_Hour_Wage, que significa, el salario por hora, por lo que se puede confirmar lo que anteriormente se vió en la correlación, es decir, la relación entre el salario por hora y la exportación.
effect_plot(modelo_regresion_usa,pred=US_Min_Hour_Wage,interval=TRUE)
Más visualmente, se puede rescatar de la gráfica que entre más bajo sea el salario mínimo por hora, menos exportaciones se tienen, esto puede deberse a la motivación de los empleados con lo que más los mueve que es el salario.
modelo_regresion_usa_2 <- lm(ventas~PIB+US_Unemployment+US_Consumer_Confidence+US_Min_Hour_Wage,data=prediccion_usa)
summary(modelo_regresion_usa_2)
##
## Call:
## lm(formula = ventas ~ PIB + US_Unemployment + US_Consumer_Confidence +
## US_Min_Hour_Wage, data = prediccion_usa)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1000398 -651416 103605 463662 1074740
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10101983.2 3570402.4 2.829 0.01787 *
## PIB -739.7 135.7 -5.452 0.00028 ***
## US_Unemployment -532799.6 248166.4 -2.147 0.05736 .
## US_Consumer_Confidence 24515.5 36919.5 0.664 0.52169
## US_Min_Hour_Wage 1496755.9 729486.7 2.052 0.06731 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 808800 on 10 degrees of freedom
## Multiple R-squared: 0.7783, Adjusted R-squared: 0.6896
## F-statistic: 8.774 on 4 and 10 DF, p-value: 0.002622
Para el siguiente modelo de regresión, se utilizó la variable ventas como variable dependiente, y el PIB como variable exploratoria, ya que, en el modelo de regresión se puede observar que es el la variable más significativa cuando se trata de las ventas.
effect_plot(modelo_regresion_usa_2,pred=PIB,interval=TRUE)
En el gráfico, lo que se ve a simple vista es una tenencia negativa, y lo que interpretamos es que la gráfica dice que si el PIB es mayor, las ventas son menores.
Vehículos de motor registrados en circulación
summary(pronostico_mx)
## Año Total Automóviles
## 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
##
##
##
##
##
str(pronostico_mx)
## 'data.frame': 47 obs. of 8 variables:
## $ Año : chr "1980" "1981" "1982" "1983" ...
## $ Total : int 4010430 4406336 4686130 4797562 5047043 5360870 5286295 5420592 5682964 6093682 ...
## $ Automóviles : int 3950042 4341363 4616897 4726236 4970526 5281842 5202922 5336228 5597735 6003532 ...
## $ Camiones.para.pasajeros : int 60388 64973 69233 71326 76517 79028 83373 84364 85229 90150 ...
## $ Camiones.y.camionetas.para.carga: int 1470816 1636899 1751799 1893206 2009875 2114395 2213025 2292078 2424025 2691551 ...
## $ Motocicletas : int 277084 296601 257235 250484 248148 250358 232692 221059 217898 223815 ...
## $ X : logi NA NA NA NA NA NA ...
## $ X.1 : logi NA NA NA NA NA NA ...
pronostico_mx1 <- subset(pronostico_mx, select = -c (Camiones.y.camionetas.para.carga, Motocicletas, X, X.1))
pronostico_mx1
## Año
## 1 1980
## 2 1981
## 3 1982
## 4 1983
## 5 1984
## 6 1985
## 7 1986
## 8 1987
## 9 1988
## 10 1989
## 11 1990
## 12 1991
## 13 1992
## 14 1993
## 15 1994
## 16 1995
## 17 1996
## 18 1997
## 19 1998
## 20 1999
## 21 2000
## 22 2001
## 23 2002
## 24 2003
## 25 2004
## 26 2005
## 27 2006
## 28 2007
## 29 2008
## 30 2009
## 31 2010
## 32 2011
## 33 2012
## 34 2013
## 35 2014
## 36 2015
## 37 2016
## 38 2017
## 39 2018
## 40 2019
## 41 2020
## 42 2021
## 43
## 44
## 45
## 46 FUENTE: INEGI. Estadísticas de vehículos de motor registrados en circulación.
## 47
## Total Automóviles Camiones.para.pasajeros
## 1 4010430 3950042 60388
## 2 4406336 4341363 64973
## 3 4686130 4616897 69233
## 4 4797562 4726236 71326
## 5 5047043 4970526 76517
## 6 5360870 5281842 79028
## 7 5286295 5202922 83373
## 8 5420592 5336228 84364
## 9 5682964 5597735 85229
## 10 6093682 6003532 90150
## 11 6648825 6555550 93275
## 12 7047618 6950708 96910
## 13 7494357 7399178 95179
## 14 7801892 7715951 85941
## 15 7332309 7217732 114577
## 16 7590001 7469504 120497
## 17 7927797 7830864 96933
## 18 8528440 8402995 125445
## 19 9262652 9086209 176443
## 20 9783153 9582796 200357
## 21 10378575 10176179 202396
## 22 11625518 11351982 273536
## 23 12554275 12254910 299365
## 24 13050150 12742049 308101
## 25 13652596 13388011 264585
## 26 14569197 14300380 268817
## 27 16722002 16411813 310189
## 28 18018701 17696623 322078
## 29 19754229 19420942 333287
## 30 20856689 20519224 337465
## 31 21465511 21152773 312738
## 32 22701891 22374326 327565
## 33 23908143 23569623 338520
## 34 25167066 24819922 347144
## 35 25891628 25543908 347720
## 36 27265446 26907994 357452
## 37 29032067 28664295 367772
## 38 31359162 30958042 401120
## 39 32733646 32290067 443579
## 40 34057197 33603591 453606
## 41 34886784 34425695 461089
## 42 35913468 35460804 452664
## 43 NA NA NA
## 44 NA NA NA
## 45 NA NA NA
## 46 NA NA NA
## 47 NA NA NA
Estas variables se eliminan, ya que, camiones y camionetas para carga y motocicletas no son el principal mercado de FORM, además de que los datos de sus variables no son significativas para el pronóstico porque sus valores son muy pequeños a comparación con las demás variables, por lo tanto, sus datos no impactan al análisis, de igual forma, se elimina la variable X y X.1 porque no tienen información relevante.
pronostico_mx2 <- pronostico_mx1[-c(43,44,45,46,47),]
pronostico_mx2
## Año Total Automóviles Camiones.para.pasajeros
## 1 1980 4010430 3950042 60388
## 2 1981 4406336 4341363 64973
## 3 1982 4686130 4616897 69233
## 4 1983 4797562 4726236 71326
## 5 1984 5047043 4970526 76517
## 6 1985 5360870 5281842 79028
## 7 1986 5286295 5202922 83373
## 8 1987 5420592 5336228 84364
## 9 1988 5682964 5597735 85229
## 10 1989 6093682 6003532 90150
## 11 1990 6648825 6555550 93275
## 12 1991 7047618 6950708 96910
## 13 1992 7494357 7399178 95179
## 14 1993 7801892 7715951 85941
## 15 1994 7332309 7217732 114577
## 16 1995 7590001 7469504 120497
## 17 1996 7927797 7830864 96933
## 18 1997 8528440 8402995 125445
## 19 1998 9262652 9086209 176443
## 20 1999 9783153 9582796 200357
## 21 2000 10378575 10176179 202396
## 22 2001 11625518 11351982 273536
## 23 2002 12554275 12254910 299365
## 24 2003 13050150 12742049 308101
## 25 2004 13652596 13388011 264585
## 26 2005 14569197 14300380 268817
## 27 2006 16722002 16411813 310189
## 28 2007 18018701 17696623 322078
## 29 2008 19754229 19420942 333287
## 30 2009 20856689 20519224 337465
## 31 2010 21465511 21152773 312738
## 32 2011 22701891 22374326 327565
## 33 2012 23908143 23569623 338520
## 34 2013 25167066 24819922 347144
## 35 2014 25891628 25543908 347720
## 36 2015 27265446 26907994 357452
## 37 2016 29032067 28664295 367772
## 38 2017 31359162 30958042 401120
## 39 2018 32733646 32290067 443579
## 40 2019 34057197 33603591 453606
## 41 2020 34886784 34425695 461089
## 42 2021 35913468 35460804 452664
summary(pronostico_mx2)
## Año Total Automóviles
## Length:42 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
## Camiones.para.pasajeros
## Min. : 60388
## 1st Qu.: 90931
## Median :233491
## Mean :226213
## 3rd Qu.:336421
## Max. :461089
Se eliminan estos renglones, debido a que no tenían contenido, es decir, eran considerados NA´s.
plot(pronostico_mx2$Año,pronostico_mx2$Total, type="l",col="blue", lwd=1.5, xlab ="Año",ylab ="Unidades", main = "Vehiculos de motor en circulación registrados anualmente")
lines(pronostico_mx2$Año,pronostico_mx2$Automóviles,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)
Con este plot, se puede observar el comportamiento de las variables y la
comparación a través de los años del total de vehiculos que están en
circulación y de los automoviles. También, se percibe que ambas líneas
son muy similares, y están muy cerca una de la otra, por lo que se puede
deducir que Automóviles ocupa el mayor porcentaje del total. Por otro
lado, la gráfica tiene una tendencia en su mayoría creciente y positiva,
es decir, que cada año hay más automóviles en circulación.
autoregressive_model <- arma(pronostico_mx2$Total, order = c(1,0))
## Warning in arma(pronostico_mx2$Total, order = c(1, 0)): Hessian negative-
## semidefinite
summary(autoregressive_model <- arma(pronostico_mx2$Total, order = c(1,0)))
## Warning in arma(pronostico_mx2$Total, order = c(1, 0)): Hessian negative-
## semidefinite
## Warning in sqrt(diag(object$vcov)): Se han producido NaNs
## Warning in sqrt(diag(object$vcov)): Se han producido NaNs
##
## Call:
## arma(x = pronostico_mx2$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))
## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series
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
Lo que se observa en el modelo autoregresivo de los vehículos de motor en circulación y al pronóstico para los siguientes años, es que como se explico anteriormente, tiene una tendencia positiva, 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.
plot(autoregressive_model_forecast)
Con este plot, se puede interpretar de manera más visual lo que se explico anteriormente, y para explicarlo con mayor precisión, es necesario saber que la línea negra corresponde a los datos que se tienen en la base de datos, mientras que la línea azul significa el resultado de los datos obtenidos a través del modelo autoregresivo, y se puede observar que va hacia arriba la tendencia. Por otro lado, la línea azul tiene un sombreado gris que indica los valores de “low” y “high” ante el 95% de confianza.
mam_circulacion <- arma(pronostico_mx2$Total,order = c(1,1))
## Warning in arma(pronostico_mx2$Total, order = c(1, 1)): Hessian negative-
## semidefinite
summary(mam_circulacion <- arma(pronostico_mx2$Total,order = c(1,1)))
## Warning in arma(pronostico_mx2$Total, order = c(1, 1)): Hessian negative-
## semidefinite
## Warning in sqrt(diag(object$vcov)): Se han producido NaNs
## Warning in sqrt(diag(object$vcov)): Se han producido NaNs
##
## Call:
## arma(x = pronostico_mx2$Total, order = c(1, 1))
##
## Model:
## ARMA(1,1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -907766 -184323 -41323 113291 1305470
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 1.042e+00 4.680e-03 222.585 < 2e-16 ***
## ma1 3.442e-01 1.237e-01 2.783 0.00539 **
## intercept 1.767e+05 NaN NaN NaN
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 1.598e+11, Conditional Sum-of-Squares = 6.391897e+12, AIC = 1208.67
mam_circulacion_forecast <- forecast(mam_circulacion$fitted,h=5,level=c(95))
## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series
mam_circulacion_forecast
## Point Forecast Lo 95 Hi 95
## 43 37635019 34318781 40951258
## 44 38948870 33832084 44065655
## 45 40262720 33315250 47210190
## 46 41576570 32704146 50448994
## 47 42890421 31977035 53803806
A través de este código, podemos deducir, que buscamos un modelo no estacionario, y que esta en constante movimiento, y al igual que el modelo autoregresivo, se puede observar una tendencia positiva, y muy similar a ella, así mismo, cuenta con un 95% de confianza. Por otro lado, los vehículos circulando durante el primer periodo de tiempo se calcula que son 37,635,019, seguido por 38,948,870 y 40,262,720.
plot(mam_circulacion_forecast)
Aquí se puede interpretar gráficamente lo explicado en el punto anterior, y se obseva como la tendencia es positiva, de igual forma, tiene “lows” y “highs”.
pronostico_usa <- clean_names(pronostico_usa)
summary(pronostico_usa)
## 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
str(pronostico_usa)
## 'data.frame': 17 obs. of 5 variables:
## $ years : int 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 ...
## $ new_passanger_car_sales: int 6098000 6182000 6177000 5387000 4507000 4514977 4812351 5691669 5711630 5750748 ...
## $ new_light_truck_sales : int 7394000 6560000 6140000 4898000 3540000 5094870 5709064 6231383 6652624 7193087 ...
## $ used_vehicle_sales : int 44138263 42565544 41418561 36530404 35491762 36911180 36920834 37582716 35775755 36241800 ...
## $ total : int 57630263 55307544 53735561 46815404 43538762 46521027 47442249 49505768 48140008 49185636 ...
plot(pronostico_usa$years,pronostico_usa$total, type="l",col="blue", lwd=1.5, xlab ="Año",ylab ="Unidades", main = "Ventas de vehículos en EUA")
lines(pronostico_usa$years,pronostico_usa$used.vehicle.sales,col="red",lty=3)
legend("topleft", legend=c("Total de ventas en EUA", "Ventas de vehículos usados"),
col=c("blue", "red"), lty = 1:2, cex=0.8)
autoregressive_model_usa <- arma(pronostico_usa$total, order = c(1,0))
summary(autoregressive_model_usa <- arma(pronostico_usa$total, order = c(1,0)))
##
## Call:
## arma(x = pronostico_usa$total, order = c(1, 0))
##
## Model:
## ARMA(1,0)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5267300 -455984 785063 1367969 2147658
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 6.200e-01 1.017e-02 60.93 <2e-16 ***
## intercept 1.877e+07 3.302e+04 568.47 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 4.806e+12, Conditional Sum-of-Squares = 7.209743e+13, AIC = 548.66
autoregressive_model_usa_forecast<-forecast(autoregressive_model_usa$fitted,h=5,level=c(95))
## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series
autoregressive_model_usa_forecast
## Point Forecast Lo 95 Hi 95
## 18 49555404 45839708 53271100
## 19 49555404 44298960 54811848
## 20 49555404 43115354 55995454
## 21 49555404 42116416 56994391
## 22 49555404 41235361 57875447
plot(autoregressive_model_usa_forecast)
mam_pronostico_usa <- arma(pronostico_usa$total,order = c(1,1))
## Warning in arma(pronostico_usa$total, order = c(1, 1)): Hessian negative-
## semidefinite
summary(mam_pronostico_usa <- arma(pronostico_usa$total,order = c(1,1)))
## Warning in arma(pronostico_usa$total, order = c(1, 1)): Hessian negative-
## semidefinite
## Warning in sqrt(diag(object$vcov)): Se han producido NaNs
## Warning in sqrt(diag(object$vcov)): Se han producido NaNs
##
## Call:
## arma(x = pronostico_usa$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_pronostico_usa_forecast <- forecast(mam_pronostico_usa$fitted,h=5,level=c(95))
## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series
mam_pronostico_usa_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_pronostico_usa_forecast)
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
##
##
##
str(scrap)
## 'data.frame': 250 obs. of 8 variables:
## $ referencia : chr "SP/08512" "SP/08511" "SP/08676" "SP/08700" ...
## $ fecha : chr "06/08/2022" "05/08/2022" "26/08/2022" "29/08/2022" ...
## $ producto : chr "[2065WY AS 30 99 0000 00 000 TAPA - BOX 2064WY] BOX 2064WY" "[2065WY AS 30 99 0000 00 000 TAPA - BOX 2064WY] BOX 2064WY" "[241B EXPORT CAJA] 241B. Export. Caja." "[341332 CELDA - U611 & U625] 341332. U611. U625. Celda Troquelada." ...
## $ cantidad : num 43 6 2 51 12 19 6 12 20 11 ...
## $ unidad_de_medida : chr "Unidad(es)" "Unidad(es)" "Unidad(es)" "Unidad(es)" ...
## $ ubicacion_de_origen : chr "Pre-Production" "Calidad/Entrega de PT" "Calidad/Entrega de PT" "Pre-Production" ...
## $ ubicacion_de_desecho: chr "Virtual Locations/Scrapped" "Virtual Locations/Scrapped" "Virtual Locations/Scrapped" "Virtual Locations/Scrapped" ...
## $ estado : chr "Hecho" "Hecho" "Hecho" "Hecho" ...
autoregressive_model_scrap <- arma(scrap$cantidad, order = c(1,0))
summary(autoregressive_model_scrap <- arma(scrap$cantidad, order = c(1,0)))
##
## Call:
## arma(x = scrap$cantidad, order = c(1, 0))
##
## Model:
## ARMA(1,0)
##
## Residuals:
## Min 1Q Median 3Q Max
## -21.05741 -3.52640 -2.52640 -0.09522 88.88652
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 0.43118 0.05572 7.738 9.99e-15 ***
## intercept 3.66404 0.75831 4.832 1.35e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 109.4, Conditional Sum-of-Squares = 27133.66, AIC = 1887.24
autoregressive_model_scrap_forecast<-forecast(autoregressive_model_scrap$fitted,h=5,level=c(95))
## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series
autoregressive_model_scrap_forecast
## Point Forecast Lo 95 Hi 95
## 251 3.985973 0.03043788 7.941509
## 252 3.898350 -0.02465771 7.821359
## 253 3.825034 -0.12784265 7.777910
## 254 3.763687 -0.27995767 7.807332
## 255 3.712357 -0.47584301 7.900557
ggplot(scrap,aes(x=fecha,y=cantidad))+
geom_point(size=2,shape=23)
plot(autoregressive_model_scrap_forecast)
mam_scrap <- arma(scrap$cantidad,order = c(1,1))
summary(mam_scrap <- arma(scrap$cantidad,order = c(1,1)))
##
## Call:
## arma(x = scrap$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))
## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series
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)
summary(bd_performance)
## fecha printel mahle magna varroc
## Length:324 Min. :0.0000 Min. :-9.00 Min. :0 Min. :0
## Class :character 1st Qu.:0.0000 1st Qu.: 2.00 1st Qu.:0 1st Qu.:0
## Mode :character Median :0.0000 Median : 3.00 Median :0 Median :0
## Mean :0.3395 Mean : 2.21 Mean :0 Mean :0
## 3rd Qu.:0.2500 3rd Qu.: 3.00 3rd Qu.:0 3rd Qu.:0
## Max. :4.0000 Max. :20.00 Max. :0 Max. :0
## retraso
## Min. :-7.000
## 1st Qu.: 2.000
## Median : 3.000
## Mean : 2.549
## 3rd Qu.: 3.000
## Max. :20.000
str(bd_performance)
## 'data.frame': 324 obs. of 6 variables:
## $ fecha : chr "22/07/2021" "25/07/2021" "26/07/2021" "27/07/2021" ...
## $ printel: int 0 1 1 0 0 1 1 1 0 1 ...
## $ mahle : int 2 2 2 2 2 2 2 3 3 3 ...
## $ magna : int 0 0 0 0 0 0 0 0 0 0 ...
## $ varroc : int 0 0 0 0 0 0 0 0 0 0 ...
## $ retraso: int 2 3 3 2 2 3 3 4 3 4 ...
autoregressive_model_performance <- arma(bd_performance$retraso, order = c(1,0))
summary(autoregressive_model_performance <- arma(bd_performance$retraso, order = c(1,0)))
##
## Call:
## arma(x = bd_performance$retraso, order = c(1, 0))
##
## Model:
## ARMA(1,0)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10.4150 -0.8329 0.3611 0.9432 17.9432
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 0.1940 0.0545 3.56 0.00037 ***
## intercept 2.0568 0.1731 11.88 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 3.473, Conditional Sum-of-Squares = 1118.16, AIC = 1326.82
autoregressive_model_performance_forecast<-forecast(autoregressive_model_performance$fitted,h=5,level=c(95))
## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series
summary(autoregressive_model_performance_forecast)
##
## Forecast method: ETS(M,N,N)
##
## Model Information:
## ETS(M,N,N)
##
## Call:
## ets(y = object, lambda = lambda, biasadj = biasadj, allow.multiplicative.trend = allow.multiplicative.trend)
##
## Smoothing parameters:
## alpha = 0.1126
##
## Initial states:
## l = 2.5814
##
## sigma: 0.1301
##
## AIC AICc BIC
## 1155.950 1156.025 1167.283
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.001010957 0.3481271 0.2143561 -2.009761 9.298164 0.8827124
## ACF1
## Training set -0.008053815
##
## Forecasts:
## Point Forecast Lo 95 Hi 95
## 325 2.618116 1.950642 3.285590
## 326 2.618116 1.946356 3.289876
## 327 2.618116 1.942096 3.294136
## 328 2.618116 1.937862 3.298370
## 329 2.618116 1.933653 3.302579
ggplot(bd_performance,aes(x=fecha,y=retraso))+
geom_point(size=2,shape=23)
plot(autoregressive_model_performance_forecast)
mam_performance <- arma(bd_performance$retraso,order = c(1,1))
summary(mam_performance <- arma(bd_performance$retraso,order = c(1,1)))
##
## Call:
## arma(x = bd_performance$retraso, order = c(1, 1))
##
## Model:
## ARMA(1,1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11.1691 -0.6033 0.2910 0.7730 16.6768
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 0.96194 0.02902 33.149 <2e-16 ***
## ma1 -0.86112 0.05448 -15.807 <2e-16 ***
## intercept 0.09791 0.07547 1.297 0.195
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 3.198, Conditional Sum-of-Squares = 1029.84, AIC = 1302.14
mam_performance_forecast <- forecast(mam_performance$fitted,h=5,level=c(95))
## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series
mam_performance_forecast
## Point Forecast Lo 95 Hi 95
## 325 2.84482 2.486224 3.203415
## 326 2.84482 2.337190 3.352449
## 327 2.84482 2.222471 3.467169
## 328 2.84482 2.125455 3.564184
## 329 2.84482 2.039717 3.649922
plot(mam_performance_forecast)
bajas_clusters <- clean_names(bajas_clusters)
summary(bajas_clusters)
## 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
##
##
##
##
bajas_clusters <- subset(bajas_clusters, 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))
bajas_clusters$edad[is.na(bajas_clusters$edad)]<-mean(bajas_clusters$edad, na.rm = TRUE)
bajas_clusters$salario_diario_imss[is.na(bajas_clusters$salario_diario_imss)]<-mean(bajas_clusters$salario_diario_imss, na.rm = TRUE)
bajas_clusters$no_dias[is.na(bajas_clusters$no_dias)]<-mean(bajas_clusters$no_dias, na.rm = TRUE)
summary(bajas_clusters)
## 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
bajas_clusters$edad<-as.numeric(bajas_clusters$edad)
bajas_clusters$genero<-as.factor(bajas_clusters$genero)
bajas_clusters$motivo_de_baja<-as.factor(bajas_clusters$motivo_de_baja)
bajas_clusters$no_dias<-as.numeric(bajas_clusters$no_dias)
bajas_clusters$puesto<-as.factor(bajas_clusters$puesto)
bajas_clusters$salario_diario_imss<-as.numeric(bajas_clusters$salario_diario_imss)
bajas_clusters$estado_civil<-as.factor(bajas_clusters$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
edad <-bajas_clusters
edad <- subset(bajas_clusters,select = -c(genero, motivo_de_baja, puesto, salario_diario_imss, estado_civil))
edad_norm<-scale(edad[1:2])
summary(edad_norm)
## edad no_dias
## Min. :-1.2638 Min. :-0.3727
## 1st Qu.:-0.8457 1st Qu.:-0.3305
## Median :-0.2184 Median :-0.2648
## Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.6178 3rd Qu.: 0.0000
## Max. : 3.1266 Max. : 8.8462
fviz_nbclust(edad_norm, kmeans, method="wss")+
geom_vline(xintercept=4, linetype=2)+
labs(subtitle = "Elbow method")
Esta herramienta nos permite ver cuantos clusters son los óptimos para visualizarlos de mejor manera.
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"
fviz_cluster(edad_cluster,data=edad_norm)
edad_salario <-bajas_clusters
edad_salario<- subset(bajas_clusters,select = -c(genero,estado_civil,motivo_de_baja, puesto, no_dias))
edad_salario_norm<-scale(edad_salario[1:2])
fviz_nbclust(edad_salario_norm, kmeans, method="wss")+
geom_vline(xintercept=4, linetype=2)+
labs(subtitle = "Elbow method")
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"
fviz_cluster(edad_salario_cluster,data=edad_salario_norm)
dias_salario <-bajas_clusters
dias_salario<- subset(bajas_clusters,select = -c(genero,estado_civil,motivo_de_baja, puesto, edad))
dias_salario_norm<-scale(dias_salario[1:2])
fviz_nbclust(dias_salario_norm, kmeans, method="wss")+
geom_vline(xintercept=4, linetype=2)+
labs(subtitle = "Elbow method")
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"
fviz_cluster(dias_salario_cluster,data=dias_salario_norm)
promedio_dias <- mean(bajas_clusters$no_dias)
promedio_dias
## [1] 79.47196
Decidimos usar el Cluster 2 para generar la clasificación de variables y poder comparar con datos cualitativos.
bajas_clusters1<-bajas_clusters
bajas_clusters1$Clusters<-edad_salario_cluster$cluster
bajas_clusters2<-bajas_clusters1 %>% group_by(Clusters) %>% dplyr::summarise(edad=max(edad)) %>% arrange(desc(edad))
bajas_clusters1$Cluster_Names<-factor(bajas_clusters1$Clusters,levels = c(1,2,3,4),
labels=c("Outlier", "Joven", "Avanzada", "Adulta"))
bajas_clusters3 <- bajas_clusters1 %>% group_by(Cluster_Names) %>% dplyr::summarize(edad_años=max(edad), salario_imss=mean(salario_diario_imss),Count=n())
clusters<-as.data.frame(bajas_clusters3)
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
ggplot(bajas_clusters3,aes(x=reorder(Cluster_Names,Count),y=Count,fill=Cluster_Names)) +
geom_bar(stat="identity")
ggplot(bajas_clusters3, aes(x=Cluster_Names,y=edad_años,fill= Cluster_Names,label=round(edad_años,digits=2))) +
geom_col() +
geom_text()
ggplot(bajas_clusters1, aes(factor(Cluster_Names), fill = factor(genero))) +
geom_bar(position = position_dodge2(preserve = "single"))
ggplot(bajas_clusters1, aes(factor(Cluster_Names), fill = factor(estado_civil))) +
geom_bar(position = position_dodge2(preserve = "single"))
ggplot(bajas_clusters1, aes(factor(Cluster_Names), fill = factor(motivo_de_baja))) +
geom_bar(position = position_dodge2(preserve = "single"))
bajas_clusters4 <-bajas_clusters1 %>% filter(Clusters==1 | Clusters==3) %>% arrange(Clusters)
library(ggalluvial)
ggplot(as.data.frame(bajas_clusters4),
aes(y=edad, 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("Gender", "Marital Status"), expand = c(.05, .05)) +
scale_fill_brewer(type = "qual", palette = "Set1") +
ggtitle("FORM's Daily Wage by Sex and Marital Status")
bajas_clusters5 <-bajas_clusters1 %>% filter(Clusters==2 | Clusters==4) %>% arrange(Clusters)
library(ggalluvial)
ggplot(as.data.frame(bajas_clusters4),
aes(y=edad, 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("Gender", "Marital Status"), expand = c(.05, .05)) +
scale_fill_brewer(type = "qual", palette = "Set1") +
ggtitle("FORM's Daily Wage by Sex and Marital Status")
Business Analytics Es una herramienta con la cual
podemos explorar grandes cantidades de datos en diversas fuentes para
poder identificar patrones que a su vez ayudan a reconocer y predecir
tendencias en diferentes mercados, considera diversos factores como el
económico, de mercado, tecnológicos, entre otros.
Su principal objetivo es comprender los posibles resultados en cuanto a
cada acción realizada, tomando en cuenta los datos procesados, esto
puede tener valor dentro y fuera de una empresa.
Business intelligence Es un software en el que se
procesa información de negocio, se puede alimentar con una gran cantidad
de fuentes como lo son reportes, paneles, tablas y gráficos. Sus
diferentes herramientas facilitan a los usuarios poder tener de manera
eficiente y rápida ferencias actuales o del pasado, gracias a la
tecnología desarrollada actualmente la información surge de muchas
plataformas y una de ellas en que también se puede recolectar
información son los datos no estructurados o mejor conocidas como las
redes sociales. Business inteligence no establece a sus usuarios que
pasos seguir, de igual manera tampoco es una herramienta que solo genera
informes sino que ofrece de manera detallada y eficiente la examinación
de datos para lograr tener una idea más clara sobre las predisposición
del mercado y poder dirigir la percepción del cosumidor.
Es importante ya que permite tener un mejor conocimiento del mercado que
se quiere explotar, ya que permite evaluar, detectar e impulsar la
mejora constante para llegar al fin de perfeccionar la calidad de los
productos, dar mayor satisfacción a la interacción con los clientes y
mejorar en los procesos empresariales y organizacionales.
Es un método para lograr la sintetización de información con eficacia
y productividad en las diferentes acciones que se toman constantemente
en los negocios y su fin es señalar e indicar las decisiones que han
causado mejor desempeño, es decir, que han sido más efectivas en los
objetivos en cuanto al mercado, desarrollo, crecimiento, entre
otras.
Si bien KPI también pueden ser conocidos como indicadores de calidad son
sumamente utilizados en el área de negocios y cual sector que se desea
hacer productivo, permite determinar estrategias, comparar información y
tomar de manera segura e infalible las decisiones que mejorarán en gran
magnitud el esquema de trabajo de una empresa.
Existen diversos tipos de Kpi, es importante determinar cuál es el
adecuado para tu plan de negocio, es importante conocer tu objetivo para
que sea más útil el emplear esta herramienta.
str(rh_logistic)
## 'data.frame': 349 obs. of 9 variables:
## $ EDAD : int 43 73 32 57 55 45 43 53 25 40 ...
## $ GENERO : chr "FEMENINO" "MASCULINO" "FEMENINO" "FEMENINO" ...
## $ PUESTO : chr "SUPERVISOR DE PEGADO" "EXTERNO" "SUPERVISORA" "SUPERVISORA" ...
## $ DEPARTAMENTO : chr "PRODUCCION CARTÓN MDL" "EXTERNO" "PRODUCCION CARTÓN MC" "COSTURA" ...
## $ SALARIO.DIARIO.IMSS: num 177 177 337 178 260 ...
## $ MUNICIPIO : chr "APODACA" "APODACA" "APODACA" "APODACA" ...
## $ ESTADO : chr "NUEVO LEON" "NUEVO LEON" "NUEVO LEON" "NUEVO LEON" ...
## $ ESTADO.CIVIL : chr "SOLTERO" "SOLTERO" "CASADO" "SOLTERO" ...
## $ BAJAS : int 0 0 0 0 0 0 0 0 0 0 ...
colnames(rh_logistic)<-c('edad','genero','puesto','depto','salario_diario','mpio','estado','estado_civil','bajas')
rh_logistic$edad <- as.numeric(rh_logistic$edad)
rh_logistic$salario_diario <- as.numeric(rh_logistic$salario_diario)
rh_logistic$genero<-as.factor(rh_logistic$genero)
rh_logistic$puesto<-as.factor(rh_logistic$puesto)
rh_logistic$depto<-as.factor(rh_logistic$depto)
rh_logistic$mpio<-as.factor(rh_logistic$mpio)
rh_logistic$estado<-as.factor(rh_logistic$estado)
rh_logistic$estado_civil<-as.factor(rh_logistic$estado_civil)
rh_logistic$bajas <- as.numeric(rh_logistic$bajas)
str(rh_logistic)
## 'data.frame': 349 obs. of 9 variables:
## $ edad : num 43 73 32 57 55 45 43 53 25 40 ...
## $ genero : Factor w/ 2 levels "FEMENINO","MASCULINO": 1 2 1 1 1 1 1 1 1 2 ...
## $ puesto : Factor w/ 17 levels "AYUDANTE DE EMBARQUES",..: 16 7 17 17 4 12 3 3 3 12 ...
## $ depto : Factor w/ 26 levels "","ADMINISTRATIVO",..: 22 13 21 9 9 9 9 9 22 11 ...
## $ salario_diario: num 177 177 337 178 260 ...
## $ mpio : Factor w/ 14 levels "APODACA","CADEREYTA",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ estado : Factor w/ 3 levels "COAHUILA","GUADALUPE N.L.",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ estado_civil : Factor w/ 4 levels "CASADO","DIVORCIADO",..: 3 3 1 3 1 4 1 1 3 3 ...
## $ bajas : num 0 0 0 0 0 0 0 0 0 0 ...
summary(rh_logistic)
## edad genero puesto
## Min. :19.00 FEMENINO :200 AYUDANTE GENERAL :286
## 1st Qu.:24.00 MASCULINO:149 COSTURERA : 24
## Median :30.00 RESIDENTE : 8
## Mean :32.79 INSPECTOR DE CALIDAD : 7
## 3rd Qu.:40.00 AYUDANTE DE EMBARQUES: 6
## Max. :73.00 MONTACARGUISTA : 3
## NA's :4 (Other) : 15
## depto salario_diario mpio
## :107 Min. :144.4 APODACA :191
## STABILUS : 56 1st Qu.:176.7 NUEVO LEON : 50
## COSTURA : 22 Median :180.7 PESQUERIA : 36
## PRODUCCIÓN RETORN: 22 Mean :178.3 JUAREZ : 22
## CEDIS : 17 3rd Qu.:180.7 RAMOS ARIZPE: 18
## PAILERIA : 16 Max. :500.0 GUADALUPE : 13
## (Other) :109 (Other) : 19
## estado estado_civil bajas
## COAHUILA : 17 CASADO :108 Min. :0.0000
## GUADALUPE N.L.: 1 DIVORCIADO : 6 1st Qu.:0.0000
## NUEVO LEON :331 SOLTERO :154 Median :1.0000
## UNION LIBRE: 81 Mean :0.6762
## 3rd Qu.:1.0000
## Max. :1.0000
##
rh_logistic$edad[is.na(rh_logistic$edad)]<-mean(rh_logistic$edad,na.rm=TRUE)
rh_logistic$edad<-replace(rh_logistic$edad,rh_logistic$edad==0,32)
rh_logistic$bajas<-as.factor(rh_logistic$bajas)
rh_logistic$dv_bajas<-fct_recode(rh_logistic$bajas, "BAJA"="1","NO BAJA"="0")
tapply(rh_logistic$salario_diario,
list(rh_logistic$genero,rh_logistic$estado_civil), mean)
## CASADO DIVORCIADO SOLTERO UNION LIBRE
## FEMENINO 179.1338 180.68 175.4728 177.2578
## MASCULINO 180.2559 178.70 180.7174 177.3359
set.seed(123)
training<-rh_logistic$dv_bajas %>%
createDataPartition(p=0.75,list=FALSE)
train.data<-rh_logistic[training, ]
test.data<-rh_logistic[-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.7798 -1.3045 0.7803 0.8407 1.1811
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.882946 1.516695 1.241 0.2144
## salario_diario -0.008860 0.008339 -1.062 0.2880
## estado_civilDIVORCIADO -0.290900 1.026463 -0.283 0.7769
## estado_civilSOLTERO 0.576272 0.312482 1.844 0.0652 .
## estado_civilUNION LIBRE 0.751073 0.364939 2.058 0.0396 *
## ---
## 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: 322.67 on 257 degrees of freedom
## AIC: 332.67
##
## Number of Fisher Scoring iterations: 4
ggplot(rh_logistic,aes(x=edad, 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 = "Probability of Bajas"
)
## `geom_smooth()` using formula 'y ~ x'
## Warning: Removed 349 rows containing non-finite values (stat_smooth).
## Warning: Removed 349 rows containing missing values (geom_point).