#Cambios previos en Excel: Se traspuso la base de datos de forma vertical
#file.choose()
performance <- read.csv("/Users/Karen/Downloads/FORM - Delivery Performance.csv")
#install.packages("foreign")
library(foreign)
#install.packages("dplyr")
library(dplyr) # data manipulation
#install.packages("forcats")
library(forcats) # to work with categorical variables
#install.packages ("janitor")
library(janitor) # data exploration and cleaning
#install.packages("Hmisc")
library(Hmisc) # several useful functions for data analysis
#install.packages ("psych")
library(psych) # functions for multivariate analysis
#install.packages("naniar")
library(naniar) # summaries and visualization of missing values NAs
#install.packages("dlookr")
library(dlookr) # summaries and visualization of missing values NAs
#install.packages ("kableExtra")
library(kableExtra)
library(readr)
#install.packages ("corrplot")
library(corrplot)
#install.packages ("jtools")
library(jtools)
#install.packages ("lmtest")
library(lmtest)
#install.packages ("car")
library(car)
#install.packages ("olsrr")
library(olsrr)
#install.packages ("gmodels")
library(gmodels)
¿Cuantas variables y cuantos registros tiene la base de datos?
8 variables y 1440 registros
#Variables
str (performance)
## 'data.frame': 1440 obs. of 8 variables:
## $ Target : int 1 1 1 1 1 1 1 1 1 1 ...
## $ Cliente : chr "PRINTEL " "MAHLE" "MAHLE" "MAHLE" ...
## $ Vueltas : int 1 1 2 3 1 1 2 3 1 1 ...
## $ Plan.arrival : num 16 8 9 20 0 0 0 0 16 8 ...
## $ Real.arrival : num 16 8 9 20 0 0 0 0 16 8 ...
## $ Real.departure: num 19.3 8.55 10 21 0 0 0 0 18.1 9 ...
## $ Diference : num 3.3 0.55 1 1 0 0 0 0 2.1 1 ...
## $ Date : chr "02/01/22" "02/01/22" "02/01/22" "02/01/22" ...
summary (performance)
## Target Cliente Vueltas Plan.arrival
## Min. :1 Length:1440 Min. :1.00 Min. : 0.000
## 1st Qu.:1 Class :character 1st Qu.:1.00 1st Qu.: 0.000
## Median :1 Mode :character Median :1.50 Median : 4.000
## Mean :1 Mean :1.75 Mean : 6.625
## 3rd Qu.:1 3rd Qu.:2.25 3rd Qu.:10.750
## Max. :1 Max. :3.00 Max. :20.000
## Real.arrival Real.departure Diference Date
## Min. : 0.000 Min. : 0.000 Min. :-14.3500 Length:1440
## 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.: 0.0000 Class :character
## Median : 0.000 Median : 0.000 Median : 0.0000 Mode :character
## Mean : 3.823 Mean : 4.142 Mean : 0.3155
## 3rd Qu.: 8.000 3rd Qu.: 9.000 3rd Qu.: 0.8000
## Max. :23.500 Max. :24.500 Max. : 20.0000
variable <- c("`Target`","`Cliente`","`Vueltas`","`Plan.arrival`","`Real.arrival`","`Plan.departure`","`Diference`","`Date`")
tipo <- c("cuantitativo (discreto)", "cualitativo", "cuantitativo (discreto)", "cuantitativo (continuo)", "cuantitativo (continuo)", "cuantitativo (continuo)", "cuantitativo (continuo)", "cualitativo")
table <- data.frame (variable, tipo)
knitr::kable(table)
| variable | tipo |
|---|---|
Target
|
cuantitativo (discreto) |
Cliente
|
cualitativo |
Vueltas
|
cuantitativo (discreto) |
Plan.arrival
|
cuantitativo (continuo) |
Real.arrival
|
cuantitativo (continuo) |
Plan.departure
|
cuantitativo (continuo) |
Diference
|
cuantitativo (continuo) |
Date
|
cualitativo |
variables <- c("`Target`","`Cliente`","`Vueltas`","`Plan.arrival`","`Real.arrival`","`Plan.departure`","`Diference`","`Date`")
tipos <- c("cuantitativo (discreto) ", "cualitativo ", "cuantitativo (discreto) ", "cuantitativo (continuo) ", "cuantitativo (continuo) ", "cuantitativo (continuo) ", "cuantitativo (continuo) ", "cualitativo ")
escalas <- c("intervalo", "nominal", "razon", "razon", "razon", "razon", "razon", "ordinal")
table1 <- data.frame (variables, tipos, escalas)
knitr::kable(table1)
| variables | tipos | escalas |
|---|---|---|
Target
|
cuantitativo (discreto) | intervalo |
Cliente
|
cualitativo | nominal |
Vueltas
|
cuantitativo (discreto) | razon |
Plan.arrival
|
cuantitativo (continuo) | razon |
Real.arrival
|
cuantitativo (continuo) | razon |
Plan.departure
|
cuantitativo (continuo) | razon |
Diference
|
cuantitativo (continuo) | razon |
Date
|
cualitativo | ordinal |
#Tecnica 1. Remover valores irrelevantes
#Eliminar columnas
performance <-subset (performance, select =-c(Target))
#Tecnica 2. Convertir tipos de datos
#Se realizó esta tecnica debido a que la base de datos provee los estimados de entrega para los diferentes clientes, por lo que es sumamente importante mantener las fechas con su respectivo tipo de variable
#Cambiar de caracter a fecha
performance$Date <-as.Date(performance$Date,format ="%d/%m/%Y")
tibble(performance)
## # A tibble: 1,440 × 7
## Cliente Vueltas Plan.arrival Real.arrival Real.depart…¹ Difer…² Date
## <chr> <int> <dbl> <dbl> <dbl> <dbl> <date>
## 1 "PRINTEL " 1 16 16 19.3 3.3 0022-01-02
## 2 "MAHLE" 1 8 8 8.55 0.55 0022-01-02
## 3 "MAHLE" 2 9 9 10 1 0022-01-02
## 4 "MAHLE" 3 20 20 21 1 0022-01-02
## 5 "MAGNA" 1 0 0 0 0 0022-01-02
## 6 "VARROC" 1 0 0 0 0 0022-01-02
## 7 "VARROC" 2 0 0 0 0 0022-01-02
## 8 "VARROC" 3 0 0 0 0 0022-01-02
## 9 "PRINTEL " 1 16 16 18.1 2.1 0022-01-03
## 10 "MAHLE" 1 8 8 9 1 0022-01-03
## # … with 1,430 more rows, and abbreviated variable names ¹​Real.departure,
## # ²​Diference
#Tecnica 3. Valores faltantes
#Se realizó esta tecnica con la finalidad de conocer si en la base de datos existen NA o similares que no sean validos para la información de los registros
#¿Tenemos NA en la base de datos?
sum(is.na(performance))
## [1] 0
#¿Tenemos NA por variable?
sapply(performance,function(x)sum(is.na(x)))
## Cliente Vueltas Plan.arrival Real.arrival Real.departure
## 0 0 0 0 0
## Diference Date
## 0 0
#En caso de tener, borrar los registros NA
performance <- na.omit(performance)
summary(performance)
## Cliente Vueltas Plan.arrival Real.arrival
## Length:1440 Min. :1.00 Min. : 0.000 Min. : 0.000
## Class :character 1st Qu.:1.00 1st Qu.: 0.000 1st Qu.: 0.000
## Mode :character Median :1.50 Median : 4.000 Median : 0.000
## Mean :1.75 Mean : 6.625 Mean : 3.823
## 3rd Qu.:2.25 3rd Qu.:10.750 3rd Qu.: 8.000
## Max. :3.00 Max. :20.000 Max. :23.500
## Real.departure Diference Date
## Min. : 0.000 Min. :-14.3500 Min. :0022-01-02
## 1st Qu.: 0.000 1st Qu.: 0.0000 1st Qu.:0022-02-23
## Median : 0.000 Median : 0.0000 Median :0022-04-17
## Mean : 4.142 Mean : 0.3155 Mean :0022-04-16
## 3rd Qu.: 9.000 3rd Qu.: 0.8000 3rd Qu.:0022-06-08
## Max. :24.500 Max. : 20.0000 Max. :0022-07-23
## <span style="Color:#FF7F50"> Exportar base de datos
#write.csv(performance,file="FORM.Performance.limpia",row.names=FALSE)
Despues de evaluar brevemente la base de datos, se pueden observar las distintas variables en donde se muestra el desempeño de las entregas para los diversos clientes que tiene FORM, evaluando un estimado de llegada por fecha, la llegada real y la salida real de la producción; visualizando de esta forma, la diferencia vs lo estimado.
En la tabla se presentan los datos estadisticos descriptivos de las diversas variables de la base, donde se puede observar que el promedio de las vueltas es de 1.75, mostrando un indicador adecuado respecto a las entregas de los pedidos.
Respecto al performance directo de los pedidos, la llegada planeada tiene un promedio de 6.6, la llegada real de 3.8 y la salida real de 4.4; mostrando que el estimado de la llegada es mayor que lo que realmente esta pasando en la empresa.
La diferencia es una variable que relaciona la variacion entre la entrada y salida real de los pedidos, mostrando un promedio de 0.316, por lo que no indica alguna preocupacion evidente.
describe (performance)
## # A tibble: 5 × 26
## described_…¹ n na mean sd se_mean IQR skewn…² kurto…³ p00 p01
## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Vueltas 1440 0 1.75 0.829 0.0219 1.25 0.494 -1.37 1 1
## 2 Plan.arrival 1440 0 6.62 7.50 0.198 10.8 0.614 -1.12 0 0
## 3 Real.arrival 1440 0 3.82 6.51 0.171 8 1.51 0.965 0 0
## 4 Real.depart… 1440 0 4.14 6.95 0.183 9 1.44 0.706 0 0
## 5 Diference 1440 0 0.316 0.922 0.0243 0.8 2.73 211. -14.4 0
## # … with 15 more variables: p05 <dbl>, p10 <dbl>, p20 <dbl>, p25 <dbl>,
## # p30 <dbl>, p40 <dbl>, p50 <dbl>, p60 <dbl>, p70 <dbl>, p75 <dbl>,
## # p80 <dbl>, p90 <dbl>, p95 <dbl>, p99 <dbl>, p100 <dbl>, and abbreviated
## # variable names ¹​described_variables, ²​skewness, ³​kurtosis
Se realizó una tabla de frecuencia de la variable plan arrival con el objetivo de validar las frecuencias en el estimado de llegada para cada uno de los clientes.
proportion <- prop.table(table(performance$Cliente,performance$Plan.arrival))
proportion %>%
kbl() %>%
kable_styling()
| 0 | 8 | 9 | 16 | 20 | |
|---|---|---|---|---|---|
| MAGNA | 0.125 | 0.000 | 0.000 | 0.000 | 0.000 |
| MAHLE | 0.000 | 0.125 | 0.125 | 0.000 | 0.125 |
| PRINTEL | 0.000 | 0.000 | 0.000 | 0.125 | 0.000 |
| VARROC | 0.375 | 0.000 | 0.000 | 0.000 | 0.000 |
Posterior a la tabla de frecuencia, se realizó una tabla cruzada donde se visualizo como es la proporcion respecto a la variable de las estimaciones de llegada de pedidos por cada cliente.
proportion %>%
kbl() %>%
kable_material (c("striped","hover"))
| 0 | 8 | 9 | 16 | 20 | |
|---|---|---|---|---|---|
| MAGNA | 0.125 | 0.000 | 0.000 | 0.000 | 0.000 |
| MAHLE | 0.000 | 0.125 | 0.125 | 0.000 | 0.125 |
| PRINTEL | 0.000 | 0.000 | 0.000 | 0.125 | 0.000 |
| VARROC | 0.375 | 0.000 | 0.000 | 0.000 | 0.000 |
location <- CrossTable(performance$Cliente, performance$Plan.arrival, prop.t=TRUE, prop.r=TRUE, prop.c=TRUE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 1440
##
##
## | performance$Plan.arrival
## performance$Cliente | 0 | 8 | 9 | 16 | 20 | Row Total |
## --------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## MAGNA | 180 | 0 | 0 | 0 | 0 | 180 |
## | 90.000 | 22.500 | 22.500 | 22.500 | 22.500 | |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.125 |
## | 0.250 | 0.000 | 0.000 | 0.000 | 0.000 | |
## | 0.125 | 0.000 | 0.000 | 0.000 | 0.000 | |
## --------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## MAHLE | 0 | 180 | 180 | 0 | 180 | 540 |
## | 270.000 | 187.500 | 187.500 | 67.500 | 187.500 | |
## | 0.000 | 0.333 | 0.333 | 0.000 | 0.333 | 0.375 |
## | 0.000 | 1.000 | 1.000 | 0.000 | 1.000 | |
## | 0.000 | 0.125 | 0.125 | 0.000 | 0.125 | |
## --------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## PRINTEL | 0 | 0 | 0 | 180 | 0 | 180 |
## | 90.000 | 22.500 | 22.500 | 1102.500 | 22.500 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.125 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.125 | 0.000 | |
## --------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## VARROC | 540 | 0 | 0 | 0 | 0 | 540 |
## | 270.000 | 67.500 | 67.500 | 67.500 | 67.500 | |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.375 |
## | 0.750 | 0.000 | 0.000 | 0.000 | 0.000 | |
## | 0.375 | 0.000 | 0.000 | 0.000 | 0.000 | |
## --------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Column Total | 720 | 180 | 180 | 180 | 180 | 1440 |
## | 0.500 | 0.125 | 0.125 | 0.125 | 0.125 | |
## --------------------|-----------|-----------|-----------|-----------|-----------|-----------|
##
##
kbl(location) %>%
kable_classic()
|
|
|
|
Real arrival
En la siguiente grafica se puede observar el desempeño de las llegadas reales de los pedidos por cliente, validando que MAHLE es el que tiene mayor promedio, siendo este mayor a 8; manteniendo un filtro de color que indican las vueltas en la logistica, siendo de 2 para MAHLE.
Realarrival<-performance %>% select(Cliente,Real.arrival,Vueltas) %>% group_by(Cliente) %>% summarise(across(everything(),mean,na.rm=TRUE)) %>% arrange(desc(Real.arrival))
ggplot(Realarrival, aes(x=reorder(Cliente, Real.arrival), y=Real.arrival, fill=(Vueltas))) +
geom_bar(stat="identity")+
coord_flip()+
guides(fill=guide_legend(reverse=FALSE))
Real departure
En la siguiente grafica se observa el desempeño de las salidas reales de los pedidos por cliente, validando que MAHLE tambien es el cliente que tiene mayor promedio, siendo este cercano a 10; con un filtro de color que indica las vueltas en la logistica, siendo de 2 para MAHLE.
Realdeparture<-performance %>% select(Cliente,Real.departure,Vueltas) %>% group_by(Cliente) %>% summarise(across(everything(),mean,na.rm=TRUE)) %>% arrange(desc(Real.departure))
ggplot(Realdeparture, aes(x=reorder(Cliente, Real.departure), y=Real.departure, fill=(Vueltas))) +
geom_bar(stat="identity")+
coord_flip()+
guides(fill=guide_legend(reverse=FALSE))
En dicha grafica de boxplot se presenta como se encuentran posicionados los datos de la base, tanto el estimado (Plan arrival), como la llegada real (real arrival) y la salida real (real departure) de los pedidos realizados por todos los clientes
Delivery <- data.frame(performance$Cliente, performance$Plan.arrival, performance$Real.arrival, performance$Real.departure, performance$Date)
colnames(Delivery)<-c('Cliente', 'Plan.arrival', 'Real.arrival', 'Real.departure', 'Date')
Realarrival_boxplot = subset(Delivery, select =-c (Cliente, Date))
boxplot(Realarrival_boxplot,data=data,main="Deliverys",
col=rainbow (ncol(trees)))
Validando las diversas variables en la base de datos y observando su distribucion, se decidio utilizar la variable de diferencia (entre la llegada real y la salida real) para observar su comportamiento y ver la comparación.
#Histograma
hist(performance$Diference,main="Histograma",xlab="Delivery diference",col='#FF7F24')
#Diagrama de dispersion
qqnorm(performance$Diference, main="Grafica de dispersion", ylab="Delivery diference",col='#FF7F24')
qqline(performance$Diference, col='#FF7F24')
#Graficos de normalidad
plot_normality(performance,Diference, col='#FF7F24')
A modo de validar en el tiempo, se realizó un time series plot donde se visualizó el desempeño tanto del plan arrival (estimado), como del real arrival, observando que existe una variacion sobre todo en Febrero- Marzo del 2022.
ggplot(performance,aes(x=Date))+
geom_point(aes(y=Plan.arrival),color="#4169E1")+
geom_point(aes(y=Real.arrival),color="#FF7F24")+
labs(x="2022",y="Llegadas")+
ggtitle("Llegadas planeadas y reales de pedidos")
Al validar la base de performance de los pedidos, se pudieron encontrar los siguientes descubrimientos principales:
-Los unicos dos clientes que registran llegadas y salidas reales de pedidos son MAHLE y PRINTEL
-En general, el promedio de la salida real es mayor que la llegada real de los pedidos.
-El estimado real de los pedidos tiene una mediana mucho mayor que la llegada real, mostrando una variacion evidente en la planeacion logistica.
-La diferencia entre la llegada y salida de pedidos sigue una distribucion normal
-Entre Febrero-Marzo 2022 fue el periodo con mayor variacion entre el estimado y la llegada real de pedidos.