Importar base de datos

#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")

Importar librerias

#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)

Limpieza, transformación y organización

¿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

Tipos de variables

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

Escala de medición

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

Limpieza de la base

#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.

Analisis exploratorio

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

Tabla de frecuencia

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

Tabla cruzada

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()
0 8 9 16 20
MAGNA 180 0 0 0 0
MAHLE 0 180 180 0 180
PRINTEL 0 0 0 180 0
VARROC 540 0 0 0 0
0 8 9 16 20
MAGNA 1 0.0000000 0.0000000 0 0.0000000
MAHLE 0 0.3333333 0.3333333 0 0.3333333
PRINTEL 0 0.0000000 0.0000000 1 0.0000000
VARROC 1 0.0000000 0.0000000 0 0.0000000
0 8 9 16 20
MAGNA 0.25 0 0 0 0
MAHLE 0.00 1 1 0 1
PRINTEL 0.00 0 0 1 0
VARROC 0.75 0 0 0 0
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

Graficos de datos cualitativos y cuantitativos

Bar Plots

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))

Dispersion plots

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')

Time Series Plots

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")

Insights

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.