library(data.table)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:data.table':
##
## between, first, last
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
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:dplyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize
library(ggplot2)
library(naniar)
library(Hmisc)
## Loading required package: lattice
## Loading required package: survival
## Loading required package: Formula
##
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:plyr':
##
## is.discrete, summarize
## The following objects are masked from 'package:dplyr':
##
## src, summarize
## The following objects are masked from 'package:base':
##
## format.pval, units
library(psych)
##
## Attaching package: 'psych'
## The following object is masked from 'package:Hmisc':
##
## describe
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
library(tidyverse)
## ── Attaching packages
## ───────────────────────────────────────
## tidyverse 1.3.2 ──
## ✔ tibble 3.1.8 ✔ purrr 0.3.4
## ✔ tidyr 1.2.0 ✔ stringr 1.4.1
## ✔ readr 2.1.2 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%() masks ggplot2::%+%()
## ✖ psych::alpha() masks ggplot2::alpha()
## ✖ plyr::arrange() masks dplyr::arrange()
## ✖ dplyr::between() masks data.table::between()
## ✖ purrr::compact() masks plyr::compact()
## ✖ plyr::count() masks dplyr::count()
## ✖ plyr::failwith() masks dplyr::failwith()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks data.table::first()
## ✖ plyr::id() masks dplyr::id()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks data.table::last()
## ✖ plyr::mutate() masks dplyr::mutate()
## ✖ plyr::rename() masks dplyr::rename()
## ✖ Hmisc::src() masks dplyr::src()
## ✖ plyr::summarise() masks dplyr::summarise()
## ✖ Hmisc::summarize() masks plyr::summarize(), dplyr::summarize()
## ✖ purrr::transpose() masks data.table::transpose()
library(janitor)
##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(knitr)
library(pollster)
##
## Attaching package: 'pollster'
##
## The following object is masked from 'package:janitor':
##
## crosstab
library(epiDisplay)
## Loading required package: foreign
## 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 objects are masked from 'package:psych':
##
## alpha, cs, lookup
##
## The following object is masked from 'package:lattice':
##
## dotplot
##
## The following object is masked from 'package:ggplot2':
##
## alpha
library(descr)
##
## Attaching package: 'descr'
##
## The following object is masked from 'package:pollster':
##
## crosstab
##
## The following object is masked from 'package:janitor':
##
## crosstab
library(dplyr)
library(plyr)
library(ggplot2)
library(naniar)
library(Hmisc)
library(psych)
library(tidyverse)
library(janitor)
library(knitr)
library(pollster)
library(epiDisplay)
library(modeest)
## Registered S3 methods overwritten by 'rmutil':
## method from
## plot.residuals psych
## print.response httr
produccion <- read.csv("C:\\Users\\chema\\Desktop\\produccion.csv")
prod2 <- subset(produccion,select = -c (no, id_form, producto, hora_fin, inicio_setup, fin_inicio_su, inicio_proceso, fin_proceso, tiempo_materiales, merma))
str(prod2)
## 'data.frame': 5411 obs. of 7 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 : chr "200" "100" "216" "100" ...
## $ tiempo_minutos : chr "20" "15" "20" "10" ...
## $ estacion_arranque : chr "C1" "C1" "C1" "C1" ...
## $ laminas_procesadas: chr "402" "134" "110" "100" ...
## $ tiempo_calidad : chr "1" "1" "1" "1" ...
prod2$piezas_prog<-as.numeric(prod2$piezas_prog)
## Warning: NAs introduced by coercion
prod2$tiempo_minutos<-as.numeric(prod2$tiempo_minutos)
## Warning: NAs introduced by coercion
prod2$laminas_procesadas<-as.numeric(prod2$laminas_procesadas)
## Warning: NAs introduced by coercion
prod2$tiempo_calidad<-as.numeric(prod2$tiempo_calidad)
## Warning: NAs introduced by coercion
prod2$cliente<-as.factor(prod2$cliente)
prod2$estacion_arranque<-as.factor(prod2$estacion_arranque)
colSums(is.na(prod2))
## fecha cliente piezas_prog tiempo_minutos
## 0 1 830 3332
## estacion_arranque laminas_procesadas tiempo_calidad
## 0 2208 2919
prod2<-prod2 %>% mutate(piezas_prog=ifelse(is.na(piezas_prog),median(piezas_prog,na.rm=T),piezas_prog))
prod2<-prod2 %>% mutate(tiempo_minutos=ifelse(is.na(tiempo_minutos),median(tiempo_minutos,na.rm=T),tiempo_minutos))
prod2<-prod2 %>% mutate(laminas_procesadas=ifelse(is.na(laminas_procesadas),median(laminas_procesadas,na.rm=T),laminas_procesadas))
prod2<-prod2 %>% mutate(tiempo_calidad=ifelse(is.na(tiempo_calidad),median(tiempo_calidad,na.rm=T),tiempo_calidad))
prod2$fecha<-as.Date(prod2$fecha,format="%m/%d/%Y")
summary(prod2)
## fecha cliente piezas_prog tiempo_minutos
## Min. :2022-01-09 STABILUS 1:1635 Min. : 0.0 Min. : 0.3854
## 1st Qu.:2022-07-09 TRMX : 981 1st Qu.: 25.0 1st Qu.: 20.0000
## Median :2022-08-04 STABILUS 3: 887 Median : 60.0 Median : 20.0000
## Mean :2022-07-11 YANFENG : 646 Mean : 111.9 Mean : 21.1835
## 3rd Qu.:2022-08-10 DENSO : 524 3rd Qu.: 150.0 3rd Qu.: 20.0000
## Max. :2022-12-09 (Other) : 737 Max. :2000.0 Max. :150.0000
## NA's :3412 NA's : 1
## estacion_arranque laminas_procesadas tiempo_calidad
## : 546 Min. : 0.00 Min. : 0.000
## 0 : 478 1st Qu.: 0.00 1st Qu.: 1.000
## TROQUEL : 422 Median : 11.00 Median : 1.000
## CAJAS : 331 Mean : 47.98 Mean : 1.046
## ROTATIVA: 270 3rd Qu.: 28.50 3rd Qu.: 1.000
## C3 : 263 Max. :1263.00 Max. :48.000
## (Other) :3101
write.csv(prod2,"C:\\Users\\chema\\Desktop\\form_produccion_final.csv", row.names=FALSE)
mea2 <- mean(prod2$piezas_prog)
med2 <- median(prod2$piezas_prog)
moda2<- mfv(prod2$piezas_prog)
sd2 <- sd(prod2$piezas_prog, na.rm = TRUE)
mea3 <- mean(prod2$tiempo_minutos)
med3 <- median(prod2$tiempo_minutos)
moda3 <- mfv(prod2$tiempo_minutos)
sd3 <- sd(prod2$tiempo_minutos, na.rm = TRUE)
mea4 <- mean(prod2$laminas_procesadas)
med4 <- median(prod2$laminas_procesadas)
moda4 <- mfv(prod2$laminas_prog)
sd4 <- sd(prod2$laminas_procesadas, na.rm = TRUE)
mea5 <- mean(prod2$tiempo_calidad)
med5 <- median(prod2$tiempo_calidad)
moda5 <- mfv(prod2$tiempo_calidad)
sd5 <- sd(prod2$tiempo_calidad, na.rm = TRUE)
moda6 <- mfv(prod2$cliente)
moda <- mfv(prod2$fecha)
moda1 <- mfv(prod2$estacion_arranque)
Variables <-c("Piezas_prog","Tiempo Minutos", "Laminas procesadas", "Tiempo Calidad", "Cliente","Fecha","Estación de Arranque")
Media <-c(mea2,mea3,mea4,mea5,"NA","NA","NA")
Mediana <-c(med2,med3,med4,med5,"NA","NA","NA")
Moda <-c(moda2,moda3,moda4,moda5,moda6,moda,moda1)
Desviacion <-c(sd2,sd3,sd4,sd5,"NA","NA","NA")
tabla2 <-data.frame(Variables, Media, Mediana, Moda,Desviacion)
knitr::kable(tabla2)
| Variables | Media | Mediana | Moda | Desviacion |
|---|---|---|---|---|
| Piezas_prog | 111.946775087784 | 60 | 60 | 143.379385489062 |
| Tiempo Minutos | 21.183497351075 | 20 | 20 | 9.44792242800397 |
| Laminas procesadas | 47.9842101223844 | 11 | NaN | 100.830331569012 |
| Tiempo Calidad | 1.04601737201996 | 1 | 1 | 1.70546266370601 |
| Cliente | NA | NA | 6 | NA |
| Fecha | NA | NA | NA | NA |
| Estación de Arranque | NA | NA | 1 | NA |
plot(prod2$piezas_prog,prod2$laminas_procesadas, col="red", xlab="Laminas Programadas",ylab="Laminas Procesadas")
plot(prod2$laminas_procesadas,prod2$tiempo_minutos, col="blue", xlab="Laminas Programadas",ylab="Laminas Procesadas")
### Bar Plot
sss <- aggregate(laminas_procesadas ~ cliente, data = prod2, FUN=sum)
ss <- aggregate(laminas_procesadas ~ cliente, data = prod2, FUN=mean)
as.matrix(ss$laminas_procesadas)
## [,1]
## [1,] 10.72093
## [2,] 28.29065
## [3,] 60.12500
## [4,] 41.19418
## [5,] 13.71696
## [6,] 56.65153
## [7,] 46.86364
## [8,] 118.19086
## [9,] 39.77853
## [10,] 45.38937
## [11,] 274.25000
## [12,] 120.16667
## [13,] 61.10280
as.matrix(sss$laminas_procesadas)
## [,1]
## [1,] 461.000
## [2,] 14824.300
## [3,] 962.000
## [4,] 5025.690
## [5,] 1577.450
## [6,] 92625.250
## [7,] 41568.050
## [8,] 4254.871
## [9,] 39022.740
## [10,] 17928.800
## [11,] 1097.000
## [12,] 721.000
## [13,] 39472.410
data <- data.frame(
name = sss$cliente,
average = ss$laminas_procesadas,
number = sss$laminas_procesadas
)
my_bar <- barplot(height=data$number, names=data$name)
library(RColorBrewer)
coul <- brewer.pal(5, "Set2")
barplot(height=data$number, names=data$name, col=coul )
barplot(height=data$number, names=data$name, border="#69b3a2", col="white" )
# Merma
merma <- read.csv("C:\\Users\\chema\\Downloads\\FORM - Merma1.csv")
se considero eliminar los registros con las fechas individuales y conservar los totales, ya que es la información que nos dará un insight general, además de que no hay fechas que coincidan entre todos los meses.
sum(is.na(merma))
## [1] 0
No hay NA´s en la base de datos.
No se cambiaron los nombres en las variables porque ya son cortos y concisos.
Promedio <- (mean(merma$Kilos))
Promedio
## [1] 20602.89
Moda <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
Moda1 <- Moda(merma$kilos)
Moda1
## NULL
mediana <- median(merma$Kilos)
mediana
## [1] 19370
varianza <- var(merma$Kilos)
varianza
## [1] 30544665
desviacion <- sqrt(varianza)
desviacion
## [1] 5526.723
Variable <- c("Kilos")
Promedio <- c("20602.89")
Moda <- c("NA")
Mediana <- c("19370")
Varianza <- c("30544665")
Desviación_Estándar <- c("5526.723")
tabla <-data.frame(Variable,Promedio, Moda, Mediana, Varianza, Desviación_Estándar)
knitr::kable(tabla)
| Variable | Promedio | Moda | Mediana | Varianza | Desviación_Estándar |
|---|---|---|---|---|---|
| Kilos | 20602.89 | NA | 19370 | 30544665 | 5526.723 |
En promedio en FORM se producieron 37085.2 kilos de merma durante Enero-Septiembre 2022 por lo que se puede asignar como un número estándar en los meses próximos del año. No hay moda porque los datos no se repiten ya que trabajan sobre pedido y la varianza es alta por que existe mucha dispersión entre los datos, ya que no son una empresa que tengan la misma cantidad de producción todos los meses.
plot(merma$Kilos, xlab = "Mes", ylab = "Kilos")
polygon(merma$Kilos, col="green", border="black")
Nota: Los números corresponden al mes correspondiente del año. Ejemplo: 1: Enero, 2: Febrero, 3: Marzo, 4: Abril, […], 9: Septiembre.
Como se puede observar en la gráfica el mes con más merma fue el mes de Agosto del 2022 y el mes con menos merma fue Septiembre ´22 pero como todavía no había concluido el mes de Septiembre al momento de descargar la base de datos, podemos decir que Enero fue el mes con menos merma. Se tendría que observar y analizar cuáles son las variables (que existan en otra base de datos) que determinan la influencia en la cantidad de merma por mes.
scrap <- read.csv("C:\\Users\\chema\\Downloads\\FORM1 - Scrap (1).csv")
Se eliminaron las variables que no nos dejan información valiosa para la empresa y solo se dejaron aquellas que sean de utilidad.
sum(is.na(scrap))
## [1] 0
No hay NA´s en la base de datos.
summary(scrap)
## Fecha Cant Ubi.origen
## Length:249 Min. : 1.000 Length:249
## Class :character 1st Qu.: 1.000 Class :character
## Mode :character Median : 2.000 Mode :character
## Mean : 6.727
## 3rd Qu.: 7.000
## Max. :96.000
scr1 <- scrap
scr1$Fecha <- as.Date(scr1$Fecha, format = "%d/%m/%Y")
summary(scr1)
## Fecha Cant Ubi.origen
## Min. :2022-08-01 Min. : 1.000 Length:249
## 1st Qu.:2022-08-11 1st Qu.: 1.000 Class :character
## Median :2022-08-19 Median : 2.000 Mode :character
## Mean :2022-08-17 Mean : 6.727
## 3rd Qu.:2022-08-25 3rd Qu.: 7.000
## Max. :2022-08-31 Max. :96.000
write.csv(scr1, file = "SCRAP_LIMPIA.csv", row.names = FALSE)
Promedio <- (mean(scr1$Cant))
Promedio
## [1] 6.726908
Moda <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
Moda1 <- Moda(scr1$Cant)
Moda1
## [1] 1
mediana <- median(scr1$Cant)
mediana
## [1] 2
varianza <- var(scr1$Cant)
varianza
## [1] 140.7477
desviacion <- sqrt(varianza)
desviacion
## [1] 11.86371
Variable <- c("Cantidad")
Promedio <- c("6.726")
Moda <- c("1")
Mediana <- c("2")
Varianza <- c("140.747")
Desviación_Estándar <- c("11.863")
tabla <-data.frame(Variable,Promedio, Moda, Mediana, Varianza, Desviación_Estándar)
knitr::kable(tabla)
| Variable | Promedio | Moda | Mediana | Varianza | Desviación_Estándar |
|---|---|---|---|---|---|
| Cantidad | 6.726 | 1 | 2 | 140.747 | 11.863 |
La tabla con estadísticas descriptivas se hizo en torno a la variable de “cantidad”. El promedio de productos por orden es de 7 unidades y la mayoría de las órdenes son de 1 unidad. La desviación estándar no es muy alta por lo que se puede inferir que las órdenes tienen un número de unidades similares entre ellas y su rango es entre 1-96 unidades.
library(ggplot2)
ggplot(scr1, aes(x=Fecha, y=Cant, colour=Ubi.origen)) + geom_point()
Al observar de primera vista la gráfica se puede ver que muchos de los pedidos están en pre-producción ya que hay una mayor cantidad de puntos azules en toda la gráfica. Los pedidos casi siempre son de menos de 25 unidades y muy pocos pedidos llegan a pasar esta cantidad de unidades. Pedidos con más de 25 unidades siempre están en pre-producción, por otro lado, Post producción y entrega de PT están en órdenes menores de 25 unidades.
#Cambios previos en Excel: Se traspuso la base de datos de forma vertical
performance <- read.csv("C:\\Users\\chema\\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
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 %>%
#dplyr::select(Cliente,Real.arrival,Vueltas) %>% group_by(Cliente) %>%
#plyr::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.
bd <- read.csv("C:\\Users\\chema\\Downloads\\Delivery Plan BD FINAL.csv")
bd <- clean_names(bd)
bd <- bd %>% 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
)
library(tidyr)
colnames(bd)
## [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"
bd <- pivot_longer(bd, cols=5:14, names_to = "Mes", values_to = "Unidades")
str(bd)
## 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 ...
bd1 <- filter(bd, Unidades>0)
Eliminación de variables irrelevantes. En este caso, dado que previamente se unieron (merge) las variables de mes, solo se considera necesaria la variables de cliente, fecha y Unidades.
bd2 <- bd1
bd2 <- subset (bd1, 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(bd1)
## cliente proyecto id_odoo item
## Length:590 Length:590 Length:590 Length:590
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## K_abr_22 L_may_22 M_jun_22 N_jul_22
## Min. : 0.0 Min. : 0.0 Min. : 0.0 Min. : 0
## 1st Qu.: 0.0 1st Qu.: 0.0 1st Qu.: 0.0 1st Qu.: 0
## Median : 24.0 Median : 48.0 Median : 15.0 Median : 40
## Mean : 494.9 Mean : 353.9 Mean : 376.8 Mean : 630
## 3rd Qu.: 200.0 3rd Qu.: 168.0 3rd Qu.: 150.0 3rd Qu.: 315
## Max. :16354.0 Max. :9600.0 Max. :9600.0 Max. :16000
## O_ago_22 P_sep_22 Q_oct_22 R_nov_22
## Min. : 0.0 Min. : 0.0 Min. : 0 Min. : 0.000
## 1st Qu.: 0.0 1st Qu.: 0.0 1st Qu.: 0 1st Qu.: 0.000
## Median : 0.0 Median : 0.0 Median : 0 Median : 0.000
## Mean : 398.1 Mean : 394.3 Mean : 137 Mean : 6.525
## 3rd Qu.: 144.0 3rd Qu.: 3.0 3rd Qu.: 0 3rd Qu.: 0.000
## Max. :13200.0 Max. :12800.0 Max. :2900 Max. :324.000
## S_dic_22 T_ene_23 V_mar_23 mar_23 total_meses
## Min. : 0.000 Min. : 0.000 Min. :0 Min. :0 Min. : 1
## 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.:0 1st Qu.:0 1st Qu.: 238
## Median : 0.000 Median : 0.000 Median :0 Median :0 Median : 931
## Mean : 4.702 Mean : 2.339 Mean :0 Mean :0 Mean : 5446
## 3rd Qu.: 0.000 3rd Qu.: 0.000 3rd Qu.:0 3rd Qu.:0 3rd Qu.: 4104
## Max. :276.000 Max. :138.000 Max. :0 Max. :0 Max. :136754
## Mes Unidades
## Length:590 Min. : 1.0
## Class :character 1st Qu.: 30.0
## Mode :character Median : 80.0
## Mean : 358.4
## 3rd Qu.: 300.0
## Max. :13120.0
Media <- mean(bd2$Unidades)
Media
## [1] 358.3729
En este caso podemos inferir que el promedio de unidades programadas por cliente es de 358
Mediana <- median(bd2$Unidades)
Mediana
## [1] 80
Para este caso pordemos identificar que la mediana es de 80 unidades pedidas por el cliente.
mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
Moda <- mode(bd2$Unidades)
Moda
## [1] 60
La moda es de de 60 pedidos programados y por consiguiente podemos inferir que es el numero de piezas más popular.
summary(bd2)
## 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
sd(bd2$cliente, na.rm = FALSE)
## Warning in var(if (is.vector(x) || is.factor(x)) x else as.double(x), na.rm =
## na.rm): NAs introduced by coercion
## [1] NA
sd(bd2$Unidades, na.rm = FALSE)
## [1] 1002.834
sd(bd2$Mes, na.rm = FALSE)
## Warning in var(if (is.vector(x) || is.factor(x)) x else as.double(x), na.rm =
## na.rm): NAs introduced by coercion
## [1] NA
Variable<-("Unidades")
Media<-c("358")
Mediana<-c("80")
Moda<-c("60")
Desviacion_Estandar<-c("1002.834")
table1 <- data.frame (Variable, Media, Mediana, Moda, Desviacion_Estandar)
knitr::kable(table1)
| Variable | Media | Mediana | Moda | Desviacion_Estandar |
|---|---|---|---|---|
| Unidades | 358 | 80 | 60 | 1002.834 |
ggplot(bd2, aes(Mes,Unidades)) +
geom_bar(stat = "identity") +
scale_fill_brewer(palette = "Set2") + ggtitle("Unidades por mes")
En este caso se puede inferir que el mes con mayor numero de piezas programadas fué julio del 2021, sin embargo se puede detectar un comportamiento alcista a partir de los ultimos meses hasta el primer cuarto del siguiente año; por lo que se puede concluir en ese sentido que durante el ultimo cuarto y primero del siguiente año es cuando existe mayor demanda para FORM en contexto de piezas programadas
ggplot(bd1, aes(x = Mes, y = Unidades, group = cliente)) +
geom_line()+
ggtitle("Pedidos por Cliente")
Con la gráfica anterior, podemos corroborar la hipotesis de que existen picos de pedidos durante la segunda mitad del año, así como a finales de año y principios del siguiente, donde se trata de un comportamiento alcista en ese sentido.
pie(table(bd2$cliente))
Con la gráfica anterior, se puede inferir que VARROC, junto con TRMX, DENSO, YFCF y HELLA, forman parte de los principales clientes de FORM. Esto dado que según los datos enviados por parte de la empresa, estos clientes son quienes se repiten en mayores instancias durante el periodo determinado.
bdcol <- read.csv("C:\\Users\\chema\\Downloads\\RHCOLABFINA1.1.csv")
bdbaj <- read.csv("C:\\Users\\chema\\Downloads\\BaseD_Limpia RH_ Bajas .csv")
summary(bdbaj)
## nombre edad genero fecha_de_alta
## Length:237 Min. : 0.00 Length:237 Length:237
## Class :character 1st Qu.:23.00 Class :character Class :character
## Mode :character Median :29.00 Mode :character Mode :character
## Mean :30.52
## 3rd Qu.:37.00
## Max. :61.00
## motivo_de_baja dias_de_trabajo baja puesto_que_desempeña
## Length:237 Min. : 0.00 Length:237 Length:237
## Class :character 1st Qu.: 9.00 Class :character Class :character
## Mode :character Median : 21.00 Mode :character Mode :character
## Mean : 83.42
## 3rd Qu.: 49.00
## Max. :1966.00
## salario_imss colonia municipio estado
## Min. :144.4 Length:237 Length:237 Length:237
## 1st Qu.:180.7 Class :character Class :character Class :character
## Median :180.7 Mode :character Mode :character Mode :character
## Mean :178.6
## 3rd Qu.:180.7
## Max. :500.0
## estado_civil
## Length:237
## Class :character
## Mode :character
##
##
##
summary(bdcol)
## numero_de_empleado nombre_completo edad genero
## Min. : 1.00 Length:113 Min. :18.00 Length:113
## 1st Qu.: 31.00 Class :character 1st Qu.:26.00 Class :character
## Median : 63.00 Mode :character Median :34.00 Mode :character
## Mean : 75.86 Mean :36.07
## 3rd Qu.:127.00 3rd Qu.:45.00
## Max. :169.00 Max. :73.00
##
## fecha_de_alta antiguedad BAJA puesto
## Length:113 Min. : 0.000 Min. :3 Length:113
## Class :character 1st Qu.: 0.000 1st Qu.:3 Class :character
## Mode :character Median : 0.000 Median :3 Mode :character
## Mean : 1.425 Mean :3
## 3rd Qu.: 2.000 3rd Qu.:3
## Max. :12.000 Max. :3
## NA's :100
## departamento mano_de_obra salario_diario colonia
## Length:113 Length:113 Min. :144.4 Length:113
## Class :character Class :character 1st Qu.:176.7 Class :character
## Mode :character Mode :character Median :180.7 Mode :character
## Mean :181.4
## 3rd Qu.:180.7
## Max. :441.4
##
## municipio
## Length:113
## Class :character
## Mode :character
##
##
##
##
library(foreign)
library(dplyr) # data manipulation
library(forcats) # to work with categorical variables
library(ggplot2) # data visualization
library(janitor) # data exploration and cleaning
library(Hmisc) # several useful functions for data analysis
library(dlookr) # summaries and visualization of missing values NAs
library(corrplot) # correlation plots
library(jtools) # presentation of regression analysis
library(lmtest) # diagnostic checks - linear regression analysis
library(car) # diagnostic checks - linear regression analysis
library(olsrr) # diagnostic checks - linear regression analysis
library(kableExtra) # HTML table attributes
str(bdcol)
## 'data.frame': 113 obs. of 13 variables:
## $ numero_de_empleado: int 1 2 3 4 5 6 7 8 9 10 ...
## $ nombre_completo : chr "NICOLAS MARTINEZ DE LOERA" "MARIANA DE LEON MORENO" "JOSE LUIS HERNANDEZ CERVANTES" "MARIA CAZARES MORALES" ...
## $ edad : int 67 43 73 32 57 38 55 26 27 37 ...
## $ genero : chr "MASCULINO" "FEMENINO" "MASCULINO" "FEMENINO" ...
## $ fecha_de_alta : chr "01/07/2010" "01/07/2011" "22/11/2011" "30/01/2013" ...
## $ antiguedad : int 12 11 11 9 8 8 7 6 5 5 ...
## $ BAJA : int NA NA NA NA NA NA NA NA NA NA ...
## $ puesto : chr "Supervisor de Máquin" "Supervisor de pegado" "Externo" "SUPERVISORA" ...
## $ departamento : chr "Produccion Cartón MDL" "Produccion Cartón MDL" "Externo" "Produccion Cartón MC" ...
## $ mano_de_obra : chr "Indirecto" "Indirecto" "Indirecto" "Indirecto" ...
## $ salario_diario : num 177 177 177 337 441 ...
## $ colonia : chr "UNIDAD LABORAL" "SANTA TERESITA" "VILLAS DE HUINALA" "PUEBLO NUEVO" ...
## $ municipio : chr "SAN NICOLAS DE LOS G" "APODACA" "APODACA" "APODACA" ...
str(bdbaj)
## 'data.frame': 237 obs. of 13 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" ...
## $ fecha_de_alta : chr "9/3/2020" "9/11/2021" "10/11/2021" "10/11/2021" ...
## $ motivo_de_baja : chr "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" ...
## $ dias_de_trabajo : int 628 60 59 59 51 37 37 31 18 224 ...
## $ baja : chr "27/11/2021" "8/1/2022" "8/1/2022" "8/1/2022" ...
## $ puesto_que_desempeña: chr "DISEÑO" "AYUDANTE GENERAL" "AYUDANTE GENERAL" "AYUDANTE GENERAL" ...
## $ salario_imss : num 500 152 152 152 152 ...
## $ colonia : chr "SAN NICOLAS DE LOS G" "COLINAS DEL AEROPÑUERTO" "PUEBLO NUEVO" "PUEBLO NUEVO" ...
## $ municipio : chr "SAN NICOLAS DE LOS G" "PESQUERIA" "APODACA" "APODACA" ...
## $ estado : chr "NUEVO LEÓN" "NUEVO LEÓN" "NUEVO LEÓN" "NUEVO LEÓN" ...
## $ estado_civil : chr "SOLTERO" "UNIÓN LIBRE" "CASADO" "SOLTERO" ...
bdcol1<-bdcol
bdbaj1<-bdbaj
#bdcol1<-bdcol %>% select(-one_of('numero_de_empleado','fecha_de_alta' ,'BAJA', 'edad'))
summary(bdcol1)
## numero_de_empleado nombre_completo edad genero
## Min. : 1.00 Length:113 Min. :18.00 Length:113
## 1st Qu.: 31.00 Class :character 1st Qu.:26.00 Class :character
## Median : 63.00 Mode :character Median :34.00 Mode :character
## Mean : 75.86 Mean :36.07
## 3rd Qu.:127.00 3rd Qu.:45.00
## Max. :169.00 Max. :73.00
##
## fecha_de_alta antiguedad BAJA puesto
## Length:113 Min. : 0.000 Min. :3 Length:113
## Class :character 1st Qu.: 0.000 1st Qu.:3 Class :character
## Mode :character Median : 0.000 Median :3 Mode :character
## Mean : 1.425 Mean :3
## 3rd Qu.: 2.000 3rd Qu.:3
## Max. :12.000 Max. :3
## NA's :100
## departamento mano_de_obra salario_diario colonia
## Length:113 Length:113 Min. :144.4 Length:113
## Class :character Class :character 1st Qu.:176.7 Class :character
## Mode :character Mode :character Median :180.7 Mode :character
## Mean :181.4
## 3rd Qu.:180.7
## Max. :441.4
##
## municipio
## Length:113
## Class :character
## Mode :character
##
##
##
##
names(bdcol1)<-c('Nomb_Comp', 'Gene', 'Anti', 'Puesto', 'Dept', 'MDO', 'SalDiario', 'Col', 'Mun')
names(bdbaj1)<-c('Nomb', 'Edad', 'Gene', 'Fecha_alta', 'MB', 'Días_trab', 'Baja', 'PuestDes', 'Sal_IMSS', 'Col', 'Mun', 'Estado', 'EstCiv')
bdcol1$Fecha_alta<-as.Date(bdcol$fecha_de_alta,format="%y/%m/%d")
bdbaj1$Fecha_alta<-as.Date(bdbaj1$Fecha_alta,format="%y/%m/%d")
bdbaj1$Baja<-as.Date(bdbaj1$Baja,format="%y/%m/%d")
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:data.table':
##
## hour, isoweek, mday, minute, month, quarter, second, wday, week,
## yday, year
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
edad<-trunc((bdcol1$Fecha_alta %--% bdcol1$Fecha_alta) / years(1))
bdcol1$edad<-edad
sum(is.na(bdcol1))
## [1] 100
sum(is.na(bdbaj1))
## [1] 0
bdcol1[is.na(bdcol1)]<-0
bdbaj1[is.na(bdbaj1)]<-0
summary(bdcol1)
## Nomb_Comp Gene Anti Puesto
## Min. : 1.00 Length:113 Min. :18.00 Length:113
## 1st Qu.: 31.00 Class :character 1st Qu.:26.00 Class :character
## Median : 63.00 Mode :character Median :34.00 Mode :character
## Mean : 75.86 Mean :36.07
## 3rd Qu.:127.00 3rd Qu.:45.00
## Max. :169.00 Max. :73.00
## Dept MDO SalDiario Col
## Length:113 Min. : 0.000 Min. :0.0000 Length:113
## Class :character 1st Qu.: 0.000 1st Qu.:0.0000 Class :character
## Mode :character Median : 0.000 Median :0.0000 Mode :character
## Mean : 1.425 Mean :0.3451
## 3rd Qu.: 2.000 3rd Qu.:0.0000
## Max. :12.000 Max. :3.0000
## Mun NA NA NA
## Length:113 Length:113 Min. :144.4 Length:113
## Class :character Class :character 1st Qu.:176.7 Class :character
## Mode :character Mode :character Median :180.7 Mode :character
## Mean :181.4
## 3rd Qu.:180.7
## Max. :441.4
## NA Fecha_alta edad
## Length:113 Min. :2001-06-20 Min. :0
## Class :character 1st Qu.:2006-07-20 1st Qu.:0
## Mode :character Median :2014-04-20 Median :0
## Mean :2014-06-16 Mean :0
## 3rd Qu.:2022-11-20 3rd Qu.:0
## Max. :2030-07-20 Max. :0
summary(bdbaj1)
## Nomb Edad Gene Fecha_alta
## Length:237 Min. : 0.00 Length:237 Min. :2001-02-20
## Class :character 1st Qu.:23.00 Class :character 1st Qu.:2010-06-20
## Mode :character Median :29.00 Mode :character Median :2015-06-20
## Mean :30.52 Mean :2015-11-07
## 3rd Qu.:37.00 3rd Qu.:2021-12-20
## Max. :61.00 Max. :2031-05-20
## MB Días_trab Baja PuestDes
## Length:237 Min. : 0.00 Min. :2001-02-20 Length:237
## Class :character 1st Qu.: 9.00 1st Qu.:2011-04-20 Class :character
## Mode :character Median : 21.00 Median :2017-08-20 Mode :character
## Mean : 83.42 Mean :2017-08-09
## 3rd Qu.: 49.00 3rd Qu.:2025-04-20
## Max. :1966.00 Max. :2031-01-20
## Sal_IMSS Col Mun Estado
## Min. :144.4 Length:237 Length:237 Length:237
## 1st Qu.:180.7 Class :character Class :character Class :character
## Median :180.7 Mode :character Mode :character Mode :character
## Mean :178.6
## 3rd Qu.:180.7
## Max. :500.0
## EstCiv
## Length:237
## Class :character
## Mode :character
##
##
##
bdcol1 <- na.omit(bdcol1)
bdbaj1 <- na.omit(bdbaj1)
summary(bdcol1)
## Nomb_Comp Gene Anti Puesto
## Min. : 1.00 Length:113 Min. :18.00 Length:113
## 1st Qu.: 31.00 Class :character 1st Qu.:26.00 Class :character
## Median : 63.00 Mode :character Median :34.00 Mode :character
## Mean : 75.86 Mean :36.07
## 3rd Qu.:127.00 3rd Qu.:45.00
## Max. :169.00 Max. :73.00
## Dept MDO SalDiario Col
## Length:113 Min. : 0.000 Min. :0.0000 Length:113
## Class :character 1st Qu.: 0.000 1st Qu.:0.0000 Class :character
## Mode :character Median : 0.000 Median :0.0000 Mode :character
## Mean : 1.425 Mean :0.3451
## 3rd Qu.: 2.000 3rd Qu.:0.0000
## Max. :12.000 Max. :3.0000
## Mun NA NA NA
## Length:113 Length:113 Min. :144.4 Length:113
## Class :character Class :character 1st Qu.:176.7 Class :character
## Mode :character Mode :character Median :180.7 Mode :character
## Mean :181.4
## 3rd Qu.:180.7
## Max. :441.4
## NA Fecha_alta edad
## Length:113 Min. :2001-06-20 Min. :0
## Class :character 1st Qu.:2006-07-20 1st Qu.:0
## Mode :character Median :2014-04-20 Median :0
## Mean :2014-06-16 Mean :0
## 3rd Qu.:2022-11-20 3rd Qu.:0
## Max. :2030-07-20 Max. :0
summary(bdbaj1)
## Nomb Edad Gene Fecha_alta
## Length:237 Min. : 0.00 Length:237 Min. :2001-02-20
## Class :character 1st Qu.:23.00 Class :character 1st Qu.:2010-06-20
## Mode :character Median :29.00 Mode :character Median :2015-06-20
## Mean :30.52 Mean :2015-11-07
## 3rd Qu.:37.00 3rd Qu.:2021-12-20
## Max. :61.00 Max. :2031-05-20
## MB Días_trab Baja PuestDes
## Length:237 Min. : 0.00 Min. :2001-02-20 Length:237
## Class :character 1st Qu.: 9.00 1st Qu.:2011-04-20 Class :character
## Mode :character Median : 21.00 Median :2017-08-20 Mode :character
## Mean : 83.42 Mean :2017-08-09
## 3rd Qu.: 49.00 3rd Qu.:2025-04-20
## Max. :1966.00 Max. :2031-01-20
## Sal_IMSS Col Mun Estado
## Min. :144.4 Length:237 Length:237 Length:237
## 1st Qu.:180.7 Class :character Class :character Class :character
## Median :180.7 Mode :character Mode :character Mode :character
## Mean :178.6
## 3rd Qu.:180.7
## Max. :500.0
## EstCiv
## Length:237
## Class :character
## Mode :character
##
##
##
str(bdcol1)
## 'data.frame': 113 obs. of 15 variables:
## $ Nomb_Comp : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Gene : chr "NICOLAS MARTINEZ DE LOERA" "MARIANA DE LEON MORENO" "JOSE LUIS HERNANDEZ CERVANTES" "MARIA CAZARES MORALES" ...
## $ Anti : int 67 43 73 32 57 38 55 26 27 37 ...
## $ Puesto : chr "MASCULINO" "FEMENINO" "MASCULINO" "FEMENINO" ...
## $ Dept : chr "01/07/2010" "01/07/2011" "22/11/2011" "30/01/2013" ...
## $ MDO : int 12 11 11 9 8 8 7 6 5 5 ...
## $ SalDiario : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Col : chr "Supervisor de Máquin" "Supervisor de pegado" "Externo" "SUPERVISORA" ...
## $ Mun : chr "Produccion Cartón MDL" "Produccion Cartón MDL" "Externo" "Produccion Cartón MC" ...
## $ NA : chr "Indirecto" "Indirecto" "Indirecto" "Indirecto" ...
## $ NA : num 177 177 177 337 441 ...
## $ NA : chr "UNIDAD LABORAL" "SANTA TERESITA" "VILLAS DE HUINALA" "PUEBLO NUEVO" ...
## $ NA : chr "SAN NICOLAS DE LOS G" "APODACA" "APODACA" "APODACA" ...
## $ Fecha_alta: Date, format: "2001-07-20" "2001-07-20" ...
## $ edad : num 0 0 0 0 0 0 0 0 0 0 ...
str(bdbaj1)
## 'data.frame': 237 obs. of 13 variables:
## $ Nomb : 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 ...
## $ Gene : chr "MASCULINO" "FEMENINO" "FEMENINO" "FEMENINO" ...
## $ Fecha_alta: Date, format: "2009-03-20" "2009-11-20" ...
## $ MB : chr "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" ...
## $ Días_trab : int 628 60 59 59 51 37 37 31 18 224 ...
## $ Baja : Date, format: "2027-11-20" "2008-01-20" ...
## $ PuestDes : chr "DISEÑO" "AYUDANTE GENERAL" "AYUDANTE GENERAL" "AYUDANTE GENERAL" ...
## $ Sal_IMSS : num 500 152 152 152 152 ...
## $ Col : chr "SAN NICOLAS DE LOS G" "COLINAS DEL AEROPÑUERTO" "PUEBLO NUEVO" "PUEBLO NUEVO" ...
## $ Mun : chr "SAN NICOLAS DE LOS G" "PESQUERIA" "APODACA" "APODACA" ...
## $ Estado : chr "NUEVO LEÓN" "NUEVO LEÓN" "NUEVO LEÓN" "NUEVO LEÓN" ...
## $ EstCiv : chr "SOLTERO" "UNIÓN LIBRE" "CASADO" "SOLTERO" ...
bdbaj1$Gen<-as.factor(bdbaj1$Gen)
bdcol1$Gen<-as.factor(bdcol1$Gen)
bdbaj1$PuestDes<-as.factor(bdbaj1$PuestDes)
bdcol1$Puesto<-as.factor(bdcol1$Puesto)
bdcol1$Dep<-as.factor(bdcol1$Dep)
bdbaj1$Mun<-as.factor(bdbaj1$Mun)
bdcol1$Mun<-as.factor(bdcol1$Mun)
bdbaj1$Estado<-as.factor(bdbaj1$Estado)
bdbaj1$EstCiv<-as.factor(bdbaj1$EstCiv)
str(bdbaj1)
## 'data.frame': 237 obs. of 14 variables:
## $ Nomb : 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 ...
## $ Gene : chr "MASCULINO" "FEMENINO" "FEMENINO" "FEMENINO" ...
## $ Fecha_alta: Date, format: "2009-03-20" "2009-11-20" ...
## $ MB : chr "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" "RENUNCIA VOLUNTARIA" ...
## $ Días_trab : int 628 60 59 59 51 37 37 31 18 224 ...
## $ Baja : Date, format: "2027-11-20" "2008-01-20" ...
## $ PuestDes : Factor w/ 31 levels "ANALISTA DE NOMINAS /AUX DE R.H.",..: 15 9 9 9 9 9 9 9 9 4 ...
## $ Sal_IMSS : num 500 152 152 152 152 ...
## $ Col : chr "SAN NICOLAS DE LOS G" "COLINAS DEL AEROPÑUERTO" "PUEBLO NUEVO" "PUEBLO NUEVO" ...
## $ Mun : Factor w/ 13 levels "APODACA","CADEREYTA",..: 10 7 1 1 1 1 1 5 4 1 ...
## $ Estado : Factor w/ 3 levels "COAHUILA","NUEVO LEÓN",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ EstCiv : Factor w/ 5 levels "CASADO","DIVORCIADO",..: 3 5 1 3 3 3 5 5 3 3 ...
## $ Gen : Factor w/ 2 levels "FEMENINO","MASCULINO": 2 1 1 1 1 1 1 2 2 2 ...
str(bdcol1)
## 'data.frame': 113 obs. of 17 variables:
## $ Nomb_Comp : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Gene : chr "NICOLAS MARTINEZ DE LOERA" "MARIANA DE LEON MORENO" "JOSE LUIS HERNANDEZ CERVANTES" "MARIA CAZARES MORALES" ...
## $ Anti : int 67 43 73 32 57 38 55 26 27 37 ...
## $ Puesto : Factor w/ 2 levels "FEMENINO","MASCULINO": 2 1 2 1 1 2 1 2 2 1 ...
## $ Dept : chr "01/07/2010" "01/07/2011" "22/11/2011" "30/01/2013" ...
## $ MDO : int 12 11 11 9 8 8 7 6 5 5 ...
## $ SalDiario : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Col : chr "Supervisor de Máquin" "Supervisor de pegado" "Externo" "SUPERVISORA" ...
## $ Mun : Factor w/ 22 levels "","Ay.flexo",..: 18 18 13 17 8 4 8 19 4 10 ...
## $ NA : chr "Indirecto" "Indirecto" "Indirecto" "Indirecto" ...
## $ NA : num 177 177 177 337 441 ...
## $ NA : chr "UNIDAD LABORAL" "SANTA TERESITA" "VILLAS DE HUINALA" "PUEBLO NUEVO" ...
## $ NA : chr "SAN NICOLAS DE LOS G" "APODACA" "APODACA" "APODACA" ...
## $ Fecha_alta: Date, format: "2001-07-20" "2001-07-20" ...
## $ edad : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Gen : Factor w/ 113 levels "ADELAIDA MENDOZA NAVARRO",..: 92 78 55 71 111 42 11 96 43 110 ...
## $ Dep : Factor w/ 93 levels "01/06/2022","01/07/2010",..: 2 3 69 91 18 10 25 75 40 63 ...
summary(bdbaj1)
## Nomb Edad Gene Fecha_alta
## Length:237 Min. : 0.00 Length:237 Min. :2001-02-20
## Class :character 1st Qu.:23.00 Class :character 1st Qu.:2010-06-20
## Mode :character Median :29.00 Mode :character Median :2015-06-20
## Mean :30.52 Mean :2015-11-07
## 3rd Qu.:37.00 3rd Qu.:2021-12-20
## Max. :61.00 Max. :2031-05-20
##
## MB Días_trab Baja
## Length:237 Min. : 0.00 Min. :2001-02-20
## Class :character 1st Qu.: 9.00 1st Qu.:2011-04-20
## Mode :character Median : 21.00 Median :2017-08-20
## Mean : 83.42 Mean :2017-08-09
## 3rd Qu.: 49.00 3rd Qu.:2025-04-20
## Max. :1966.00 Max. :2031-01-20
##
## PuestDes Sal_IMSS Col
## AYUDANTE GENERAL :173 Min. :144.4 Length:237
## SOLDADOR : 11 1st Qu.:180.7 Class :character
## COSTURERA : 10 Median :180.7 Mode :character
## MONTACARGUISTA : 5 Mean :178.6
## AY. GENERAL : 4 3rd Qu.:180.7
## AUXILIAR DE EMBARQUES: 3 Max. :500.0
## (Other) : 31
## Mun Estado EstCiv
## APODACA :162 COAHUILA : 9 CASADO : 64
## PESQUERIA : 32 NUEVO LEÓN:227 DIVORCIADO : 3
## JUAREZ : 15 SALTILLO : 1 SOLTERO :110
## GUADALUPE : 10 Unión libre: 1
## RAMOS ARIZPE : 8 UNIÓN LIBRE: 59
## SAN NICOLAS DE LOS GARZA: 3
## (Other) : 7
## Gen
## FEMENINO :140
## MASCULINO: 97
##
##
##
##
##
summary(bdcol1)
## Nomb_Comp Gene Anti Puesto
## Min. : 1.00 Length:113 Min. :18.00 FEMENINO :61
## 1st Qu.: 31.00 Class :character 1st Qu.:26.00 MASCULINO:52
## Median : 63.00 Mode :character Median :34.00
## Mean : 75.86 Mean :36.07
## 3rd Qu.:127.00 3rd Qu.:45.00
## Max. :169.00 Max. :73.00
##
## Dept MDO SalDiario Col
## Length:113 Min. : 0.000 Min. :0.0000 Length:113
## Class :character 1st Qu.: 0.000 1st Qu.:0.0000 Class :character
## Mode :character Median : 0.000 Median :0.0000 Mode :character
## Mean : 1.425 Mean :0.3451
## 3rd Qu.: 2.000 3rd Qu.:0.0000
## Max. :12.000 Max. :3.0000
##
## Mun NA NA
## :40 Length:113 Min. :144.4
## Producción Retorn :10 Class :character 1st Qu.:176.7
## Costura : 7 Mode :character Median :180.7
## Produccion Cartón MDL: 7 Mean :181.4
## Stabilus : 7 3rd Qu.:180.7
## Cedis : 6 Max. :441.4
## (Other) :36
## NA NA Fecha_alta edad
## Length:113 Length:113 Min. :2001-06-20 Min. :0
## Class :character Class :character 1st Qu.:2006-07-20 1st Qu.:0
## Mode :character Mode :character Median :2014-04-20 Median :0
## Mean :2014-06-16 Mean :0
## 3rd Qu.:2022-11-20 3rd Qu.:0
## Max. :2030-07-20 Max. :0
##
## Gen Dep
## ADELAIDA MENDOZA NAVARRO : 1 14/06/2022: 4
## ADRIANA BADILLO LOZANO : 1 03/08/2022: 3
## ADRIANA IRENE ZAPATA GARCIA: 1 23/08/2022: 3
## ADRIANA PADILLO CASTILLO : 1 01/06/2022: 2
## ALFREDO HERNANDEZ PASCUAL : 1 02/08/2022: 2
## ALMA DELIA LARA CAMPOS : 1 03/11/2020: 2
## (Other) :107 (Other) :97
tapply(bdbaj1$Sal_IMSS,
list(bdbaj1$Gen,bdbaj1$EstCiv), mean)
## CASADO DIVORCIADO SOLTERO Unión libre UNIÓN LIBRE
## FEMENINO 176.6727 180.68 178.5836 NA 175.7823
## MASCULINO 180.2840 180.68 182.6171 176.72 176.5513
bdbaj1$Sal_IMSS<-replace(bdbaj1$Sal_IMSS,bdbaj1$Sal_IMSS>1000000,181)
tapply(bdbaj1$Sal_IMSS,
list(bdbaj1$Gene,bdbaj1$EstCiv), mean)
## CASADO DIVORCIADO SOLTERO Unión libre UNIÓN LIBRE
## FEMENINO 176.6727 180.68 178.5836 NA 175.7823
## MASCULINO 180.2840 180.68 182.6171 176.72 176.5513
hist(bdbaj1$Edad, freq=TRUE, col='Darkblue', main="Histograma Edad",xlab="Edad en Años")
Dentro de este histograma se analizó la edad y la frecuencia que tiene. En este caso se puede observar que la edad que se ve mas presente dentro de la empresa es la de 20-30 años.
ggplot(bdbaj1, aes(Gene,Días_trab,fill=Gene)) +
geom_bar(stat = "identity") +
scale_fill_brewer(palette = "Set3") + ggtitle(" Días trabajadospor Genero")
En este gráfico se puede observar como los hombres cuentan con más días trabajados que las mujeres al momento de ser dados de baja de la empresa.
ggplot(bdbaj1, aes(x=Gene, y=Sal_IMSS, fill=Gene)) +
geom_bar(stat="identity") +
facet_grid(~EstCiv) + scale_fill_brewer(palette = "Set3")
Dentro de este gráfico se puede observar como en todos los rubros las mujeres ganan mas de su salario del IMSS que los hombres.
bdss <- read.csv("C:\\Users\\chema\\Downloads\\cccs.csv")
as.numeric(bdss$cant_car)
## [1] 12969.8 14481.9 14981.0 13758.4 11197.5 10563.6 10357.3 12107.1 14205.1
## [10] 15425.1 16044.3 14875.1 15443.2 14520.7 13859.7 12309.4 12857.3 13882.7
## [19] 15044.9 14728.4 15097.1 15121.9 15543.0 16893.7 17349.7 17122.4 16816.2
## [28] 16639.1 16866.9 16948.2 16504.1 16089.0 13194.8 10402.3 11554.8 12741.8
## [37] 14433.2 15530.1 16452.2 17408.0 17477.3 17150.1 17224.9 16961.1 14471.8
## [46] 14926.9
aa<-bdss$cant_car
a1 <- ts(data = aa, start = c(2022,1), frequency = 12)
library(forecast)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Registered S3 method overwritten by 'forecast':
## method from
## predict.default statip
##
## Attaching package: 'forecast'
## The following object is masked from 'package:modeest':
##
## naive
modelo <- auto.arima(a1)
modelo
## Series: a1
## ARIMA(0,1,1)
##
## Coefficients:
## ma1
## 0.4127
## s.e. 0.1211
##
## sigma^2 = 1172836: log likelihood = -377.88
## AIC=759.75 AICc=760.04 BIC=763.37
mer2 <- forecast(modelo, level=c(95), h=3)
mer2
## Point Forecast Lo 95 Hi 95
## Nov 2025 15515.09 13392.49 17637.68
## Dec 2025 15515.09 11841.25 19188.92
## Jan 2026 15515.09 10772.86 20257.31
plot(mer2)
### Análisis de la gráfica
La grafica está basada en una base de datos extraida de Statista, dicha base de datos muestra las ventas de autos en los ultimos años en estados unidos. Con el pronostico realizado podemos ver que las ventas tendrán una caida en el 2022 sin embargo se recuperarán en el 2024, cayendo violentamente en el año 2025. Esto es un gran Insight para Form, quienes necesitan comenzar a prepararse contra dicha posible caida.
La base de datos externa utilizada en este caso fue proporcionada por Passport, en donde se visualizan la cantidad de produccion de autos durante los ultimos años, comprendiendo el periodo desde el 2017 al 2021, esto para diversos paises de todos los continentes.
#Se agrego una columna de continentes en Excel
#file.choose()
externa <- read.csv("/Users/chema/Downloads/Produccion autos.csv")
#{r message=FALSE, warning=FALSE}
#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)
#install.packages("lubridate")
library(lubridate)
¿Cuantas variables y cuantos registros tiene la base de datos?
10 variables y 994 registros
str (externa)
## 'data.frame': 994 obs. of 10 variables:
## $ Geography: chr "China" "Japan" "India" "Germany" ...
## $ Continent: chr "Asia" "Asia" "Asia" "Europa" ...
## $ Category : chr "Passenger Car Production" "Passenger Car Production" "Passenger Car Production" "Passenger Car Production" ...
## $ Data.Type: chr "Unit Volume" "Unit Volume" "Unit Volume" "Unit Volume" ...
## $ Unit : int 0 0 0 0 0 0 0 0 0 0 ...
## $ X2017 : int 24807 8348 3961 5646 3735 2308 2291 3033 1349 1306 ...
## $ X2018 : int 23529 8359 4032 5120 3662 2388 2267 2785 1564 1437 ...
## $ X2019 : int 21360 8329 3623 4661 3613 2448 2248 2513 1524 1428 ...
## $ X2020 : int 19994 6960 2850 3510 3175 1607 1675 1958 1261 1016 ...
## $ X2021 : int 21408 6619 3628 3162 3129 1708 1698 1578 1353 1079 ...
summary(externa)
## Geography Continent Category Data.Type
## Length:994 Length:994 Length:994 Length:994
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## Unit X2017 X2018 X2019
## Min. :0 Min. : 0.00 Min. : 0.00 Min. : 0.0
## 1st Qu.:0 1st Qu.: 78.25 1st Qu.: 71.25 1st Qu.: 60.0
## Median :0 Median : 274.00 Median : 266.50 Median : 284.5
## Mean :0 Mean : 1370.59 Mean : 1335.76 Mean : 1246.0
## 3rd Qu.:0 3rd Qu.: 1265.25 3rd Qu.: 1201.75 3rd Qu.: 1086.5
## Max. :0 Max. :24807.00 Max. :23529.00 Max. :21360.0
## NA's :940 NA's :940 NA's :940 NA's :940
## X2020 X2021
## Min. : 0.00 Min. : 0.0
## 1st Qu.: 41.75 1st Qu.: 51.5
## Median : 260.50 Median : 252.0
## Mean : 1027.72 Mean : 1058.9
## 3rd Qu.: 810.00 3rd Qu.: 861.5
## Max. :19994.00 Max. :21408.0
## NA's :940 NA's :940
Variable <- c("`Geography`", "`Continent`", "`Category`", "`Data.Type`", "`Unit`", "`X2017`", "`X2018`", "`X2019`", "`X2020`", "`X2021`")
Tipo <- c("Cualitativa", "Cualitativa", "Cualitativa", "Cualitativa", "Cuantitativa discreta", "Cuantitativa discreta", "Cuantitativa discreta", "Cuantitativa discreta", "Cuantitativa discreta", "Cuantitativa discreta")
Escala <- c("Nominal", "Nominal", "Nominal", "Nominal", "Razón", "Razon", "Razon", "Razon", "Razon", "Razon")
Table <- data.frame (Variable, Tipo, Escala)
knitr::kable(Table)
| Variable | Tipo | Escala |
|---|---|---|
Geography
|
Cualitativa | Nominal |
Continent
|
Cualitativa | Nominal |
Category
|
Cualitativa | Nominal |
Data.Type
|
Cualitativa | Nominal |
Unit
|
Cuantitativa discreta | Razón |
X2017
|
Cuantitativa discreta | Razon |
X2018
|
Cuantitativa discreta | Razon |
X2019
|
Cuantitativa discreta | Razon |
X2020
|
Cuantitativa discreta | Razon |
X2021
|
Cuantitativa discreta | Razon |
#Tecnica 1. Remover valores irrelevantes
#Eliminar columnas
externa <-subset (externa, select =-c(Unit))
#Tecnica 2. 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
#¿Tenemos NA en la base de datos?
sum(is.na(externa))
## [1] 4700
#¿Tenemos NA por variable?
sapply(externa,function(x)sum(is.na(x)))
## Geography Continent Category Data.Type X2017 X2018 X2019 X2020
## 0 0 0 0 940 940 940 940
## X2021
## 940
#En caso de tener, borrar los registros NA
externa <- na.omit(externa)
summary(externa)
## Geography Continent Category Data.Type
## Length:54 Length:54 Length:54 Length:54
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## X2017 X2018 X2019 X2020
## Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.00
## 1st Qu.: 78.25 1st Qu.: 71.25 1st Qu.: 60.0 1st Qu.: 41.75
## Median : 274.00 Median : 266.50 Median : 284.5 Median : 260.50
## Mean : 1370.59 Mean : 1335.76 Mean : 1246.0 Mean : 1027.72
## 3rd Qu.: 1265.25 3rd Qu.: 1201.75 3rd Qu.: 1086.5 3rd Qu.: 810.00
## Max. :24807.00 Max. :23529.00 Max. :21360.0 Max. :19994.00
## X2021
## Min. : 0.0
## 1st Qu.: 51.5
## Median : 252.0
## Mean : 1058.9
## 3rd Qu.: 861.5
## Max. :21408.0
#La base de datos queda con 54 observaciones
#Tecnica 3. Agregar valores relevantes
#Se sacó el porcentage de crecimiento entre los años 2017-2021
externa$Crecimiento <- ((externa$X2021-externa$X2017)/externa$X2017)
externa$Crecimiento
## [1] -0.137017777 -0.207115477 -0.084069679 -0.439957492 -0.162248996
## [6] -0.259965338 -0.258838935 -0.479723046 0.002965159 -0.173813170
## [11] -0.347482014 -0.103869654 -0.156976744 -0.508551881 -0.485338121
## [16] -0.628736235 -0.433070866 -0.272616137 -0.337819650 -0.034632035
## [21] 0.043062201 0.156593407 -0.563249001 0.170124481 -0.467961165
## [26] -0.161993769 -0.143322476 -0.276276276 0.685714286 0.603174603
## [31] -0.143478261 -0.039024390 -0.106481481 -0.098039216 -0.263157895
## [36] 0.415730337 0.009174312 0.333333333 4.058823529 -0.283783784
## [41] -0.514285714 0.000000000 -0.620253165 6.500000000 1.500000000
## [46] -0.639344262 -0.222222222 0.000000000 2.000000000 0.000000000
## [51] NaN -1.000000000 NaN -1.000000000
#Analizar los valores de crecimiento de mayor a menor
orden_descendente <- sort(externa$Crecimiento,decreasing=TRUE)
orden_descendente
## [1] 6.500000000 4.058823529 2.000000000 1.500000000 0.685714286
## [6] 0.603174603 0.415730337 0.333333333 0.170124481 0.156593407
## [11] 0.043062201 0.009174312 0.002965159 0.000000000 0.000000000
## [16] 0.000000000 -0.034632035 -0.039024390 -0.084069679 -0.098039216
## [21] -0.103869654 -0.106481481 -0.137017777 -0.143322476 -0.143478261
## [26] -0.156976744 -0.161993769 -0.162248996 -0.173813170 -0.207115477
## [31] -0.222222222 -0.258838935 -0.259965338 -0.263157895 -0.272616137
## [36] -0.276276276 -0.283783784 -0.337819650 -0.347482014 -0.433070866
## [41] -0.439957492 -0.467961165 -0.479723046 -0.485338121 -0.508551881
## [46] -0.514285714 -0.563249001 -0.620253165 -0.628736235 -0.639344262
## [51] -1.000000000 -1.000000000
#Ordenar los valores de crecimiento de mayor a menor
externa <- externa[order(-externa$Crecimiento),]
head(externa)
## Geography Continent Category Data.Type X2017 X2018 X2019
## 44 Belarus Europa Passenger Car Production Unit Volume 4 11 20
## 39 Kazakhstan Asia Passenger Car Production Unit Volume 17 30 44
## 49 Azerbaijan Europa Passenger Car Production Unit Volume 1 1 2
## 45 Egypt Africa Passenger Car Production Unit Volume 10 19 19
## 29 Uzbekistan Asia Passenger Car Production Unit Volume 140 221 271
## 30 Portugal Europa Passenger Car Production Unit Volume 126 234 282
## X2020 X2021 Crecimiento
## 44 21 30 6.5000000
## 39 65 86 4.0588235
## 49 2 3 2.0000000
## 45 24 25 1.5000000
## 29 280 236 0.6857143
## 30 188 202 0.6031746
#write.csv(externa,file="FORM.Externa.limpia",row.names=FALSE)
describe (externa)
## # A tibble: 6 × 26
## descr…¹ n na mean sd se_mean IQR skewn…² kurto…³ p00 p01
## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 X2017 54 0 1.37e+3 3.60e3 490. 1.19e+3 5.57 35.2 0 0
## 2 X2018 54 0 1.34e+3 3.43e3 466. 1.13e+3 5.51 34.4 0 0
## 3 X2019 54 0 1.25e+3 3.15e3 428. 1.03e+3 5.36 32.7 0 0
## 4 X2020 54 0 1.03e+3 2.88e3 392. 7.68e+2 5.76 36.9 0 0
## 5 X2021 54 0 1.06e+3 3.05e3 415. 8.1 e+2 5.95 39.0 0 0
## 6 Crecim… 52 2 8.51e-2 1.19e0 0.165 3.70e-1 4.04 18.7 -1 -1
## # … 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
table(externa$Continent)
##
## Africa America Asia Europa Oceania
## 4 10 18 21 1
proportion <- prop.table(table(externa$Geography,externa$Continent))
proportion %>%
kbl() %>%
kable_styling()
| Africa | America | Asia | Europa | Oceania | |
|---|---|---|---|---|---|
| Algeria | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| Argentina | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Australia | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 |
| Austria | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Azerbaijan | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Bangladesh | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Belarus | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Belgium | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Brazil | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Canada | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Chile | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| China | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Colombia | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Czech Republic | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Ecuador | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Egypt | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| Finland | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| France | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Germany | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Hungary | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| India | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Indonesia | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Iran | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Italy | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Japan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Kazakhstan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Malaysia | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Mexico | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Morocco | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| Myanmar | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Netherlands | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Pakistan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Philippines | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Poland | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Portugal | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Romania | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Russia | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Serbia | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Slovakia | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Slovenia | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| South Africa | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| South Korea | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Spain | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Sweden | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Taiwan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Thailand | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Turkey | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Ukraine | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| United Kingdom | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Uruguay | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| USA | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Uzbekistan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Venezuela | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Vietnam | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
proportion %>%
kbl() %>%
kable_material (c("striped","hover"))
| Africa | America | Asia | Europa | Oceania | |
|---|---|---|---|---|---|
| Algeria | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| Argentina | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Australia | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 |
| Austria | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Azerbaijan | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Bangladesh | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Belarus | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Belgium | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Brazil | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Canada | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Chile | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| China | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Colombia | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Czech Republic | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Ecuador | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Egypt | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| Finland | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| France | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Germany | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Hungary | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| India | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Indonesia | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Iran | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Italy | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Japan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Kazakhstan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Malaysia | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Mexico | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Morocco | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| Myanmar | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Netherlands | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Pakistan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Philippines | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Poland | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Portugal | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Romania | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Russia | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Serbia | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Slovakia | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Slovenia | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| South Africa | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 | 0.0000000 |
| South Korea | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Spain | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Sweden | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Taiwan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Thailand | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Turkey | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Ukraine | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| United Kingdom | 0.0000000 | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 |
| Uruguay | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| USA | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Uzbekistan | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
| Venezuela | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 | 0.0000000 |
| Vietnam | 0.0000000 | 0.0000000 | 0.0185185 | 0.0000000 | 0.0000000 |
location <- CrossTable(externa$Geography, externa$Continent, 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: 54
##
##
## | externa$Continent
## externa$Geography | Africa | America | Asia | Europa | Oceania | Row Total |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Algeria | 1 | 0 | 0 | 0 | 0 | 1 |
## | 11.574 | 0.185 | 0.333 | 0.389 | 0.019 | |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.250 | 0.000 | 0.000 | 0.000 | 0.000 | |
## | 0.019 | 0.000 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Argentina | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Australia | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.389 | 52.019 | |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | |
## | 0.000 | 0.000 | 0.000 | 0.000 | 0.019 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Austria | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Azerbaijan | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Bangladesh | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Belarus | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Belgium | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Brazil | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Canada | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Chile | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## China | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Colombia | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Czech Republic | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Ecuador | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Egypt | 1 | 0 | 0 | 0 | 0 | 1 |
## | 11.574 | 0.185 | 0.333 | 0.389 | 0.019 | |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.250 | 0.000 | 0.000 | 0.000 | 0.000 | |
## | 0.019 | 0.000 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Finland | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## France | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Germany | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Hungary | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## India | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Indonesia | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Iran | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Italy | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Japan | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Kazakhstan | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Malaysia | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Mexico | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Morocco | 1 | 0 | 0 | 0 | 0 | 1 |
## | 11.574 | 0.185 | 0.333 | 0.389 | 0.019 | |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.250 | 0.000 | 0.000 | 0.000 | 0.000 | |
## | 0.019 | 0.000 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Myanmar | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Netherlands | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Pakistan | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Philippines | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Poland | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Portugal | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Romania | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Russia | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Serbia | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Slovakia | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Slovenia | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## South Africa | 1 | 0 | 0 | 0 | 0 | 1 |
## | 11.574 | 0.185 | 0.333 | 0.389 | 0.019 | |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.250 | 0.000 | 0.000 | 0.000 | 0.000 | |
## | 0.019 | 0.000 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## South Korea | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Spain | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Sweden | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Taiwan | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Thailand | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Turkey | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Ukraine | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## United Kingdom | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.074 | 0.185 | 0.333 | 0.960 | 0.019 | |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.000 | 0.048 | 0.000 | |
## | 0.000 | 0.000 | 0.000 | 0.019 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Uruguay | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## USA | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Uzbekistan | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Venezuela | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.074 | 3.585 | 0.333 | 0.389 | 0.019 | |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.100 | 0.000 | 0.000 | 0.000 | |
## | 0.000 | 0.019 | 0.000 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Vietnam | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.074 | 0.185 | 1.333 | 0.389 | 0.019 | |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.019 |
## | 0.000 | 0.000 | 0.056 | 0.000 | 0.000 | |
## | 0.000 | 0.000 | 0.019 | 0.000 | 0.000 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Column Total | 4 | 10 | 18 | 21 | 1 | 54 |
## | 0.074 | 0.185 | 0.333 | 0.389 | 0.019 | |
## ------------------|-----------|-----------|-----------|-----------|-----------|-----------|
##
##
kbl(location) %>%
kable_classic()
|
|
|
|
#Bar plot
#En dicha grafica se observan las cantidad de autos producidos en cada continente.
Paises <- data.frame(externa$Continent, externa$X2021)
colnames(Paises)<-c('Continent','2021')
ggplot(data = Paises, aes (x=Continent, y=2021)) +
geom_bar(stat = "identity", fill="orange") + scale_fill_grey() + # Add bars to the plot
labs(title = "Produccion de autos 2021", # Add a title
y="Autos producidos")
#Diagrama de dispersion
#En la siguiente grafica se observa la dispersion de la cantidad de autos producidos totales durante el 2021
qqnorm(externa$X2021, main="Grafica de dispersion", ylab="Produccion en 2021",col='#FF7F24')
qqline(externa$X2021, col='#FF7F24')
plot(externa$X2020,externa$X2021,main="Influencia del 2020 sobre la produccion de autos en 2021",xlab="2020",ylab="2021", col="orange")
El primer modelo predictivo, en este caso, analiza la variable dependiente siendo el año de produccion 2021, mientras que para las variables exploratorias se tomaron en cuenta unicamente los dos años mas recientes siendo 2019 y 2020.
regresion <- lm(X2021~ X2019 + X2020, data=externa)
summary (regresion)
##
## Call:
## lm(formula = X2021 ~ X2019 + X2020, data = externa)
##
## Residuals:
## Min 1Q Median 3Q Max
## -508.66 -29.06 -10.80 16.29 767.72
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 13.4201 28.2568 0.475 0.63686
## X2019 -0.3121 0.1011 -3.087 0.00327 **
## X2020 1.3957 0.1104 12.644 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 174 on 51 degrees of freedom
## Multiple R-squared: 0.9969, Adjusted R-squared: 0.9967
## F-statistic: 8109 on 2 and 51 DF, p-value: < 2.2e-16
datos_nuevos <- data.frame(X2019=1800, X2020=1000)
predict(regresion,datos_nuevos)
## 1
## 847.2813
ggplot(externa, aes(x=X2020, y=X2021))+
geom_point() +
geom_line(aes(y=X2021), color="blue", linetype="dashed") +
geom_line(aes(y=X2020), color="red", linetype="dashed") +
geom_smooth(method=lm, formula=y~x, se=TRUE, level=0.95, col='orange', fill='pink2') +
theme_light()
En este primer modelo se observa que la variable del año 2020 tiene mayor impacto en el resultado de la produccion de 2021.
El segundo modelo predictivo, analiza la misma variable dependiente siendo el año de produccion 2021, pero con las variables exploratorias de los dos años mas antiguos de la base, siendo 2017 y 2018.
plot(externa$X2018,externa$X2021,main="Influencia del 2018 sobre la produccion de autos en 2021",xlab="2018",ylab="2021", col="orange")
regresion1 <- lm(X2021~ X2017 + X2018, data=externa)
summary (regresion1)
##
## Call:
## lm(formula = X2021 ~ X2017 + X2018, data = externa)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1130.56 -15.87 89.55 136.33 752.57
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -136.0214 44.6872 -3.044 0.00369 **
## X2017 -0.3861 0.3499 -1.103 0.27501
## X2018 1.2907 0.3675 3.512 0.00094 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 296.1 on 51 degrees of freedom
## Multiple R-squared: 0.9909, Adjusted R-squared: 0.9906
## F-statistic: 2783 on 2 and 51 DF, p-value: < 2.2e-16
datos_nuevos1 <- data.frame(X2017=2300, X2018=1800)
predict(regresion1,datos_nuevos1)
## 1
## 1299.249
ggplot(externa, aes(x=X2018, y=X2021))+
geom_point() +
geom_line(aes(y=X2021), color="blue", linetype="dashed") +
geom_line(aes(y=X2018), color="red", linetype="dashed") +
geom_smooth(method=lm, formula=y~x, se=TRUE, level=0.95, col='orange', fill='orange') +
theme_light()
En este segundo modelo, se observa que tiene una mayor relacion la variable del año 2018 en la produccion del 2021.
Con base en los resultados anteriores, se realizo un tercer modelo en donde se establecieron las variables del año 2018 y 2020
plot(externa$X2018,externa$X2021,main="Influencia del 2018 sobre la produccion de autos en 2021",xlab="2018",ylab="2021", col="orange")
regresion2 <- lm(X2021~ X2018 + X2020, data=externa)
summary (regresion2)
##
## Call:
## lm(formula = X2021 ~ X2018 + X2020, data = externa)
##
## Residuals:
## Min 1Q Median 3Q Max
## -705.86 -18.50 11.07 27.60 718.52
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -10.2539 30.1392 -0.340 0.735
## X2018 -0.1377 0.1146 -1.201 0.235
## X2020 1.2193 0.1363 8.946 4.98e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 186.9 on 51 degrees of freedom
## Multiple R-squared: 0.9964, Adjusted R-squared: 0.9962
## F-statistic: 7023 on 2 and 51 DF, p-value: < 2.2e-16
datos_nuevos2 <- data.frame(X2018=1800, X2020=1000)
predict(regresion2,datos_nuevos2)
## 1
## 961.1717
ggplot(externa, aes(x=X2020, y=X2021))+
geom_point() +
geom_line(aes(y=X2021), color="blue", linetype="dashed") +
geom_line(aes(y=X2018), color="red", linetype="dashed") +
geom_smooth(method=lm, formula=y~x, se=TRUE, level=0.95, col='orange', fill='orange') +
theme_light()
Finalmente, nos podemos dar cuenta de que la variable que mayor impacto tiene en la variable dependiente, en este caso, la produccion anual de autos en 2021 a nivel mundial, es la produccion de autos en 2020. Siendo que existe una relacion logica entre los años mas recientes y la cercania con la prediccion en 2021. Por lo que, una estimacion mas aproximada conforme a la produccion, corresponde al impacto del 2020 en 2021, pudiendose observar los cambios y/o alteraciones en el periodo como pudiese ser la afectacion por la pandemia de Covid 19.
merma <- c(14560,22830,22470,18820,23410,18280,19370,32100,13586) mer1 <- ts(data = merma, start = c(2022,1), frequency = 12) produccion_st
modelo <- auto.arima(mer1) modelo
mer2 <- forecast(modelo, level=c(95), h=3) mer2 plot(mer2)
La gráfica muestra el pronóstico que se tiene para los siguientes tres periodos, tomando en cuenta la base de datos de merma. En el código se ingreso un 95% de confiabilidad y eso explica lo ancho del área gris en la gráfica. Para los siguiente tres meses se pronóstica una merma de 20602 kilos y gracias a esto podemos anticipar la carga que se va a tener en el futuro e ir implementando nuevas maneras de desechar o reutilizar la merma para que no se acumule con la merma de los meses pasados. La merma mínima que se tiene pronosticada es de 9770.71 kg. y la máxima de 31435 kg.
¿Qué es Business Analytics? Business Analytics es conocido como un conjunto de disciplinas y tecnologías para resolver problemas que surgen en una empresa, sin embargo la manera de resolver estos problemas es mediante un análisis de los datos de la empresa. Para llevar esto a cabo se necesita un equipo de trabajo capacitado en el uso de tecnologías que ayuden a la solución de problemas y saber de que manera interpretar la información para la solución de problemas.
Describir brevemente 3 objetivos deL uso de la herramienta de Business Analytics
De acuerdo con el sitio web techtarget algunos de los objetivos que tiene esta herramienta son, seleccionar una metodología de análisis, obtener datos comerciales para respaldar el análisis, limpiar e integrar datos en un solo repositorio, como un almacén de datos o un data mart.
¿Cuál es la relación entre Business Analytics y Business Intelligence? La relación principal entre business analytics y business intelligence es Que los datos recopilados para business intelligence son los datos necesarios para las bases de business analytics, esto significa que ambos van de la mano en todo momento para que así con la ayuda de los datos proporcionados las empresas puedan decidir qué áreas a analizar o que áreas necesitan ayuda utilizando un análisis de negocios