EVIDENCIA 2

Importar bases de datos

#file.choose()

bd_merma <- read.csv("/Users/isaacdiazruizdechavez/Downloads/FORM - Merma1.csv")
bd_scrap <- read.csv("/Users/isaacdiazruizdechavez/Downloads/FORM - Scrap(1).csv")
bd_bajas <- read.csv("/Users/isaacdiazruizdechavez/Downloads/bajas_limpia.csv")
bd_dper <- read.csv("/Users/isaacdiazruizdechavez/Downloads/FORM - Delivery Performance C.csv")
bd_dplan <- read.csv("/Users/isaacdiazruizdechavez/Downloads/DELIVERY PLAN bdf_Prueba(1).csv")
bd_prod <- read.csv("/Users/isaacdiazruizdechavez/Downloads/Producion Completa.csv")
bd_rh <- read.csv("/Users/isaacdiazruizdechavez/Downloads/rlimpia.csv")
bd_auto <- read.csv("/Users/isaacdiazruizdechavez/Downloads/us_motor_production_and_domestic_sales1.csv")

Bases de datos que no utilizamos en limpieza pero si utilizamos para el diagnóstico.

bajas <- read.csv("/Users/isaacdiazruizdechavez/Downloads/bajas_final(1).csv")
bd_colab <- read.csv("/Users/isaacdiazruizdechavez/Downloads/colab_final.csv")

Descargar paquetes y llamar librerías

library(foreign)
library(dplyr)        # data manipulation 

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(forcats)      # to work with categorical variables
library(ggplot2)      # data visualization 
library(janitor)      # data exploration and cleaning 

## 
## Attaching package: 'janitor'

## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test

library(Hmisc)        # several useful functions for data analysis 

## Loading required package: lattice

## Loading required package: survival

## Loading required package: Formula

## 
## Attaching package: 'Hmisc'

## The following objects are masked from 'package:dplyr':
## 
##     src, summarize

## The following objects are masked from 'package:base':
## 
##     format.pval, units

library(naniar) 
library(dlookr) 

## 
## Attaching package: 'dlookr'

## The following object is masked from 'package:Hmisc':
## 
##     describe

## The following object is masked from 'package:base':
## 
##     transform

library(pollster)

## 
## Attaching package: 'pollster'

## The following object is masked from 'package:janitor':
## 
##     crosstab

library(descr)

## 
## Attaching package: 'descr'

## The following object is masked from 'package:pollster':
## 
##     crosstab

## The following object is masked from 'package:janitor':
## 
##     crosstab

library(data.table)

## 
## Attaching package: 'data.table'

## The following objects are masked from 'package:dplyr':
## 
##     between, first, last

library(epiDisplay)

## Loading required package: MASS

## 
## Attaching package: 'MASS'

## The following object is masked from 'package:dplyr':
## 
##     select

## Loading required package: nnet

## 
## Attaching package: 'epiDisplay'

## The following object is masked from 'package:lattice':
## 
##     dotplot

## The following object is masked from 'package:ggplot2':
## 
##     alpha

library(tidyr)

## 
## Attaching package: 'tidyr'

## The following object is masked from 'package:dlookr':
## 
##     extract

library(psych)        # functions for multivariate analysis 

## 
## Attaching package: 'psych'

## The following objects are masked from 'package:epiDisplay':
## 
##     alpha, cs, lookup

## The following object is masked from 'package:dlookr':
## 
##     describe

## The following object is masked from 'package:Hmisc':
## 
##     describe

## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha

library(corrplot)     # correlation plots

## corrplot 0.92 loaded

library(jtools)       # presentation of regression analysis 

## 
## Attaching package: 'jtools'

## The following object is masked from 'package:epiDisplay':
## 
##     summ

## The following object is masked from 'package:Hmisc':
## 
##     %nin%

library(lmtest)       # diagnostic checks - linear regression analysis 

## Loading required package: zoo

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

## 
## Attaching package: 'lmtest'

## The following object is masked from 'package:epiDisplay':
## 
##     lrtest

library(car)          # diagnostic checks - linear regression analysis

## Loading required package: carData

## 
## Attaching package: 'car'

## The following object is masked from 'package:psych':
## 
##     logit

## The following object is masked from 'package:dplyr':
## 
##     recode

library(olsrr)        # diagnostic checks - linear regression analysis 

## 
## Attaching package: 'olsrr'

## The following object is masked from 'package:MASS':
## 
##     cement

## The following object is masked from 'package:datasets':
## 
##     rivers

library(kableExtra)   # HTML table attributes

## 
## Attaching package: 'kableExtra'

## The following object is masked from 'package:dplyr':
## 
##     group_rows

library(tseries)   # time series analysis and computational finance 

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

library(forecast)  # provides methods and tools for displaying and analyzing univariate time series forecast
library(astsa)     # applied statistical time series analysis

## 
## Attaching package: 'astsa'

## The following object is masked from 'package:forecast':
## 
##     gas

## The following object is masked from 'package:psych':
## 
##     scatter.hist

library(plyr)

## ------------------------------------------------------------------------------

## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)

## ------------------------------------------------------------------------------

## 
## Attaching package: 'plyr'

## The following objects are masked from 'package:Hmisc':
## 
##     is.discrete, summarize

## The following objects are masked from 'package:dplyr':
## 
##     arrange, count, desc, failwith, id, mutate, rename, summarise,
##     summarize

Producción

#### Tecnica 1.  Remover valores irrelevantes

bd_prod1 <- bd_prod
bd_prod1<-subset(bd_prod1,select=-c(No.,ID.FORM,PRODUCTO,X,HR..FIN,ESTACION.ARRANQUE,INICIO.SEP.UP,FIN.INICIO.DE.SEP.UP,INICIO.de.PROCESO,FIN.de.PROCESO,TIEMPO.CALIDAD,TIEMPO.MATERIALES,MERMAS.Maquinas.))
str(bd_prod1)

## 'data.frame':    5300 obs. of  5 variables:
##  $ Fecha             : chr  "15/07/2022" "15/07/2022" "15/07/2022" "15/07/2022" ...
##  $ CLIENTE           : chr  "STABILUS 1" "STABILUS 1" "STABILUS 1" "STABILUS 1" ...
##  $ PIEZAS.PROG.      : int  20 15 20 10 10 20 10 10 10 60 ...
##  $ TMO..MIN.         : chr  "9:20" "9:35" "9:55" "10:05" ...
##  $ Laminas.procesadas: chr  "9:05" "10:05" "9:40" "11.2" ...

#### Tecnica 4. Convertir tipos de datos
bd_prod2 <- bd_prod1
bd_prod2$TMO..MIN. <- substr(bd_prod2$TMO..MIN., start = 1, stop = 2)
#tibble(bd_prod2)  
bd_prod2$TMO..MIN. <- as.integer(bd_prod2$TMO..MIN.)

## Warning: NAs introduced by coercion

str(bd_prod2)  

## 'data.frame':    5300 obs. of  5 variables:
##  $ Fecha             : chr  "15/07/2022" "15/07/2022" "15/07/2022" "15/07/2022" ...
##  $ CLIENTE           : chr  "STABILUS 1" "STABILUS 1" "STABILUS 1" "STABILUS 1" ...
##  $ PIEZAS.PROG.      : int  20 15 20 10 10 20 10 10 10 60 ...
##  $ TMO..MIN.         : int  NA NA NA 10 10 10 10 10 11 10 ...
##  $ Laminas.procesadas: chr  "9:05" "10:05" "9:40" "11.2" ...

bd_prod3 <- bd_prod2
bd_prod3$Laminas.procesadas <- substr(bd_prod3$Laminas.procesadas, start = 1, stop = 2)
#tibble(bd_prod3)  
bd_prod3$Laminas.procesadas <- as.integer(bd_prod3$Laminas.procesadas)

## Warning: NAs introduced by coercion

str(bd_prod3) 

## 'data.frame':    5300 obs. of  5 variables:
##  $ Fecha             : chr  "15/07/2022" "15/07/2022" "15/07/2022" "15/07/2022" ...
##  $ CLIENTE           : chr  "STABILUS 1" "STABILUS 1" "STABILUS 1" "STABILUS 1" ...
##  $ PIEZAS.PROG.      : int  20 15 20 10 10 20 10 10 10 60 ...
##  $ TMO..MIN.         : int  NA NA NA 10 10 10 10 10 11 10 ...
##  $ Laminas.procesadas: int  NA 10 NA 11 12 12 2 2 NA NA ...

bd_prod3$Fecha <- as.Date(bd_prod3$Fecha, format ="%d/%m/%y")

#### Tecnica 5. Valores faltantes
bd_prod4 <- bd_prod3
bd_prod4$TMO..MIN.[is.na(bd_prod4$TMO..MIN.)]<-mean(bd_prod4$TMO..MIN., na.rm = TRUE)
summary (bd_prod4) 

##      Fecha              CLIENTE           PIEZAS.PROG.      TMO..MIN.   
##  Min.   :2020-01-08   Length:5300        Min.   :  0.00   Min.   : 0.0  
##  1st Qu.:2020-07-22   Class :character   1st Qu.: 15.00   1st Qu.:10.3  
##  Median :2020-08-19   Mode  :character   Median : 20.00   Median :10.3  
##  Mean   :2020-08-05                      Mean   : 28.18   Mean   :10.3  
##  3rd Qu.:2020-09-03                      3rd Qu.: 25.00   3rd Qu.:10.3  
##  Max.   :2020-12-09                      Max.   :800.00   Max.   :70.0  
##                                          NA's   :1496                   
##  Laminas.procesadas
##  Min.   : 0.000    
##  1st Qu.: 0.000    
##  Median : 0.000    
##  Mean   : 4.765    
##  3rd Qu.:10.000    
##  Max.   :97.000    
##  NA's   :2626

bd_prod5 <- bd_prod4
bd_prod5$PIEZAS.PROG.[is.na(bd_prod5$PIEZAS.PROG.)]<-mean(bd_prod5$PIEZAS.PROG., na.rm = TRUE)
summary (bd_prod5) 

##      Fecha              CLIENTE           PIEZAS.PROG.      TMO..MIN.   
##  Min.   :2020-01-08   Length:5300        Min.   :  0.00   Min.   : 0.0  
##  1st Qu.:2020-07-22   Class :character   1st Qu.: 15.00   1st Qu.:10.3  
##  Median :2020-08-19   Mode  :character   Median : 25.00   Median :10.3  
##  Mean   :2020-08-05                      Mean   : 28.18   Mean   :10.3  
##  3rd Qu.:2020-09-03                      3rd Qu.: 28.18   3rd Qu.:10.3  
##  Max.   :2020-12-09                      Max.   :800.00   Max.   :70.0  
##                                                                         
##  Laminas.procesadas
##  Min.   : 0.000    
##  1st Qu.: 0.000    
##  Median : 0.000    
##  Mean   : 4.765    
##  3rd Qu.:10.000    
##  Max.   :97.000    
##  NA's   :2626

bd_prod6 <- bd_prod5
bd_prod6$Laminas.procesadas[is.na(bd_prod6$Laminas.procesadas)]<-mean(bd_prod6$Laminas.procesadas, na.rm = TRUE)
summary (bd_prod6)

##      Fecha              CLIENTE           PIEZAS.PROG.      TMO..MIN.   
##  Min.   :2020-01-08   Length:5300        Min.   :  0.00   Min.   : 0.0  
##  1st Qu.:2020-07-22   Class :character   1st Qu.: 15.00   1st Qu.:10.3  
##  Median :2020-08-19   Mode  :character   Median : 25.00   Median :10.3  
##  Mean   :2020-08-05                      Mean   : 28.18   Mean   :10.3  
##  3rd Qu.:2020-09-03                      3rd Qu.: 28.18   3rd Qu.:10.3  
##  Max.   :2020-12-09                      Max.   :800.00   Max.   :70.0  
##  Laminas.procesadas
##  Min.   : 0.000    
##  1st Qu.: 0.000    
##  Median : 4.765    
##  Mean   : 4.765    
##  3rd Qu.: 4.765    
##  Max.   :97.000

Scrap

#### Técnica. Remover valores irrelevantes

#### Eliminar columnas
summary(bd_scrap)

##   Referencia           Fecha               Hora             Producto        
##  Length:250         Length:250         Length:250         Length:250        
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##     Cantidad      Unidad.de.medida   Ubicación.de.origen Ubicación.de.desecho
##  Min.   : 0.000   Length:250         Length:250          Length:250          
##  1st Qu.: 1.000   Class :character   Class :character    Class :character    
##  Median : 2.000   Mode  :character   Mode  :character    Mode  :character    
##  Mean   : 6.696                                                              
##  3rd Qu.: 7.000                                                              
##  Max.   :96.000                                                              
##     Estado         
##  Length:250        
##  Class :character  
##  Mode  :character  
##                    
##                    
## 

bd_scrap2 <- bd_scrap
bd_scrap2 <- subset (bd_scrap2, select = -c (Referencia, Hora, Producto, Unidad.de.medida, Ubicación.de.desecho, Estado))

summary (bd_scrap2)

##     Fecha              Cantidad      Ubicación.de.origen
##  Length:250         Min.   : 0.000   Length:250         
##  Class :character   1st Qu.: 1.000   Class :character   
##  Mode  :character   Median : 2.000   Mode  :character   
##                     Mean   : 6.696                      
##                     3rd Qu.: 7.000                      
##                     Max.   :96.000

#### Técnica. Convertir tipos de datos

#### Convertir de caracter a fecha
bd_scrap3 <- bd_scrap2
bd_scrap3$Fecha <- as.Date(bd_scrap3$Fecha, format ="%d/%m/%y")

# Cambiar los nombres de las variables más cortas y específicas

names(bd_scrap3) [3] = "Ubi_origen"
names(bd_scrap3)

## [1] "Fecha"      "Cantidad"   "Ubi_origen"

#### Exportar base de datos
bd_scrap4 <- bd_scrap3
write.csv(bd_scrap4, file ="scrap_FORM_limpia.csv", row.names = FALSE)

Merma

# Técnica. Remover valores irrelevantes

# Eliminar columnas
summary(bd_merma)

##     Fecha               Mes                Kilos       
##  Length:60          Length:60          Min.   :   790  
##  Class :character   Class :character   1st Qu.:  3545  
##  Mode  :character   Mode  :character   Median :  4025  
##                                        Mean   :  9271  
##                                        3rd Qu.:  4702  
##                                        Max.   :185426

bd_merma2 <- bd_merma
bd_merma2 <- subset (bd_merma2, select = -c (Mes))

# Eliminar renglones
bd_merma3 <- bd_merma2
bd_merma3 <- bd_merma3[bd_merma3$Fecha > 0, ]


# Técnica. Convertir tipos de datos

# Convertir de caracter a fecha
bd_merma4 <- bd_merma3
bd_merma4$Fecha <- as.Date(bd_merma4$Fecha, format ="%d/%m/%y")

# Exportar
bd_merma5 <- bd_merma4
write.csv(bd_merma5, file ="merma_FORM_limpia.csv", row.names = FALSE)

Delivery Performance

# Técnica 4. Convertir tipos de datos

# Convertir de caracter a fecha
bd_dper2 <- bd_dper
bd_dper2$fecha <- as.Date(bd_dper2$fecha, format ="%d/%m/%y")
library(tibble)
tibble(bd_dper2)  

## # A tibble: 52 × 3
##    fecha      cliente      dif
##    <date>     <chr>      <dbl>
##  1 2021-07-31 "PRINTEL "   4.9
##  2 2021-07-31 "MAHLE"     15.7
##  3 2021-07-31 "MAGNA"      0  
##  4 2021-07-31 "VARROC"     0  
##  5 2021-08-31 "PRINTEL "  27.7
##  6 2021-08-31 "MAHLE"     67.3
##  7 2021-08-31 "MAGNA"      0  
##  8 2021-08-31 "VARROC"     0  
##  9 2021-09-30 "PRINTEL "   8.6
## 10 2021-09-30 "MAHLE"     56.8
## # … with 42 more rows

# Cambiar los nombres de las variables más cortas y específicas

names(bd_dper2) [3] = "delay_performance"
names(bd_dper2)

## [1] "fecha"             "cliente"           "delay_performance"

# Exportar
bd_dper3 <- bd_dper2
write.csv(bd_dper3, file ="deliveryperformance_FORM_limpia.csv", row.names = FALSE)

Delivery Plan

# Técnica 4. Convertir tipos de datos

# Convertir de caracter a fecha
bd_dplan1 <- bd_dplan
bd_dplan1$Fecha<-as.Date(bd_dplan1$Fecha,format="%m/%d/%Y") 

# Contabilizar si hay NA´S dentro de la base de datos actual para sustituirlos con la media, moda o mediana.

colSums(is.na(bd_dplan1))

## ID_Fecha    Fecha  CLIENTE  Pedidos 
##        0        0        0        0

# Vemos que en la base de datos no hay NA´S 

Recursos Humanos

# Técnica. Remover valores irrelevantes
bd_rh1<-bd_rh
bd_rh1<-subset(bd_rh1,select=-c(Primer.mes,X4to.mes,Empleado,DEPARTAMENTO))
summary(bd_rh1)

##  ANO.DE.NACIMIENTO    GENERO          FECHA.DE.ALTA     PUESTO         
##  Min.   :1955      Length:104         Min.   :2010   Length:104        
##  1st Qu.:1978      Class :character   1st Qu.:2021   Class :character  
##  Median :1989      Mode  :character   Median :2022   Mode  :character  
##  Mean   :1987                         Mean   :2021                     
##  3rd Qu.:1996                         3rd Qu.:2022                     
##  Max.   :2003                         Max.   :2022                     
##  SALARIO.DIARIO.IMSS LUGAR.DE.NACIMIENTO  MUNICIPIO            ESTADO         
##  Min.   :144.4       Length:104          Length:104         Length:104        
##  1st Qu.:176.7       Class :character    Class :character   Class :character  
##  Median :180.7       Mode  :character    Mode  :character   Mode  :character  
##  Mean   :179.3                                                                
##  3rd Qu.:180.7                                                                
##  Max.   :337.1                                                                
##  ESTADO.CIVIL      
##  Length:104        
##  Class :character  
##  Mode  :character  
##                    
##                    
## 

# ¿Cuántos NA  tengo por variables? COLAB

sapply(bd_rh1,function(x) sum(is.na(x)))

##   ANO.DE.NACIMIENTO              GENERO       FECHA.DE.ALTA              PUESTO 
##                   0                   0                   0                   0 
## SALARIO.DIARIO.IMSS LUGAR.DE.NACIMIENTO           MUNICIPIO              ESTADO 
##                   0                   0                   0                   0 
##        ESTADO.CIVIL 
##                   0

# ¿Cuántos NA  tengo por variables? BAJAS
sapply(bd_bajas,function(x) sum(is.na(x)))

##     NOMBRE.COMPLETO                EDAD              GENERO       FECHA.DE.ALTA 
##                   0                   0                   0                   0 
##      MOTIVO.DE.BAJA            DURACION              PUESTO SALARIO.DIARIO.IMSS 
##                   0                   0                   0                   0 
##              ESTADO        ESTADO.CIVIL 
##                   0                   0

# No hay más valores faltantes.

# Técnica. Convertir tipos de datos

# Cambiar nombres de columnas.
# COLAB
str(bd_rh1)

## 'data.frame':    104 obs. of  9 variables:
##  $ ANO.DE.NACIMIENTO  : int  1990 1984 1984 1985 1984 1962 1966 1976 1963 1979 ...
##  $ GENERO             : chr  "FEMENINO" "MASCULINO" "FEMENINO" "MASCULINO" ...
##  $ FECHA.DE.ALTA      : int  2013 2018 2015 2016 2020 2020 2022 2022 2022 2022 ...
##  $ PUESTO             : chr  "SUPERVISORA" "MANTENIMIENTO" "COSTURERA" "AYUDANTE GENERAL" ...
##  $ SALARIO.DIARIO.IMSS: num  337 280 260 241 241 ...
##  $ LUGAR.DE.NACIMIENTO: chr  "" "" "" "" ...
##  $ MUNICIPIO          : chr  "APODACA" "APODACA" "APODACA" "APODACA" ...
##  $ ESTADO             : chr  "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" ...
##  $ ESTADO.CIVIL       : chr  "Casado" "Soltero" "Casado" "Casado" ...

names (bd_rh1) = c("edad", "genero", "alta", "puesto", "salario_diario", "lugar.nacim.","mpio","estado","civil")
names (bd_rh1)

## [1] "edad"           "genero"         "alta"           "puesto"        
## [5] "salario_diario" "lugar.nacim."   "mpio"           "estado"        
## [9] "civil"

str(bd_rh1)

## 'data.frame':    104 obs. of  9 variables:
##  $ edad          : int  1990 1984 1984 1985 1984 1962 1966 1976 1963 1979 ...
##  $ genero        : chr  "FEMENINO" "MASCULINO" "FEMENINO" "MASCULINO" ...
##  $ alta          : int  2013 2018 2015 2016 2020 2020 2022 2022 2022 2022 ...
##  $ puesto        : chr  "SUPERVISORA" "MANTENIMIENTO" "COSTURERA" "AYUDANTE GENERAL" ...
##  $ salario_diario: num  337 280 260 241 241 ...
##  $ lugar.nacim.  : chr  "" "" "" "" ...
##  $ mpio          : chr  "APODACA" "APODACA" "APODACA" "APODACA" ...
##  $ estado        : chr  "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" ...
##  $ civil         : chr  "Casado" "Soltero" "Casado" "Casado" ...

# BAJAS
str(bd_bajas)

## 'data.frame':    233 obs. of  10 variables:
##  $ NOMBRE.COMPLETO    : chr  "MARIO VALDEZ ORTIZ" "ISABEL BARRIOS MENDEZ" "MARIA ELIZABETH GOMEZ HERNANDEZ" "ALONDRA ABIGAIL ESCARCIA GOMEZ" ...
##  $ EDAD               : int  32 36 23 21 29 46 29 31 50 19 ...
##  $ GENERO             : chr  "MASCULINO" "FEMENINO" "FEMENINO" "FEMENINO" ...
##  $ FECHA.DE.ALTA      : chr  "09/03/20" "09/11/21" "10/11/21" "10/11/21" ...
##  $ MOTIVO.DE.BAJA     : chr  "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" ...
##  $ DURACION           : num  628 60 59 59 51 37 37 31 18 224 ...
##  $ PUESTO             : chr  "DISENO" "AYUDANTE GENERAL" "AYUDANTE GENERAL" "AYUDANTE GENERAL" ...
##  $ SALARIO.DIARIO.IMSS: num  500 152 152 152 152 ...
##  $ ESTADO             : chr  "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" ...
##  $ ESTADO.CIVIL       : chr  "Soltero" "Union libre" "Matrimonio" "Soltero" ...

names (bd_bajas) = c("nombre", "edad", "genero", "alta", "motivo_baja", "duracion", "puesto","salario_diario","estado","e.civil.")
names (bd_bajas)

##  [1] "nombre"         "edad"           "genero"         "alta"          
##  [5] "motivo_baja"    "duracion"       "puesto"         "salario_diario"
##  [9] "estado"         "e.civil."

str(bd_bajas)

## 'data.frame':    233 obs. of  10 variables:
##  $ nombre        : chr  "MARIO VALDEZ ORTIZ" "ISABEL BARRIOS MENDEZ" "MARIA ELIZABETH GOMEZ HERNANDEZ" "ALONDRA ABIGAIL ESCARCIA GOMEZ" ...
##  $ edad          : int  32 36 23 21 29 46 29 31 50 19 ...
##  $ genero        : chr  "MASCULINO" "FEMENINO" "FEMENINO" "FEMENINO" ...
##  $ alta          : chr  "09/03/20" "09/11/21" "10/11/21" "10/11/21" ...
##  $ motivo_baja   : chr  "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" ...
##  $ duracion      : num  628 60 59 59 51 37 37 31 18 224 ...
##  $ puesto        : chr  "DISENO" "AYUDANTE GENERAL" "AYUDANTE GENERAL" "AYUDANTE GENERAL" ...
##  $ salario_diario: num  500 152 152 152 152 ...
##  $ estado        : chr  "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" ...
##  $ e.civil.      : chr  "Soltero" "Union libre" "Matrimonio" "Soltero" ...

# Exportar
colab_final<-bd_rh1
write.csv(colab_final, file ="colab_final.csv", row.names = FALSE)

bajas_final<-bd_bajas
write.csv(bajas_final, file ="bajas_final.csv", row.names = FALSE)

bd_colab$genero[bd_colab$genero == "FEMENINO"] <- "F"
bd_colab$genero[bd_colab$genero == "MASCULINO"] <- "M"
str(bd_colab)

## 'data.frame':    104 obs. of  9 variables:
##  $ edad          : int  32 38 38 37 38 60 56 46 59 43 ...
##  $ genero        : chr  "F" "M" "F" "M" ...
##  $ alta          : int  2013 2018 2015 2016 2020 2020 2022 2022 2022 2022 ...
##  $ puesto        : chr  "SUPERVISORA" "MANTENIMIENTO" "COSTURERA" "AYUDANTE GENERAL" ...
##  $ salario_diario: num  337 280 260 241 241 ...
##  $ lugar.nacim.  : chr  "" "" "" "" ...
##  $ mpio          : chr  "APODACA" "APODACA" "APODACA" "APODACA" ...
##  $ estado        : chr  "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" ...
##  $ civil         : chr  "Casado" "Soltero" "Casado" "Casado" ...

bajas$genero[bajas$genero == "FEMENINO"] <- "F"
bajas$genero[bajas$genero == "MASCULINO"] <- "M"
str(bajas)

## 'data.frame':    233 obs. of  10 variables:
##  $ nombre        : chr  "MARIO VALDEZ ORTIZ" "ISABEL BARRIOS MENDEZ" "MARIA ELIZABETH GOMEZ HERNANDEZ" "ALONDRA ABIGAIL ESCARCIA GOMEZ" ...
##  $ edad          : int  32 36 23 21 29 46 29 31 50 19 ...
##  $ genero        : chr  "M" "F" "F" "F" ...
##  $ alta          : chr  "09/03/20" "09/11/21" "10/11/21" "10/11/21" ...
##  $ motivo_baja   : chr  "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" ...
##  $ duracion      : num  628 60 59 59 51 37 37 31 18 224 ...
##  $ puesto        : chr  "DISENO" "AYUDANTE GENERAL" "AYUDANTE GENERAL" "AYUDANTE GENERAL" ...
##  $ salario_diario: num  500 152 152 152 152 ...
##  $ estado        : chr  "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" "Nuevo Leon" ...
##  $ e.civil.      : chr  "Soltero" "Union libre" "Matrimonio" "Soltero" ...

2

Merma

Tipo de Variable y Escala de medición

Variable_merma <-c("Fecha","Mes", "Año")
Type_merma <-c("Cuantitativa (Discreta)", "Cualitativa", "Cuantitativa (Discreta)")
Medicion_merma <- c("Numero", "Empresa", "ID")
table_merma<-data.frame(Variable_merma,Type_merma,Medicion_merma)
knitr::kable(table_merma)

Variable_merma	Type_merma	Medicion_merma
Fecha	Cuantitativa (Discreta)	Numero
Mes	Cualitativa	Empresa
Año	Cuantitativa (Discreta)	ID

Estadísticos descriptivos Merma

# install.packages("psych")
library(psych)
describe(bd_merma5)

## Warning in FUN(newX[, i], ...): no non-missing arguments to min; returning Inf

## Warning in FUN(newX[, i], ...): no non-missing arguments to max; returning -Inf

##       vars  n    mean      sd median trimmed    mad min  max range  skew
## Fecha    1 50     NaN      NA     NA     NaN     NA Inf -Inf  -Inf    NA
## Kilos    2 50 3708.52 1023.99   3925 3798.65 541.15 790 6140  5350 -0.94
##       kurtosis     se
## Fecha       NA     NA
## Kilos     1.65 144.81

Variables <-c("Kilos")
Media <-c("3709.52")
Mediana <-c("3925")
Desviacion_estandar <-c("1023.99")

table2 <-data.frame(Variables, Media, Mediana, Desviacion_estandar)
knitr::kable(table2)

Variables	Media	Mediana	Desviacion_estandar
Kilos	3709.52	3925	1023.99

ggplot(bd_merma5, aes(x= Fecha, y= Kilos)) + geom_bar(stat="identity", fill="red") + scale_fill_grey() + labs(title = "Kilos de merma", x = "Fecha")

Podemos ver como en inicios de Febrero a Abril tenemos la mayor cantidad de kilos de merma, que incluso pasa del promedio de los demas meses, por lo que es importante analizar que factor hizo que durante ese periodo hubiera más merma.

bd_merma5$Fecha <- as.Date(bd_merma5$Fecha, format = "%d/%m/%Y")
plot(bd_merma5$Fecha, bd_merma5$Kilos, main = "Kilos de merma",
     xlab = "Fecha", ylab = "Kilos",
     pch = 19, frame = FALSE)

Podemos ver como hay mas dispersión en septiembre, los demás meses ha tenido en promedio la misma cantidad de merma.

Producción

Tipo de Variable y Escala de medición

Variable_prod <-c("Fecha","CLIENTE", "PIEZAS.PROG.", "TMO..MIN.")
Type_prod <-c("Cuantitativa (Discreta)", "Cualitativa", "Cuantitativa (Discreta)","Cuantitativa (Discreta)")
Medicion_prod <- c("Numero", "Empresa", "ID", "ID")
table_prod<-data.frame(Variable_prod,Type_prod,Medicion_prod)
knitr::kable(table_prod)

Variable_prod	Type_prod	Medicion_prod
Fecha	Cuantitativa (Discreta)	Numero
CLIENTE	Cualitativa	Empresa
PIEZAS.PROG.	Cuantitativa (Discreta)	ID
TMO..MIN.	Cuantitativa (Discreta)	ID

Estadísticos descriptivos Producción

Barplots

barplot(prop.table(table(bd_prod6$Laminas.procesadas)),col=c("orange"),main="Laminas procesadas",xlab = "Laminas", ylab ="Frecuencias",las=1)

Dispersion plots

plot(bd_prod6$TMO..MIN., xlab = "Proceso de lamina", ylab = "Tiempo", main = "Tiempo por Lamina" )

Scrap

Tipo de Variable y Escala de medición

Variable_scrap <-c("Fecha","Cantidad", "Ubicación.de.origen")
Type_scrap <-c("Cuantitativa (Discreta)", "Cualitativa", "Cuantitativa (Discreta)")
Medicion_scrap <- c("Numero", "Empresa", "ID")
table_scrap <-data.frame(Variable_scrap,Type_scrap,Medicion_scrap)
knitr::kable(table_scrap)

Variable_scrap	Type_scrap	Medicion_scrap
Fecha	Cuantitativa (Discreta)	Numero
Cantidad	Cualitativa	Empresa
Ubicación.de.origen	Cuantitativa (Discreta)	ID

Estadísticos descriptivos Scrap

# install.packages("psych")
library(psych)
describe(bd_scrap4)

## Warning in FUN(newX[, i], ...): no non-missing arguments to min; returning Inf

## Warning in FUN(newX[, i], ...): no non-missing arguments to max; returning -Inf

##             vars   n mean    sd median trimmed  mad min  max range  skew
## Fecha          1 250  NaN    NA     NA     NaN   NA Inf -Inf  -Inf    NA
## Cantidad       2 250 6.70 11.85      2    3.88 1.48   0   96    96  4.12
## Ubi_origen*    3 250 2.48  0.85      3    2.60 0.00   1    3     2 -1.10
##             kurtosis   se
## Fecha             NA   NA
## Cantidad       21.14 0.75
## Ubi_origen*    -0.70 0.05

Variables <-c("Cantidad" )
Media <-c("6.70" )
Mediana <-c("2" )
Desviacion_estandar <-c("11.85" )

table1 <-data.frame(Variables, Media , Mediana , Desviacion_estandar)
knitr::kable(table1)

Variables	Media	Mediana	Desviacion_estandar
Cantidad	6.70	2	11.85

Gráficas Scrap

library(plyr)
pie(prop.table(table(bd_scrap4$Ubi_origen)),col=c("lightgreen","blue","red"),main="Ubicación de origen",las=1)

hist(bd_scrap4$Cantidad, main = "Cantidad de Material reciclado", xlab = "Cantidad", ylab = "Frecuencia",col = "blue")

Este histograma nos muestra que entre 0 a 10 Toneladas es lo que mas se frecuenta a reciclar el material.

plot(bd_scrap4$Fecha, bd_scrap4$Cantidad, main = "Cantidad de Scrap por fecha", xlab = "Fecha", ylab = "Cantidad")

Podemos ver que hay ciertos días que salen fuera del promedio (que es alrededor de 0-20Toneladas) que se tiene de la cantidad de Scrap.

Delivery Performance

Tipo de Variable y Escala de medición

Variable_dp <-c("fecha","cliente", "dif")
Type_dp <-c("Cuantitativa (Discreta)", "Cualitativa", "Cuantitativa (Discreta)")
Medicion_dp <- c("Numero", "Empresa", "ID")
table_dp <-data.frame(Variable_dp,Type_dp,Medicion_dp)
knitr::kable(table_dp)

Variable_dp	Type_dp	Medicion_dp
fecha	Cuantitativa (Discreta)	Numero
cliente	Cualitativa	Empresa
dif	Cuantitativa (Discreta)	ID

Estadísticos descriptivos Delivery Performance

# install.packages("psych")
library(psych)
describe(bd_dper3)

## Warning in FUN(newX[, i], ...): no non-missing arguments to min; returning Inf

## Warning in FUN(newX[, i], ...): no non-missing arguments to max; returning -Inf

##                   vars  n  mean    sd median trimmed  mad min   max range skew
## fecha                1 52   NaN    NA     NA     NaN   NA Inf  -Inf  -Inf   NA
## cliente*             2 52  2.50  1.13    2.5    2.50 1.48   1  4.00  3.00 0.00
## delay_performance    3 52 16.07 24.63    0.0   11.88 0.00   0 71.25 71.25 1.15
##                   kurtosis   se
## fecha                   NA   NA
## cliente*             -1.42 0.16
## delay_performance    -0.33 3.42

Variables <-c("Diferencia Delivery")
Media <-c("16.07")
Mediana <-c("0")
Desviacion_estandar <-c("24.63")

table3 <-data.frame(Variables, Media, Mediana, Desviacion_estandar)
knitr::kable(table3)

Variables	Media	Mediana	Desviacion_estandar
Diferencia Delivery	16.07	0	24.63

Delivery Plan

Tipo de Variable y Escala de medición

Variable_dplan <-c("ID_Fecha","Fecha", "CLIENTE", "Pedidos")
Type_dplan <-c("Cuantitativa (Discreta)", "Cualitativa", "Cuantitativa (Discreta)", "Cuantitativa (Discreta)")
Medicion_dplan <- c("Numero", "Empresa", "ID", "ID")
table_dplan <-data.frame(Variable_dplan,Type_dplan,Medicion_dplan)
knitr::kable(table_dplan)

Variable_dplan	Type_dplan	Medicion_dplan
ID_Fecha	Cuantitativa (Discreta)	Numero
Fecha	Cualitativa	Empresa
CLIENTE	Cuantitativa (Discreta)	ID
Pedidos	Cuantitativa (Discreta)	ID

Estadísticos descriptivos Delivery Plan

mediana <- median(bd_dplan1$Pedidos, na.rm = TRUE)
mediana

## [1] 0

describe(bd_dplan1)

## Warning in FUN(newX[, i], ...): no non-missing arguments to min; returning Inf

## Warning in FUN(newX[, i], ...): no non-missing arguments to max; returning -Inf

##          vars   n    mean      sd median trimmed  mad min   max range skew
## ID_Fecha    1 228    6.50    3.46    6.5    6.50 4.45   1    12    11 0.00
## Fecha       2 228     NaN      NA     NA     NaN   NA Inf  -Inf  -Inf   NA
## CLIENTE*    3 228   10.00    5.49   10.0   10.00 7.41   1    19    18 0.00
## Pedidos     4 228 1703.14 6164.04    0.0  251.26 0.00   0 52779 52779 5.69
##          kurtosis     se
## ID_Fecha    -1.23   0.23
## Fecha          NA     NA
## CLIENTE*    -1.22   0.36
## Pedidos     37.14 408.22

Para conocer estas funciones estadísticas realizamos una descripción de la base de datos, donde podemos ver que la mediana es 0. Hay un total de 228 registros y utilizamos 4 variables para acomodo de las gráficas en donde contabilizamos el número de pedidos por mes y cliente.

Histograma general

hist(bd_dplan1$Pedidos) 

DELIVERY PLAN: PRINCIPALES CLIENTES

ggplot(bd_dplan1, aes(x=reorder(CLIENTE,Pedidos), y=Pedidos)) +
  geom_bar(stat="identity")+
  coord_flip()

DELIVERY PLAN: TOP 6 CLIENTES Y PROMEDIO

Como siguiente paso eliminaremos todos los clientes que no nos interesan para el análisis y dejaremos el top 6 de clientes para el ejercicio.

bd_dplan2 <- bd_dplan1
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="ABC QUERETARO",]
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="ANTOLIN ARTEAGA",]  
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="ANTOLIN TOLUCA",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="ISRI",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="SEGROVE",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="STB 1",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="UFI",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="YF QRO",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="INOAC POLYTEC",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="HANON",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="MERIDIAN",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="YF RAMOS",] 
bd_dplan2<-bd_dplan2[bd_dplan2$CLIENTE!="YANFENG sm",] 

ggplot(bd_dplan2,aes(x=Fecha, y=Pedidos,fill=CLIENTE))+
  geom_bar(stat="identity")+
  geom_hline(yintercept=33,linetype="dashed",color="black")+
  labs(x="Fecha",y="Número de pedidos", color="Legend")+
  ggtitle("Pedidos por fecha")

Pedidos

plot(bd_dplan2$Fecha, bd_dplan2$Pedidos, main = "Pedidos por fecha",
     xlab = "Fecha", ylab = "Pedidos",
     pch = 1, frame = FALSE)

boxplot(bd_dplan2$Pedidos, main = "Pedidos")

Como primer boxplot vimos los pedidos y la gran dispersión que hay entre pedidos, pues detectamos una frecuencia en donde hay clientes que generan pedidos obviamente diferentes como para tener una mediana o una dispersión positiva.

Clientes

Después de generar un boxplot de pedidos en general, realizamos un boxplot que nos muestra los pedidos por cliente

bd_dplan3 <- bd_dplan2
bd_dplan3$CLIENTE<-as.factor(bd_dplan3$CLIENTE)
ggplot(bd_dplan3, aes(x=CLIENTE, y=Pedidos)) + 
  geom_boxplot(color="red", fill="orange", alpha=0.2)

En el gráfico anterior podemos observar a los 6 clientes con mayor presencia en FORM en cuanto a Delivery Plan en donde el objetivo es ver la dispersión y la distribución entre cada uno y respecto a los pronósticos individuales.

El cliente HELLA es el cliente con una mayor distribución y dispersión y una mediana que genera una desviación estándar positiva. Varroc y TRMX tienen también una distribución mayor al tener la boxplot más grande, mientras que los demás; DENSO, STB3 y YFTO tienen la mayoría de sus pedidos en un mismo rango con pequeños datos fuera del boxplot presentando algunos warnings.

Se puede concluir, que HELLA es el cliente más fuerte en dicha base de datos para la empresa.

RECURSOS HUMANOS: COLABORADORES ACTUALES

# as.data.frame(bajas)
# as.data.frame(bd_colab)

bd_colab1<-bd_colab %>% dplyr::select(genero,edad,salario_diario) %>%  dplyr::group_by(genero) %>%
  dplyr::summarise(across(everything(),mean,na.rm=TRUE)) %>% arrange(desc(edad))
ggplot(bd_colab1, aes(x=reorder(genero,edad), y=edad, fill=(salario_diario))) +
  geom_bar(stat="identity",col=c("black"))+
  coord_flip()+
  guides(fill=guide_legend(reverse=FALSE))

La primera gráfica de barras nos da a conocer sobre el salario diario de las personas de Form, segmentado por edad y por género. Lo que nos da a conocer es que en la empresa existe un mayor rango de edad entre las mujeres de Form, llegando a ser casi 40 lo mayor; por otra parte, los hombres presentan un menor rango, con un máximo de (aprox) 33. Igualmente, vemos que en promedio las mujeres ganan 60 centavos más que los hombres.

ggplot(bd_colab, aes(x=genero, y=salario_diario, fill=genero)) + 
  geom_bar(stat="identity") + 
  facet_grid(~civil) + scale_fill_brewer(palette = "Set2")

Esta segunda gráfica descriptiva de los actuales colaboradores de Form, nos comunica, principalmente, el estado civil de los colaboradores por género, y su ganancia. Lo que podemos notar es que en general, las mujeres ganan más en cualquier estado civil en el que se encuentren, y en donde se puede ver una mayor variedad de la suma de los salarios es en las mujeres y los hombres que se encuentran en unión libre.

RECURSOS HUMANOS: BAJAS

bajas_1<-bajas %>% dplyr::select(motivo_baja,edad,duracion) %>% group_by(motivo_baja) %>%
  dplyr::summarise(across(everything(),mean,na.rm=TRUE)) %>% arrange(desc(edad))
ggplot(bajas_1, aes(x=reorder(motivo_baja,edad), y=edad, fill=(duracion))) +
  geom_bar(stat="identity",col=c("black"))+
  coord_flip()+
  guides(fill=guide_legend(reverse=FALSE))

Viendo ahora los colaboradores que han sido dados de baja en la empresa, vemos que la gran parte de los que se han salido de Form tienen menos de 30 años. Pocos casos han sido de jubilación, llegando a más de 60 en rango. Igualmente, a partir de la gráfica vemos que las razones principales son por abandono y baja por faltas; durando menos de 500 días en su trabajo.

ggplot(bajas, aes(x=genero, y=salario_diario, fill=genero)) + 
  geom_bar(stat="identity") + 
  facet_grid(~e.civil.) + scale_fill_brewer(palette = "Set2")

Finalmente, observamos la última gráfica descriptiva de los colaboradores que han sido dados de baja por Form. En un caso observamos que no se conoce su situación de estado civil. Igualmente, observamos que la mayor cantidad (se asume por la suma de salario diario) han sido solteros, y una gran cantidad de mujeres casadas. Por lo tanto, podemos asumir a partir de los datos que la mayoría de los que abandonan su trabajo en Form son personas solteras.

Time series plots

DISTRIBUCIÓN

ggplot(bd_dper3,aes(x=fecha, y=delay_performance,color=cliente))+
  geom_line()+
  labs(x="Fecha",y="Retraso en Minutos", color="Legend")+
  ggtitle("Retrasos en el desempeño por parte del cliente")

bd_dper3<-bd_dper3[bd_dper3$cliente!="Magna",]
bd_dper3<-bd_dper3[bd_dper3$cliente!="Varroc",]

ggplot(bd_dper3,aes(x=fecha, y=delay_performance,fill=cliente))+
  geom_bar(stat="identity")+
  geom_hline(yintercept=33,linetype="dashed",color="black")+
  labs(x="Fecha",y="Retraso en minutos", color="Legend")+
  ggtitle("Retrasos en el desempeño por parte del cliente")

A pesar de que esta diminuyendo el retraso con el cliente Mahle seguimos viendo que se encuentra por arriba del promedio.

Hallazgos

1. Nuestro top 3 clientes de producción son STABILUS 1, STABILUS 3 y TRMX.

2. Traemos un retraso mayor en distribución con el cliente Mahle, arriba del promedio llegando incluso a tiempos de 1 hora con 40 minutos.

3. Se tienen sobrepedidos (arriba del promedio) y esto puede afectar si no se tienen la capacidad para recibir pedidos de más.

4. Dentro de RH tenemos más bajas por distintos motivos: en primer lugar esta por Jubilación, en segundo lugar Renuncia voluntaria y en tercer lugar Baja por Faltas.

Predicción del Desempeño de la Industria Automotriz

Se cambian los nombres de las columnas.

names (bd_auto) = c("año", "prod_total", "prod_passenger", "prod_veh_comerciales", "ventas_domesticas", "ventas_passenger","ventas_comerciales","desempleo_usa","confianza_cons_usa","salario_hora_min_usa")
names (bd_auto)

##  [1] "año"                  "prod_total"           "prod_passenger"      
##  [4] "prod_veh_comerciales" "ventas_domesticas"    "ventas_passenger"    
##  [7] "ventas_comerciales"   "desempleo_usa"        "confianza_cons_usa"  
## [10] "salario_hora_min_usa"

str(bd_auto)

## 'data.frame':    14 obs. of  10 variables:
##  $ año                 : int  2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 ...
##  $ prod_total          : num  10752 8672 5710 7744 8662 ...
##  $ prod_passenger      : num  3867 3731 2196 2732 2978 ...
##  $ prod_veh_comerciales: num  6885 4941 3514 5012 5685 ...
##  $ ventas_domesticas   : num  12687 10108 7868 9020 10109 ...
##  $ ventas_passenger    : num  5197 4491 3558 3792 4146 ...
##  $ ventas_comerciales  : num  7490 5617 4309 5229 5963 ...
##  $ desempleo_usa       : num  4.62 5.8 9.28 9.61 8.93 8.08 7.36 6.16 5.28 4.88 ...
##  $ confianza_cons_usa  : num  85.6 63.8 66.3 71.8 67.3 ...
##  $ salario_hora_min_usa: num  5.5 6.2 6.9 7.25 7.25 7.25 7.25 7.25 7.25 7.25 ...

Primer modelo de regresión

En este caso, se escoge como variable dependiente las ventas de los carros passenger, por ello entiéndase los automóviles de uso cotidiano en Estados Unidos. Para esta variable dependiente, se han tomado las siguientes variables independientes, con el fin de notar su efecto en las ventas. Estas son:

1. Desempleo USA: este índice es calculado anualmente con la formula. (Unemployed ÷ Labor Force) x 100. Entre menor mejor.

2. Confianza del consumidor de USA: índice que mide, a partir de una encuesta que tan optimistas o pesimistas se encuentran los consumidores sobre su situación financiera. Entre mayor, mejor.

3. Salario mínimo por hora: se mide en dólares. Está establecido a nivel federal.

4. Año: los años que se tienen de los datos, 2007-2020.

regresion1 <- lm (ventas_passenger ~ desempleo_usa + confianza_cons_usa + salario_hora_min_usa + año, data=bd_auto)
summary (regresion1)

## 
## Call:
## lm(formula = ventas_passenger ~ desempleo_usa + confianza_cons_usa + 
##     salario_hora_min_usa + año, data = bd_auto)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -850.29 -560.86   88.28  446.55  847.47 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)   
## (Intercept)          646180.04  197959.50   3.264  0.00977 **
## desempleo_usa          -255.04     217.62  -1.172  0.27129   
## confianza_cons_usa       46.68      41.57   1.123  0.29062   
## salario_hora_min_usa   1394.06     697.08   2.000  0.07657 . 
## año                    -324.65     100.49  -3.231  0.01031 * 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 712.5 on 9 degrees of freedom
## Multiple R-squared:  0.5831, Adjusted R-squared:  0.3978 
## F-statistic: 3.147 on 4 and 9 DF,  p-value: 0.0707

Para la tasa de desempleo y el índice de confianza del consumidor, se ha decidido tomar el promedio del 2007 al 2020, para poder predecir. Con el salario mínimo por hora, al ser establecido a nivel federal, se toma en cuenta la última cantidad: $7.25 dólares. Se quieren las predicciones para los siguientes cinco años, a partir del último año con datos (2020).

datos_nuevos1 <- data.frame(desempleo_usa=6.43,confianza_cons_usa=82.3,salario_hora_min_usa=7.25,año=2021:2025)
predict(regresion1,datos_nuevos1)

##        1        2        3        4        5 
## 2369.905 2045.254 1720.604 1395.954 1071.303

¿Qué observamos?

modelo1 <- plot(predict(regresion1,datos_nuevos1), type = "l", xlab = "Año",  ylab ="Ventas Passenger",  main="Predicción de Ventas")

En esta predicción de ventas de automóviles passenger, observamos que es hacia abajo. Es decir, tomando en cuenta una tasa de desempleo de 6.43, un índice de confianza de 82.3 y el salario mínimo por hora de $7.25, se espera que las ventas de estos automóviles bajen en EUA del 2021 hasta 2025. Igualmente, resulta destacable mencionar que las variables que más impactan en las ventas de automóviles passenger son el año y el salario mínimo.

effect_plot(regresion1,pred=desempleo_usa,interval=TRUE)

Si tomamos en cuenta la tasa de desempleo de EUA, y su relación con las ventas de los automóviles passenger, observamos que esta es negativa. Debido a que al crecer la tasa de desempleo, bajan las ventas.

effect_plot(regresion1,pred=confianza_cons_usa,interval=TRUE)

Mientras que el índice de confianza del consumidor de EUA, y su relación con las ventas de los automóviles passenger, observamos que esta es positiva. Debido a que al crecer la confianza, incrementan las ventas.

effect_plot(regresion1,pred=salario_hora_min_usa,interval=TRUE)

Igualmente, al subir el salario mínimo por hora, las ventas de los automóviles passenger incrementan.

effect_plot(regresion1,pred=año,interval=TRUE)

Con el pasar de los años las ventas han decrecido.

Segundo modelo de regresión

En este caso, se escoge como variable dependiente las ventas de los carros comerciales, por ello entiéndase los cualquier tipo de vehículo de motor utilizado para transportar mercancías o pasajeros en Estados Unidos. Para esta variable dependiente, se han tomado las siguientes variables independientes, con el fin de notar su efecto en las ventas. Estas son:
1. Desempleo USA: este índice es calculado anualmente con la formula. (Unemployed ÷ Labor Force) x 100. Entre menor mejor.
2. Confianza del consumidor de USA: índice que mide, a partir de una encuesta que tan optimistas o pesimistas se encuentran los consumidores sobre su situación financiera. Entre mayor, mejor.
3. Salario mínimo por hora: se mide en dólares. Está establecido a nivel federal.
4. Año: los años que se tienen de los datos, 2007-2020.

regresion2 <- lm (ventas_comerciales ~ desempleo_usa + confianza_cons_usa + salario_hora_min_usa + año, data=bd_auto)
summary (regresion2)

## 
## Call:
## lm(formula = ventas_comerciales ~ desempleo_usa + confianza_cons_usa + 
##     salario_hora_min_usa + año, data = bd_auto)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -731.58  -87.12   57.56  160.03  513.82 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          -588817.41   97672.75  -6.028 0.000196 ***
## desempleo_usa           -147.24     107.37  -1.371 0.203504    
## confianza_cons_usa        50.55      20.51   2.464 0.035896 *  
## salario_hora_min_usa    -839.15     343.94  -2.440 0.037374 *  
## año                      297.49      49.58   6.000 0.000203 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 351.6 on 9 degrees of freedom
## Multiple R-squared:  0.9732, Adjusted R-squared:  0.9613 
## F-statistic: 81.82 on 4 and 9 DF,  p-value: 4.516e-07

Para la tasa de desempleo y el índice de confianza del consumidor, se ha decidido tomar el promedio del 2007 al 2020, para poder predecir. Con el salario mínimo por hora, al ser establecido a nivel federal, se toma en cuenta la última cantidad: $7.25 dólares. Se quieren las predicciones para los siguientes cinco años, a partir del último año con datos (2020).

datos_nuevos2 <- data.frame(desempleo_usa=6.43,confianza_cons_usa=82.3,salario_hora_min_usa=7.25,año=2021:2025)
predict(regresion2,datos_nuevos2)

##         1         2         3         4         5 
##  9547.780  9845.274 10142.768 10440.262 10737.756

¿Qué observamos?

modelo2 <- plot(predict(regresion2,datos_nuevos2), type = "l", xlab = "Año",  ylab ="Ventas Comerciales",  main="Predicción de Ventas")

En esta predicción de ventas de automóviles comerciales, observamos que es hacia arriba Es decir, tomando en cuenta una tasa de desempleo de 6.43, un índice de confianza de 82.3 y el salario mínimo por hora de $7.25, se espera que las ventas de estos automóviles suban en EUA del 2021 hasta 2025. En el caso de las ventas de automóviles comerciales, notamos que el pasar de los años es la variable que más impacta, siguiendo por el nivel de confianza del consumidor y el salario mínimo por hora; mientras que el que menos afecta es la tasa de desempleo.

effect_plot(regresion2,pred=desempleo_usa,interval=TRUE)

Si tomamos en cuenta la tasa de desempleo de EUA, y su relación con las ventas de los automóviles comerciales, observamos que esta es negativa. Debido a que al crecer la tasa de desempleo, bajan las ventas.

effect_plot(regresion2,pred=confianza_cons_usa,interval=TRUE)

Mientras que el índice de confianza del consumidor de EUA, y su relación con las ventas de los automóviles comerciales, observamos que esta es positiva. Debido a que al crecer la confianza, incrementan las ventas. A comparación de la gráfica de ventas passenger con el nivel de confianza, observamos que en este caso la pendiente es más pronunciada, por lo que vemos un mayor impacto.

effect_plot(regresion2,pred=salario_hora_min_usa,interval=TRUE)

Igualmente, al subir el salario mínimo por hora, las ventas de los automóviles comerciales disminuyen. Este podría ser un tema interesante a investigar.

effect_plot(regresion2,pred=año,interval=TRUE)

Con el pasar de los años las ventas han incrementado.

Pronóstico del Desempeño de la Industria Automotriz y la empresa FORM

Pronóstico Industria Automotriz USA

plot(bd_auto$año,bd_auto$prod_veh_comerciales, type="l",col="blue", lwd=1.5, xlab ="Year",ylab ="Thousands of Units", main = "Annual U.S. Motor Vehicle Sales")
lines(bd_auto$año,bd_auto$ventas_comerciales,col="red",lty=3)
legend("topleft", legend=c("Domestic Commercial Sales", "Production Commercial Vehicles"),
       col=c("blue", "red"), lty = 1:2, cex=0.8)

### Pronóstico Industria Automotriz México

Exportar base de datos

bd_externaMX <- read.csv("/Users/isaacdiazruizdechavez/Downloads/industria_automotriz_mx.csv")

Predicción del Desempeño de la Industria Automotriz en México

Primer modelo de regresión

mx_regresion1 <- lm (unidades_produccion ~ unidades_exportacion + año, data=bd_externaMX)
summary (mx_regresion1)

## 
## Call:
## lm(formula = unidades_produccion ~ unidades_exportacion + año, 
##     data = bd_externaMX)
## 
## Residuals:
##      1      2      3      4      5 
##  32786 -40083  15888 -42671  34080 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)  
## (Intercept)           2.228e+08  5.666e+07   3.933   0.0590 .
## unidades_exportacion  8.527e-01  1.180e-01   7.223   0.0186 *
## año                  -1.099e+05  2.792e+04  -3.937   0.0589 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 54390 on 2 degrees of freedom
## Multiple R-squared:  0.9933, Adjusted R-squared:  0.9866 
## F-statistic: 148.2 on 2 and 2 DF,  p-value: 0.006703

Como resultado de la regresión podemos ver que existe una significancia de 0.05 con la variable de exportación en unidades vehiculares y lo que nos dice el modelo esque si aumenta la producción como tenemos el ‘Estimate’ positivo quiere decir que igualmente la exportación aumenta, pero después podemos ver que en año hay una tendencia negativa diciéndonos que decrece con el año. El modelo tiene una R² de 0.98 teniendo un buen nivel de confianza.

Ahora graficaremos nuestra regresión, para las unidades de exportación se ha decidido tomar el media del 2017 al 2021 (3,096,421). Se quieren las predicciones para los siguientes cinco años, a partir del último año con datos (2021).

datos_nuevos1 <- data.frame(unidades_exportacion=3096421,año=2022:2026)
predict(mx_regresion1,datos_nuevos1)

##       1       2       3       4       5 
## 3216556 3106643 2996729 2886816 2776902

¿Qué observamos?

prediccionmx1 <- plot(predict(mx_regresion1,datos_nuevos1), type = "l", xlab = "Año",  ylab ="Exportaciones",  main="Predicción de Exportaciones")

En esta predicción exportaciones de automoviles, observamos que es hacia abajo. Es decir, se espera que las exportaciones de los automóviles bajen en México del 2022 hasta 2026.

Segundo modelo de regresión

mx_regresion2 <- lm (unidades_ventas ~ desempleo + año, data=bd_externaMX)
summary (mx_regresion2)

## 
## Call:
## lm(formula = unidades_ventas ~ desempleo + año, data = bd_externaMX)
## 
## Residuals:
##      1      2      3      4      5 
##  25338 -28279  -1471 -13570  17983 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)  
## (Intercept) 163028739   32739329   4.980   0.0380 *
## desempleo     -281802      50603  -5.569   0.0308 *
## año            -79602      16291  -4.886   0.0394 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 31240 on 2 degrees of freedom
## Multiple R-squared:  0.9926, Adjusted R-squared:  0.9851 
## F-statistic: 133.5 on 2 and 2 DF,  p-value: 0.007435

Como resultado de la regresión podemos ver que existe una significancia de 0.05 con la variable desempleo y año, teniendo una tendencia negativa en ambas, lo que quiere decir que si aumentan las ventas disminuye el desempleo y que con el paso de los años las ventas igual disminuyen. El modelo tiene una R² de 0.98 teniendo un buen nivel de confianza.

Ahora graficaremos nuestra regresión, para desempleo se ha decidido tomar la media del 2017 al 2021 (3.77). Se quieren las predicciones para los siguientes cinco años, a partir del último año con datos (2021).

datos_nuevos2 <- data.frame(desempleo=3.77, año=2022:2026)
predict(mx_regresion2,datos_nuevos2)

##         1         2         3         4         5 
## 1010144.2  930541.7  850939.2  771336.8  691734.3

¿Qué observamos?

prediccionmx2 <- plot(predict(mx_regresion2,datos_nuevos2), type = "l", xlab = "Año",  ylab ="Ventas",  main="Predicción de Ventas")

Con el modelo podemos ver como tenemos la tendencia negativa decreciendo las ventas.

Pronóstico Moving Average

summary(ma_model<-arma(bd_auto$prod_total,order=c(0,1)))

## 
## Call:
## arma(x = bd_auto$prod_total, order = c(0, 1))
## 
## Model:
## ARMA(0,1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3425.7 -1313.0   141.6  1100.1  1449.5 
## 
## Coefficient(s):
##            Estimate  Std. Error  t value Pr(>|t|)    
## ma1       6.756e-01   1.610e-01    4.195 2.73e-05 ***
## intercept 1.010e+04   6.096e+02   16.569  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Fit:
## sigma^2 estimated as 2094390,  Conditional Sum-of-Squares = 25229390,  AIC = 247.5

ma_model_forecast<-forecast(ma_model$fitted,h=3,level=c(95))
ma_model_forecast

##    Point Forecast    Lo 95    Hi 95
## 15       10455.67 8568.350 12342.99
## 16       10455.67 8438.084 12473.26
## 17       10455.67 8315.732 12595.61

Pronóstico Producción FORM

plot(bd_dper3$fecha,bd_dper3$delay_performance, type="l",col="blue", lwd=1.5, xlab ="Fecha",ylab ="Piezas programadas", main = "Piezas programadas por fecha")
legend("topleft", legend=c("Piezas programadas", "Laminas procesadas"),
       col=c("blue", "red"), lty = 1:2, cex=0.8)

(ma_model<-arma(bd_dper3$delay_performance,order=c(0,1)))

## 
## Call:
## arma(x = bd_dper3$delay_performance, order = c(0, 1))
## 
## Coefficient(s):
##       ma1  intercept  
##   -0.5914    16.6744

ma_model_forecast<-forecast(ma_model$fitted,h=3,level=c(95))
ma_model_forecast

##    Point Forecast     Lo 95    Hi 95
## 53       16.46733 -9.469107 42.40377
## 54       16.46733 -9.469107 42.40377
## 55       16.46733 -9.469107 42.40377

Pronóstico Merma FORM

# Sumar el Total de KilosxMes
merma <- c(14560,22830,22470,18820,23410,18280,19370,32100,13586)

merma_st <- ts(data = merma, start = c(2022,1), frequency = 12)
merma_st

##        Jan   Feb   Mar   Apr   May   Jun   Jul   Aug   Sep
## 2022 14560 22830 22470 18820 23410 18280 19370 32100 13586

modelo <- auto.arima(merma_st)
modelo

## Series: merma_st 
## ARIMA(0,0,0) with non-zero mean 
## 
## Coefficients:
##            mean
##       20602.889
## s.e.   1736.893
## 
## sigma^2 = 30544665:  log likelihood = -89.8
## AIC=183.59   AICc=185.59   BIC=183.99

pronostico <- forecast(modelo, level=c(95), h=3)
pronostico

##          Point Forecast    Lo 95    Hi 95
## Oct 2022       20602.89 9770.711 31435.07
## Nov 2022       20602.89 9770.711 31435.07
## Dec 2022       20602.89 9770.711 31435.07

plot(pronostico)