Por: Lesly Darian Romero Vazquez - A01771127
El análisis exploratorio de los datos (EDA, por sus siglas en inglés) es un enfoque en estadística que se enfoca en inspeccionar, limpiar y modelar conjuntos de datos con el objetivo de descubrir patrones, anomalías, tendencias y relaciones entre variables, que no se habrían identificado mediante métodos estadísticos formales. Este tipo de análisis es fundamental en la fase preliminar de cualquier proyecto de datos y se utiliza ampliamente antes de realizar inferencias estadísticas más complejas o construir modelos predictivos.
El EDA es fundamentalmente visual y descriptivo, empleando una variedad de técnicas gráficas y cuantitativas para analizar los datos. Entre las herramientas más comunes se encuentran los histogramas, diagramas de dispersión, gráficos de caja y bigotes (box plots), y mapas de calor, los cuales permiten a los analistas y científicos de datos observar las distribuciones y relaciones de las variables de manera intuitiva. Además, el EDA involucra el uso de estadísticas descriptivas, como la media, mediana, moda, varianza, y correlación para resumir las características principales de los conjuntos de datos.
Una parte crucial del EDA es la limpieza de datos, que incluye la identificación y manejo de valores atípicos, datos faltantes y errores de entrada, asegurando así la calidad y fiabilidad de los análisis posteriores. El EDA también puede implicar la transformación de datos, donde se modifican o se crean nuevas variables para facilitar el análisis.
El análisis exploratorio de los datos contribuye significativamente a mejorar tanto el proceso como los resultados de la analítica descriptiva de varias maneras:
En 2033 seremos una de las cinco mejores compañías de México que generan valor dentro de la cadena de suministro de las industrias que más valoran la forma en la que se protegen y trasladan las cosas.
Transformar nuestro entorno y resolver retos industriales de nuestros clientes a través de la colaboración, provocando nuevas oportunidades que potencian nuestro modelo de negocio, para alcanzar nuestros ideales.
** La producción de vehículos y autopartes en USA es muy centralizada, frente a un mercado mexicano que esta más diluido. ** Importante barrera de entrada para el resto de organizaciones que buscan competir en este mercado. ** Siguen distintas tendencias comerciales.
** Industria de de productos de cartón y papel esta en una tendencia creciente. ** Exportaciones de Autos en México parece tener estacionalidad. ** Se espera que para el primer trimestre del 2024 haya un incremento en exportaciones.
Los principales factores del clima organizacional de FORM que propician la satisfacción y/o no satisfacción de trabajar en dicha empresa.
Librerías
library(syuzhet)
library(tm)
library(wordcloud)
library(ggplot2)
library(dplyr)
library(readr)
library(naniar)
library(RColorBrewer)
library(regclass)
library(mctest)
library(lmtest)
library(caret)
library(e1071)
library(SparseM)
library(Metrics)
library(jtools)
library(DiagrammeR)
library(effects)
library(scales)
library(DataExplorer)
library(corrr)
library(tidyverse)
library(readxl)
library(gmodels)
library(gridExtra)
library(readtext)
library(dlookr)
df <- read_xlsx("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\BD_FORM.xlsx")
df1 <- read.csv("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\Datos_FORM_RH.csv")
# Visualizar estructura interna del data frame
str(df)
## tibble [106 × 22] (S3: tbl_df/tbl/data.frame)
## $ id : num [1:106] 1 2 3 4 5 6 7 8 9 10 ...
## $ puesto_trabajo : chr [1:106] "Administrativo" "Costurera" "Ayudante general" "Ayudante general" ...
## $ antiguedad : num [1:106] 9 36 4 2 1 36 36 36 36 1 ...
## $ razon_trabajo : chr [1:106] "Por el salario" "Otro" "Ubicación de la empresa" "Ubicación de la empresa" ...
## $ salario : chr [1:106] "Totalmente de acuerdo" "Medianamente de acuerdo" "Medianamente en desacuerdo" "Totalmente de acuerdo" ...
## $ prestaciones : chr [1:106] "Medianamente de acuerdo" "Medianamente de acuerdo" "Totalmente en desacuerdo" "Medianamente de acuerdo" ...
## $ jornada_laboral : chr [1:106] "Totalmente de acuerdo" "Totalmente de acuerdo" "Totalmente en desacuerdo" "Totalmente de acuerdo" ...
## $ desemp_aprend : chr [1:106] "Totalmente de acuerdo" "Medianamente de acuerdo" "Totalmente en desacuerdo" "Totalmente de acuerdo" ...
## $ clima : chr [1:106] "Medianamente en desacuerdo" "Ni de acuerdo ni en desacuerdo" "Ni de acuerdo ni en desacuerdo" "Medianamente de acuerdo" ...
## $ estres : chr [1:106] "Totalmente de acuerdo" "Medianamente en desacuerdo" "Totalmente en desacuerdo" "Totalmente de acuerdo" ...
## $ transporte : chr [1:106] "Medianamente de acuerdo" "Medianamente en desacuerdo" "Medianamente de acuerdo" "Totalmente de acuerdo" ...
## $ zona_trabajo : chr [1:106] "Totalmente de acuerdo" "Medianamente de acuerdo" "Medianamente de acuerdo" "Totalmente de acuerdo" ...
## $ futuro_form : chr [1:106] "Medianamente de acuerdo" "Totalmente de acuerdo" "Totalmente en desacuerdo" "Medianamente de acuerdo" ...
## $ inseguridad : chr [1:106] "No" "No" "Si" "No" ...
## $ ins_puesto_actual : chr [1:106] "Cotización ante IMSS, fecha de pago, comer a las 3pm" "NA" "Mucho trabajo, estrés" "NA" ...
## $ op_form : chr [1:106] "A gusto, feliz" "Bien" "Cómoda, no satisfecha" "Tranquila y contenta" ...
## $ edad : chr [1:106] "30" "54" "21" "20" ...
## $ genero : chr [1:106] "Femenino" "Femenino" "Femenino" "Femenino" ...
## $ estado_civil : chr [1:106] "Unión libre" "Casado" "Soltero" "Casado" ...
## $ municipio_residencia: chr [1:106] "Apodaca" "Apodaca" "Apodaca" "Apodaca" ...
## $ escolaridad : chr [1:106] "Licenciatura" "Primaria" "Preparatoria" "Preparatoria" ...
## $ dep_econ : num [1:106] 0 0 0 0 0 2 1 0 0 2 ...
# Seleccionar información y datos relevantes para responder las preguntas de análisis
# Eliminar columna id
df <- subset(df, select = -id)
names(df)
## [1] "puesto_trabajo" "antiguedad" "razon_trabajo"
## [4] "salario" "prestaciones" "jornada_laboral"
## [7] "desemp_aprend" "clima" "estres"
## [10] "transporte" "zona_trabajo" "futuro_form"
## [13] "inseguridad" "ins_puesto_actual" "op_form"
## [16] "edad" "genero" "estado_civil"
## [19] "municipio_residencia" "escolaridad" "dep_econ"
# Al visualizar la estructura interna del data frame, es poisble observar que algunos valores son representados por la palabra "NA", la cual está siendo identificada como un carácter. En este caso, sustituiremos la palabra "NA" por el tipo de dato NA.
df[df == "NA"] <- NA
# Contar la cantidad total de NA's en el data frame
sum(is.na(df))
## [1] 36
# Conocer cuántos datos faltantes hay por columna
colSums(is.na(df))
## puesto_trabajo antiguedad razon_trabajo
## 0 0 0
## salario prestaciones jornada_laboral
## 0 0 0
## desemp_aprend clima estres
## 0 0 0
## transporte zona_trabajo futuro_form
## 0 0 0
## inseguridad ins_puesto_actual op_form
## 0 36 0
## edad genero estado_civil
## 0 0 0
## municipio_residencia escolaridad dep_econ
## 0 0 0
# Con esto podemos ver que los 36 datos faltantes se encuentran en la columna ins_puesto_actual. La columna contiene las respuestas de cada entrevistado para la pregunta ¿qué aspectos de tu puesto actual te resultan menos satisfactorios?. En este caso, los NA's son interpretados de la siguiente manera: el colaborador no califica ningún aspecto de su puesto actual como menos satisfactorio.
# Sustituir los valores NA por la palabra "Ninguno"
df$ins_puesto_actual[is.na(df$ins_puesto_actual)] <- "Ninguno"
# Al visualizar la estructura interna del data frame, es poisble observar que algunas columnas no corresponden al tipo de datos que deberían.
# Convertir las columnas seleccionadas a factores
categoricas <- c("puesto_trabajo","razon_trabajo","salario","prestaciones","jornada_laboral","desemp_aprend","clima","estres","transporte","zona_trabajo","futuro_form","inseguridad","genero","estado_civil","municipio_residencia","escolaridad")
# Usar lapply para aplicar la función as.factor a las columnas seleccionadas
df[categoricas] <- lapply(df[categoricas], as.factor)
# Convertir las columnas seleccionadas a enteros
df$antiguedad <- as.integer(df$antiguedad)
df$edad <- as.integer(df$edad)
df$dep_econ <- as.integer(df$dep_econ)
# Revisar que las columnas tengan el tipo de dato correcto
str(df)
## tibble [106 × 21] (S3: tbl_df/tbl/data.frame)
## $ puesto_trabajo : Factor w/ 25 levels "Administrativo",..: 1 7 3 3 3 3 3 1 7 3 ...
## $ antiguedad : int [1:106] 9 36 4 2 1 36 36 36 36 1 ...
## $ razon_trabajo : Factor w/ 6 levels "Ambiente de trabajo",..: 3 2 6 6 6 5 6 5 3 3 ...
## $ salario : Factor w/ 5 levels "Medianamente de acuerdo",..: 4 1 2 4 3 1 2 4 1 4 ...
## $ prestaciones : Factor w/ 5 levels "Medianamente de acuerdo",..: 1 1 5 1 5 4 3 1 5 1 ...
## $ jornada_laboral : Factor w/ 5 levels "Medianamente de acuerdo",..: 4 4 5 4 4 4 1 4 1 4 ...
## $ desemp_aprend : Factor w/ 5 levels "Medianamente de acuerdo",..: 4 1 5 4 4 4 1 4 5 4 ...
## $ clima : Factor w/ 5 levels "Medianamente de acuerdo",..: 2 3 3 1 1 2 2 1 4 5 ...
## $ estres : Factor w/ 5 levels "Medianamente de acuerdo",..: 4 2 5 4 3 1 4 1 1 4 ...
## $ transporte : Factor w/ 5 levels "Medianamente de acuerdo",..: 1 2 1 4 5 4 5 4 4 2 ...
## $ zona_trabajo : Factor w/ 5 levels "Medianamente de acuerdo",..: 4 1 1 4 4 1 1 4 4 4 ...
## $ futuro_form : Factor w/ 5 levels "Medianamente de acuerdo",..: 1 4 5 1 3 4 3 4 4 4 ...
## $ inseguridad : Factor w/ 3 levels "No","Prefiero no decirlo",..: 1 1 3 1 1 1 3 1 3 1 ...
## $ ins_puesto_actual : chr [1:106] "Cotización ante IMSS, fecha de pago, comer a las 3pm" "Ninguno" "Mucho trabajo, estrés" "Ninguno" ...
## $ op_form : chr [1:106] "A gusto, feliz" "Bien" "Cómoda, no satisfecha" "Tranquila y contenta" ...
## $ edad : int [1:106] 30 54 21 20 43 61 55 29 56 36 ...
## $ genero : Factor w/ 2 levels "Femenino","Masculino": 1 1 1 1 1 1 1 2 1 1 ...
## $ estado_civil : Factor w/ 4 levels "Casado","Divorciado",..: 4 1 3 1 3 4 1 3 3 4 ...
## $ municipio_residencia: Factor w/ 6 levels "Apodaca","Guadalupe",..: 1 1 1 1 3 1 1 1 1 1 ...
## $ escolaridad : Factor w/ 5 levels "Licenciatura",..: 1 4 3 3 5 5 5 1 5 5 ...
## $ dep_econ : int [1:106] 0 0 0 0 0 2 1 0 0 2 ...
# Confirmar ausencia de NA's en el data frame
any(is.na(df))
## [1] FALSE
# Visualizar los primeros 6 renglones de la nueva base de datos
head(df)
## # A tibble: 6 × 21
## puesto_trabajo antiguedad razon_trabajo salario prestaciones jornada_laboral
## <fct> <int> <fct> <fct> <fct> <fct>
## 1 Administrativo 9 Por el salar… Totalm… Medianament… Totalmente de …
## 2 Costurera 36 Otro Median… Medianament… Totalmente de …
## 3 Ayudante general 4 Ubicación de… Median… Totalmente … Totalmente en …
## 4 Ayudante general 2 Ubicación de… Totalm… Medianament… Totalmente de …
## 5 Ayudante general 1 Ubicación de… Ni de … Totalmente … Totalmente de …
## 6 Ayudante general 36 Razones pers… Median… Totalmente … Totalmente de …
## # ℹ 15 more variables: desemp_aprend <fct>, clima <fct>, estres <fct>,
## # transporte <fct>, zona_trabajo <fct>, futuro_form <fct>, inseguridad <fct>,
## # ins_puesto_actual <chr>, op_form <chr>, edad <int>, genero <fct>,
## # estado_civil <fct>, municipio_residencia <fct>, escolaridad <fct>,
## # dep_econ <int>
Más información: Glosario de variables
str(df1)
## 'data.frame': 106 obs. of 23 variables:
## $ ID : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Puesto_trabajo : chr "Administrativo" "Costurera" "Ayudante general" "Ayudante general" ...
## $ Puesto_otro : chr "" "" "" "" ...
## $ Antigüedad_meses: int 9 36 4 2 1 36 36 36 36 1 ...
## $ p1 : chr "Por el salario" "Otro" "Ubicación de la empresa" "Ubicación de la empresa" ...
## $ p2 : chr "Totalmente de acuerdo" "Medianamente de acuerdo" "Medianamente en desacuerdo" "Totalmente de acuerdo" ...
## $ p3 : chr "Medianamente de acuerdo" "Medianamente de acuerdo" "Totalmente en desacuerdo" "Medianamente de acuerdo" ...
## $ p4 : chr "Totalmente de acuerdo" "Totalmente de acuerdo" "Totalmente en desacuerdo" "Totalmente de acuerdo" ...
## $ p5 : chr "Totalmente de acuerdo" "Medianamente de acuerdo" "Totalmente en desacuerdo" "Totalmente de acuerdo" ...
## $ p6 : chr "Medianamente en desacuerdo" "Ni de acuerdo ni en desacuerdo" "Ni de acuerdo ni en desacuerdo" "Medianamente de acuerdo" ...
## $ p7 : chr "Totalmente de acuerdo" "Medianamente en desacuerdo" "Totalmente en desacuerdo" "Totalmente de acuerdo" ...
## $ p8 : chr "Medianamente de acuerdo" "Medianamente en desacuerdo" "Medianamente de acuerdo" "Totalmente de acuerdo" ...
## $ p9 : chr "Totalmente de acuerdo" "Medianamente de acuerdo" "Medianamente de acuerdo" "Totalmente de acuerdo" ...
## $ p10 : chr "Medianamente de acuerdo" "Totalmente de acuerdo" "Totalmente en desacuerdo" "Medianamente de acuerdo" ...
## $ p11 : chr "No" "No" "Si" "No" ...
## $ p12 : chr "cotización ante imss, fecha de pago, comer a las 3pm" "Ninguno" "mucho trabajo, estrés" "Todo bien " ...
## $ p13 : chr "agusto, feliz" "Bien" "cómoda, no satisfecha" "Tranquila y contenta " ...
## $ Edad : int 30 54 21 20 43 61 55 29 56 36 ...
## $ Género : chr "Femenino" "Femenino" "Femenino" "Femenino" ...
## $ Estado_civil : chr "Unión libre" "Casado" "Soltero" "Casado" ...
## $ Residencia : chr "Apodaca" "Apodaca" "Apodaca" "Apodaca" ...
## $ Escolaridad : chr "Licenciatura" "Primaria" "Preparatoria" "Preparatoria" ...
## $ Dependientes : int 0 0 0 0 0 2 1 0 0 2 ...
colnames(df1)
## [1] "ID" "Puesto_trabajo" "Puesto_otro" "Antigüedad_meses"
## [5] "p1" "p2" "p3" "p4"
## [9] "p5" "p6" "p7" "p8"
## [13] "p9" "p10" "p11" "p12"
## [17] "p13" "Edad" "Género" "Estado_civil"
## [21] "Residencia" "Escolaridad" "Dependientes"
Cambio de columnas para variables en base de datos “df1”
summary(df)
## puesto_trabajo antiguedad razon_trabajo
## Ayudante general:46 Min. : 1.00 Ambiente de trabajo :13
## Administrativo :17 1st Qu.: 1.00 Otro :21
## Costurera : 7 Median : 9.00 Por el salario :19
## Supervisor(a) : 6 Mean :14.08 Prestaciones : 2
## Montacarguista : 3 3rd Qu.:34.50 Razones personales :19
## Operador : 3 Max. :36.00 Ubicación de la empresa:32
## (Other) :24
## salario prestaciones
## Medianamente de acuerdo :35 Medianamente de acuerdo :22
## Medianamente en desacuerdo :11 Medianamente en desacuerdo :19
## Ni de acuerdo ni en desacuerdo: 8 Ni de acuerdo ni en desacuerdo:10
## Totalmente de acuerdo :41 Totalmente de acuerdo :34
## Totalmente en desacuerdo :11 Totalmente en desacuerdo :21
##
##
## jornada_laboral desemp_aprend
## Medianamente de acuerdo :19 Medianamente de acuerdo :15
## Medianamente en desacuerdo : 6 Medianamente en desacuerdo : 2
## Ni de acuerdo ni en desacuerdo:10 Ni de acuerdo ni en desacuerdo: 9
## Totalmente de acuerdo :63 Totalmente de acuerdo :60
## Totalmente en desacuerdo : 8 Totalmente en desacuerdo :20
##
##
## clima estres
## Medianamente de acuerdo :14 Medianamente de acuerdo :21
## Medianamente en desacuerdo : 7 Medianamente en desacuerdo : 9
## Ni de acuerdo ni en desacuerdo:12 Ni de acuerdo ni en desacuerdo:20
## Totalmente de acuerdo :38 Totalmente de acuerdo :43
## Totalmente en desacuerdo :35 Totalmente en desacuerdo :13
##
##
## transporte zona_trabajo
## Medianamente de acuerdo :14 Medianamente de acuerdo :18
## Medianamente en desacuerdo : 9 Medianamente en desacuerdo : 5
## Ni de acuerdo ni en desacuerdo: 2 Ni de acuerdo ni en desacuerdo: 4
## Totalmente de acuerdo :66 Totalmente de acuerdo :71
## Totalmente en desacuerdo :15 Totalmente en desacuerdo : 8
##
##
## futuro_form inseguridad
## Medianamente de acuerdo :21 No :89
## Medianamente en desacuerdo : 5 Prefiero no decirlo: 1
## Ni de acuerdo ni en desacuerdo:15 Si :16
## Totalmente de acuerdo :56
## Totalmente en desacuerdo : 9
##
##
## ins_puesto_actual op_form edad genero
## Length:106 Length:106 Min. :18.00 Femenino :69
## Class :character Class :character 1st Qu.:25.25 Masculino:37
## Mode :character Mode :character Median :33.50
## Mean :35.62
## 3rd Qu.:45.00
## Max. :68.00
##
## estado_civil municipio_residencia escolaridad dep_econ
## Casado :38 Apodaca :77 Licenciatura:24 Min. :0.000
## Divorciado : 1 Guadalupe: 4 Otro : 3 1st Qu.:0.000
## Soltero :47 Juárez :12 Preparatoria:27 Median :1.000
## Unión libre:20 Monterrey: 3 Primaria : 9 Mean :1.085
## Otro : 6 Secundaria :43 3rd Qu.:2.000
## Pesquería: 4 Max. :3.000
##
describe(df)
## # A tibble: 3 × 26
## described_variables n na mean sd se_mean IQR skewness kurtosis
## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 antiguedad 106 0 14.1 14.5 1.41 33.5 0.629 -1.33
## 2 edad 106 0 35.6 12.2 1.18 19.8 0.473 -0.853
## 3 dep_econ 106 0 1.08 1.10 0.106 2 0.492 -1.14
## # ℹ 17 more variables: p00 <dbl>, p01 <dbl>, 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>
# Seleccionar solo las columnas con tipo de dato factor para los gráficos de barras
# Seleccionar y graficar las variables demográficas
plot_bar(df %>%
select(genero,estado_civil,municipio_residencia,escolaridad))
# Graficar las variables en escala likert
plot_bar(df %>%
select(salario, prestaciones, jornada_laboral, desemp_aprend, clima, estres, transporte, zona_trabajo, futuro_form))
# Seleccionar y graficar el resto de las variables categóricas
plot_bar(df %>%
select(puesto_trabajo, razon_trabajo, inseguridad))
library(dplyr)
# Cambiamos las respuestas de la escala de Likert a números para clasificar las respuestas
df1 <- df1 %>%
dplyr::mutate(p6_Escala = dplyr::recode(p6,
"Totalmente en desacuerdo" = 1,
"Medianamente en desacuerdo" = 2,
"Ni de acuerdo ni en desacuerdo" = 3,
"Medianamente de acuerdo" = 4,
"Totalmente de acuerdo" = 5))
frecuencias <- table(df1$Puesto_trabajo, df1$p6_Escala)
Graficamos las respuestas bajo la siguiente llave.
ggplot(data = as.data.frame.table(frecuencias), aes(x = Var1, y = Var2, fill = Freq)) +
geom_tile() +
scale_fill_gradient(low = "skyblue", high = "blue") +
labs(x = "Puesto de Trabajo", y = "Totalmente en desacuerdo a totalmente de acuerdo", fill = "Frecuencia") +
ggtitle("Que haga mucho frío o calor en mi área de trabajo no es algo que me moleste") +
theme_minimal()
# En este caso se creará una copia del dataframe df
df_likert <- df
# Las variables con respuestas en escala likert serán convertidas a enteros para facilitar su análisis en el EDA
df_likert <- df_likert %>%
mutate(across(c("salario", "prestaciones", "jornada_laboral", "desemp_aprend", "clima", "estres", "transporte", "zona_trabajo", "futuro_form"), ~recode(.,
"Totalmente en desacuerdo" = 1,
"Medianamente en desacuerdo" = 2,
"Ni de acuerdo ni en desacuerdo" = 3,
"Medianamente de acuerdo" = 4,
"Totalmente de acuerdo" = 5)))
# Confirmar que la conversión no genere valores nulos
#any(is.na(df_likert))
Los siguientes gráficos representan únicamente la información obtenida de la encuesta.
# Histograma de edad
ggplot(df, aes(x = edad)) +
geom_histogram(binwidth = 5, fill = "#FF8000", color = "black") + # Puedes ajustar el ancho del bin según tus datos
labs(title = "Histograma de Edad", subtitle = "Encuesta FORM, Otoño 2023", x = "Edad (años)", y = "Frecuencia")
# Porcentaje de respuestas por género
CrossTable(df_likert$genero, prop.c = FALSE, prop.t = FALSE, prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## |-------------------------|
##
##
## Total Observations in Table: 106
##
##
## | Femenino | Masculino |
## |-----------|-----------|
## | 69 | 37 |
## | 0.651 | 0.349 |
## |-----------|-----------|
##
##
##
##
# Tabla cruzada municipio_residencia y transporte
CrossTable(df_likert$municipio_residencia, df_likert$transporte, prop.c = FALSE, prop.t = FALSE, prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## |-------------------------|
##
##
## Total Observations in Table: 106
##
##
## | df_likert$transporte
## df_likert$municipio_residencia | 1 | 2 | 3 | 4 | 5 | Row Total |
## -------------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Apodaca | 10 | 4 | 1 | 9 | 53 | 77 |
## | 0.130 | 0.052 | 0.013 | 0.117 | 0.688 | 0.726 |
## -------------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Guadalupe | 0 | 1 | 0 | 0 | 3 | 4 |
## | 0.000 | 0.250 | 0.000 | 0.000 | 0.750 | 0.038 |
## -------------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Juárez | 4 | 3 | 0 | 3 | 2 | 12 |
## | 0.333 | 0.250 | 0.000 | 0.250 | 0.167 | 0.113 |
## -------------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Monterrey | 0 | 0 | 0 | 0 | 3 | 3 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.028 |
## -------------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Otro | 1 | 1 | 0 | 1 | 3 | 6 |
## | 0.167 | 0.167 | 0.000 | 0.167 | 0.500 | 0.057 |
## -------------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Pesquería | 0 | 0 | 1 | 1 | 2 | 4 |
## | 0.000 | 0.000 | 0.250 | 0.250 | 0.500 | 0.038 |
## -------------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Column Total | 15 | 9 | 2 | 14 | 66 | 106 |
## -------------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
##
##
Interpretación de los valores enteros (columnas de la tabla):
Totalmente en desacuerdo = 1
Medianamente en desacuerdo = 2
Ni de acuerdo ni en desacuerdo = 3
Medianamente de acuerdo = 4
Totalmente de acuerdo = 5
# Razón de trabajo por género
# Filtrar el DataFrame por género
df_femenino <- df_likert[df_likert$genero == 'Femenino', ]
df_masculino <- df_likert[df_likert$genero == 'Masculino', ]
# Calcular frecuencias de razon_trabajo
fem_razon_trabajo <- table(df_femenino$razon_trabajo)
masc_razon_trabajo <- table(df_masculino$razon_trabajo)
# Ordenar frecuencias
ord_fem <- names(sort(table(df_femenino$razon_trabajo), decreasing = TRUE))
ord_masc <- names(sort(table(df_masculino$razon_trabajo), decreasing = TRUE))
# Crear las gráficas de frecuencias
ggplot(data = as.data.frame(fem_razon_trabajo), aes(x = factor(Var1, levels = ord_fem), y = Freq)) +
geom_bar(stat = "identity", fill = "#E7236F") +
labs(title = "Razón de trabajo género femenino", subtitle = "Encuesta FORM, Otoño 2023",
x = "Razón trabajo",
y = "Frecuencia")
ggplot(data = as.data.frame(masc_razon_trabajo), aes(x = factor(Var1, levels = ord_masc), y = Freq)) +
geom_bar(stat = "identity", fill = "#494D8A") +
labs(title = "Razón de trabajo género masculino", subtitle = "Encuesta FORM, Otoño 2023",
x = "Razón trabajo",
y = "Frecuencia")
A continuación, el análisis de sentimientos a la pregunta “¿Cómo te sientes en FORM?” En donde se resaltan los sentimiento de confianza y alegría como las principales vías que usaron los trabajadores para referirse a su estadía en FORM. Si bien también se registraron respuestas que hacen referencia a emociones negativas, la suma de todas ellas apenas es comparable con los sentimientos mencionados al inicio. A partir de este análisis es posible concluir que muy posiblemente el ambiente organizacional dentro de FORM y la relación que tienen los empleados con la empresa no son los problemas o principales causes que generan una alta rotación de personal.
Si bien también se mapeó la progresión emocional de las respuestas, al tratárse únicamente de encuestas individuales.
texto_palabras <- get_tokens(df1$p13)
emociones_df <- get_nrc_sentiment(texto_palabras, language = "spanish")
barras <- barplot(colSums(prop.table(emociones_df[, 1:8])))
respuestas <- get_tokens(df1$p13)
emociones_df_2 <- get_nrc_sentiment(respuestas, language = "spanish")
sentimientos <- (emociones_df_2$negative*-1) + emociones_df_2$positive
simple_plot(sentimientos)
Y ahora contrastando las opiniones por género
# Análisis de sentimientos de la columna op_form por género
opinion_fem <- get_tokens(df_femenino$op_form)
emociones_df <- get_nrc_sentiment(opinion_fem, language = "spanish")
barplot(colSums(prop.table(emociones_df[,1:8])),
main = "F: ¿Cómo te sientes en FORM?",
xlab = "Emociones",
ylab = "Frecuencia")
opinion_masc <- get_tokens(df_masculino$op_form)
emociones_df <- get_nrc_sentiment(opinion_masc, language = "spanish")
barplot(colSums(prop.table(emociones_df[,1:8])),
main = "M: ¿Cómo te sientes en FORM?",
xlab = "Emociones",
ylab = "Frecuencia")
Después nos enfocaremos en los principales dolores que tienen los trabajadores.
text <- read_lines("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\p12.txt")
corpus <- Corpus(VectorSource(text))
corpus <- tm_map(corpus, content_transformer(tolower))
corpus <- tm_map(corpus, removePunctuation)
corpus <- tm_map(corpus, removeNumbers)
corpus <- tm_map(corpus, removeWords, stopwords("spa"))
tdm <- TermDocumentMatrix(corpus)
m <- as.matrix(tdm)
frecuencia <- sort(rowSums(m), decreasing = TRUE)
frecuencia_df <- data.frame(word=names(frecuencia), freq = frecuencia)
# Análisis insatisfacción puesto actual
texto_ins <- read_lines("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\ins_puesto_actual.txt")
corpus_1 <- Corpus(VectorSource(texto_ins))
corpus_1 <- tm_map(corpus_1, content_transformer(tolower))
corpus_1 <- tm_map(corpus_1, removePunctuation)
corpus_1 <- tm_map(corpus_1, removeNumbers)
corpus_1 <- tm_map(corpus_1, removeWords, stopwords("spa"))
corpus_1 <- tm_map(corpus_1, removeWords, c("Ninguno"))
tdm_1 <- TermDocumentMatrix(corpus_1)
m_1 <- as.matrix(tdm_1)
frecuencia_1 <- sort(rowSums(m_1), decreasing = TRUE)
frecuencia_df_1 <- data.frame(word=names(frecuencia_1), freq = frecuencia_1)
ggplot(head(frecuencia_df, 10), aes(x = reorder(word, -freq), y = freq, fill = freq)) +
geom_col() +
geom_text(aes(label = freq), vjust = -0.3) +
scale_fill_gradient(low = "lightblue", high = "blue", limits = c(0, 20)) +
labs(title = "TOP 10 Palabras Más Frecuentes",
subtitle = "¿Qué aspectos de tu puesto actual te resultan menos satisfactorios?",
x = "Palabra",
y = "Frecuencia") +
theme_minimal()
wordcloud(words = frecuencia_df$word,
freq = frecuencia_df$freq,
min.freq = 2,
random.order = FALSE,
rot.per = 0.35,
colors = brewer.pal(8, "Dark2"),
scale = c(4,0.5),
max.words = 100)
ggplot(head(frecuencia_df_1, 10), aes(x = reorder(word, -freq), y = freq, fill = freq)) +
geom_col() +
geom_text(aes(label = freq), vjust = -0.3) +
scale_fill_gradient(low = "#FF8000", high = "blue", limits = c(0, 20)) +
labs(title = "TOP 10 Palabras Más Frecuentes",
subtitle = "¿Qué aspectos de tu puesto actual te resultan menos satisfactorios?",
x = "Palabra",
y = "Frecuencia") +
theme_minimal()
wordcloud(words = frecuencia_df_1$word,
freq = frecuencia_df_1$freq,
min.freq = 2,
random.order = FALSE,
rot.per = 0.35,
colors = brewer.pal(8, "RdGy"),
scale = c(4,0.5),
max.words = 100)
# Tabla cruzada puesto_trabajo y clima
CrossTable(df_likert$puesto_trabajo, df_likert$clima, prop.c = FALSE, prop.t = FALSE, prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## |-------------------------|
##
##
## Total Observations in Table: 106
##
##
## | df_likert$clima
## df_likert$puesto_trabajo | 1 | 2 | 3 | 4 | 5 | Row Total |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Administrativo | 3 | 1 | 5 | 3 | 5 | 17 |
## | 0.176 | 0.059 | 0.294 | 0.176 | 0.294 | 0.160 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Asistente de producción | 1 | 0 | 0 | 0 | 0 | 1 |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Ayudante general | 18 | 5 | 3 | 7 | 13 | 46 |
## | 0.391 | 0.109 | 0.065 | 0.152 | 0.283 | 0.434 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Calidad | 0 | 0 | 0 | 1 | 1 | 2 |
## | 0.000 | 0.000 | 0.000 | 0.500 | 0.500 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Comercial | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Coordinador(a) | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Costurera | 3 | 0 | 1 | 0 | 3 | 7 |
## | 0.429 | 0.000 | 0.143 | 0.000 | 0.429 | 0.066 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Desfajadora | 1 | 0 | 0 | 0 | 0 | 1 |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Desgajo | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Director(a) | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Embarque | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Enfermero(a) | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Ingeniería | 1 | 0 | 0 | 0 | 0 | 1 |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Intern/practicante | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Jefe de SGC | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Laminado | 1 | 0 | 0 | 1 | 0 | 2 |
## | 0.500 | 0.000 | 0.000 | 0.500 | 0.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Limpieza | 1 | 1 | 0 | 0 | 0 | 2 |
## | 0.500 | 0.500 | 0.000 | 0.000 | 0.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Mantenimiento | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Materiales | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Montacarguista | 2 | 0 | 0 | 0 | 1 | 3 |
## | 0.667 | 0.000 | 0.000 | 0.000 | 0.333 | 0.028 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Operador | 0 | 0 | 1 | 0 | 2 | 3 |
## | 0.000 | 0.000 | 0.333 | 0.000 | 0.667 | 0.028 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Otro | 1 | 0 | 0 | 0 | 1 | 2 |
## | 0.500 | 0.000 | 0.000 | 0.000 | 0.500 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Pintura | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Soldador | 1 | 0 | 0 | 0 | 1 | 2 |
## | 0.500 | 0.000 | 0.000 | 0.000 | 0.500 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Supervisor(a) | 2 | 0 | 1 | 0 | 3 | 6 |
## | 0.333 | 0.000 | 0.167 | 0.000 | 0.500 | 0.057 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Column Total | 35 | 7 | 12 | 14 | 38 | 106 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
##
##
# Tabla cruzada puesto_trabajo y salario
CrossTable(df_likert$puesto_trabajo, df_likert$salario, prop.c = FALSE, prop.t = FALSE, prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## |-------------------------|
##
##
## Total Observations in Table: 106
##
##
## | df_likert$salario
## df_likert$puesto_trabajo | 1 | 2 | 3 | 4 | 5 | Row Total |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Administrativo | 0 | 3 | 2 | 6 | 6 | 17 |
## | 0.000 | 0.176 | 0.118 | 0.353 | 0.353 | 0.160 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Asistente de producción | 0 | 1 | 0 | 0 | 0 | 1 |
## | 0.000 | 1.000 | 0.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Ayudante general | 6 | 5 | 4 | 11 | 20 | 46 |
## | 0.130 | 0.109 | 0.087 | 0.239 | 0.435 | 0.434 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Calidad | 0 | 0 | 1 | 1 | 0 | 2 |
## | 0.000 | 0.000 | 0.500 | 0.500 | 0.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Comercial | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Coordinador(a) | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Costurera | 1 | 0 | 0 | 3 | 3 | 7 |
## | 0.143 | 0.000 | 0.000 | 0.429 | 0.429 | 0.066 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Desfajadora | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Desgajo | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Director(a) | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Embarque | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Enfermero(a) | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Ingeniería | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Intern/practicante | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Jefe de SGC | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Laminado | 0 | 0 | 0 | 2 | 0 | 2 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Limpieza | 0 | 0 | 0 | 0 | 2 | 2 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Mantenimiento | 1 | 0 | 0 | 0 | 0 | 1 |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Materiales | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Montacarguista | 0 | 0 | 0 | 3 | 0 | 3 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.028 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Operador | 1 | 0 | 0 | 0 | 2 | 3 |
## | 0.333 | 0.000 | 0.000 | 0.000 | 0.667 | 0.028 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Otro | 0 | 1 | 0 | 1 | 0 | 2 |
## | 0.000 | 0.500 | 0.000 | 0.500 | 0.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Pintura | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Soldador | 2 | 0 | 0 | 0 | 0 | 2 |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Supervisor(a) | 0 | 1 | 0 | 2 | 3 | 6 |
## | 0.000 | 0.167 | 0.000 | 0.333 | 0.500 | 0.057 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Column Total | 11 | 11 | 8 | 35 | 41 | 106 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
##
##
# Tabla cruzada puesto_trabajo y prestaciones
CrossTable(df_likert$puesto_trabajo, df_likert$prestaciones, prop.c = FALSE, prop.t = FALSE, prop.chisq = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Row Total |
## |-------------------------|
##
##
## Total Observations in Table: 106
##
##
## | df_likert$prestaciones
## df_likert$puesto_trabajo | 1 | 2 | 3 | 4 | 5 | Row Total |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Administrativo | 3 | 5 | 3 | 4 | 2 | 17 |
## | 0.176 | 0.294 | 0.176 | 0.235 | 0.118 | 0.160 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Asistente de producción | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Ayudante general | 9 | 9 | 3 | 12 | 13 | 46 |
## | 0.196 | 0.196 | 0.065 | 0.261 | 0.283 | 0.434 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Calidad | 0 | 1 | 0 | 0 | 1 | 2 |
## | 0.000 | 0.500 | 0.000 | 0.000 | 0.500 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Comercial | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Coordinador(a) | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Costurera | 1 | 1 | 0 | 1 | 4 | 7 |
## | 0.143 | 0.143 | 0.000 | 0.143 | 0.571 | 0.066 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Desfajadora | 1 | 0 | 0 | 0 | 0 | 1 |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Desgajo | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Director(a) | 0 | 0 | 0 | 1 | 0 | 1 |
## | 0.000 | 0.000 | 0.000 | 1.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Embarque | 1 | 0 | 0 | 0 | 0 | 1 |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Enfermero(a) | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Ingeniería | 0 | 0 | 1 | 0 | 0 | 1 |
## | 0.000 | 0.000 | 1.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Intern/practicante | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Jefe de SGC | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Laminado | 0 | 0 | 1 | 1 | 0 | 2 |
## | 0.000 | 0.000 | 0.500 | 0.500 | 0.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Limpieza | 1 | 0 | 0 | 0 | 1 | 2 |
## | 0.500 | 0.000 | 0.000 | 0.000 | 0.500 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Mantenimiento | 1 | 0 | 0 | 0 | 0 | 1 |
## | 1.000 | 0.000 | 0.000 | 0.000 | 0.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Materiales | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Montacarguista | 0 | 2 | 0 | 0 | 1 | 3 |
## | 0.000 | 0.667 | 0.000 | 0.000 | 0.333 | 0.028 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Operador | 1 | 0 | 0 | 1 | 1 | 3 |
## | 0.333 | 0.000 | 0.000 | 0.333 | 0.333 | 0.028 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Otro | 1 | 1 | 0 | 0 | 0 | 2 |
## | 0.500 | 0.500 | 0.000 | 0.000 | 0.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Pintura | 0 | 0 | 0 | 0 | 1 | 1 |
## | 0.000 | 0.000 | 0.000 | 0.000 | 1.000 | 0.009 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Soldador | 1 | 0 | 1 | 0 | 0 | 2 |
## | 0.500 | 0.000 | 0.500 | 0.000 | 0.000 | 0.019 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Supervisor(a) | 1 | 0 | 1 | 0 | 4 | 6 |
## | 0.167 | 0.000 | 0.167 | 0.000 | 0.667 | 0.057 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
## Column Total | 21 | 19 | 10 | 22 | 34 | 106 |
## -------------------------|-----------|-----------|-----------|-----------|-----------|-----------|
##
##
ggplot(df_likert, aes(x=antiguedad, y=futuro_form)) +
geom_point(shape=19, size=3) +
labs(title = "Relación entre antigüedad en la empresa y trabajar en un futuro en FORM",
x="Antigüedad (meses)", y="Futuro FORM") +
theme_classic()
# Tabla de frecuencias cruzadas entre género y opinión: femenino
Situaciones_inseguridad_fem <- table(df_femenino$inseguridad)
# Crear el gráfico de pastel
ggplot(data = NULL, aes(x = "", y = Situaciones_inseguridad_fem, fill = names(Situaciones_inseguridad_fem))) +
geom_bar(stat = "identity", width = 1) +
coord_polar("y", start = 0) +
theme_void() +
scale_fill_manual(values = c("#c6c6c6", "#FF7F50", "#FF4500")) +
labs(title = "¿Has experimentado situaciones de conflicto, acoso o que te hayan hecho sentir inseguro(a) durante tu tiempo en la empresa?") +
geom_text(aes(label = paste0(round((..y..)/sum(..y..)*100), "%")),
position = position_stack(vjust = 0.5),
color = "black", size = 4)
# Tabla de frecuencias cruzadas entre género y opinión: masculino
Situaciones_inseguridad_masc <- table(df_masculino$inseguridad)
# Crear el gráfico de pastel
ggplot(data = NULL, aes(x = "", y = Situaciones_inseguridad_masc, fill = names(Situaciones_inseguridad_masc))) +
geom_bar(stat = "identity", width = 1) +
coord_polar("y", start = 0) +
theme_void() +
scale_fill_manual(values = c("#c6c6c6", "#FF7F50", "#FF4500")) +
labs(title = "¿Has experimentado situaciones de conflicto, acoso o que te hayan hecho sentir inseguro(a) durante tu tiempo en la empresa?") +
geom_text(aes(label = paste0(round((..y..)/sum(..y..)*100), "%")),
position = position_stack(vjust = 0.5),
color = "black", size = 4)
# Estado Civil de los Trabajadores
# Calcular el total de observaciones
total <- nrow(df1)
# Calcular la frecuencia de cada categoría de estado civil
frecuencia_estado_civil <- table(df1$Estado_civil)
# Calcular los porcentajes
porcentajes <- (frecuencia_estado_civil / total) * 100
# Crear un DataFrame con los porcentajes
df_porcentajes <- data.frame(Estado_civil = names(porcentajes), Porcentaje = porcentajes)
# Graficar el gráfico de pastel con porcentajes
ggplot(df_porcentajes, aes(x = "", y = Porcentaje.Freq, fill = Estado_civil)) +
geom_bar(width = 1, stat = "identity") +
geom_text(aes(label = paste0(round(Porcentaje.Freq), "%")),
position = position_stack(vjust = 0.5), color = "black", size = 3) +
coord_polar(theta = "y") +
labs(title = "Estado Civil de los Trabajadores", y = "Porcentaje") +
theme_void() +
scale_fill_manual(values = rainbow(length(unique(df_porcentajes$Estado_civil))))
# Distribicion de Genero de los Trabajadores
# Calcular el total de observaciones
total <- nrow(df1)
# Calcular la frecuencia de cada género
frecuencia_genero <- table(df1$Género)
# Calcular los porcentajes
porcentajes <- (frecuencia_genero / total) * 100
# Crear un DataFrame con los porcentajes
df_porcentajes <- data.frame(Género = names(porcentajes), Porcentaje = porcentajes)
# Graficar el gráfico de pastel con porcentajes
ggplot(df_porcentajes, aes(x = "", y = Porcentaje.Freq, fill = Género)) +
geom_bar(width = 1, stat = "identity") +
geom_text(aes(label = paste0(round(Porcentaje.Freq), "%")),
position = position_stack(vjust = 0.5), color = "white", size = 3) +
coord_polar(theta = "y") +
labs(title = "Distribución de Género de los Trabajadores", y = "Porcentaje") +
theme_void() +
scale_fill_manual(values = c("blue", "pink")) # Puedes cambiar los colores si lo deseas
# Estado civil de los Trabahadores por Género
# Filtrar datos por género femenino
df_femenino <- subset(df1, Género == "Femenino")
# Calcular el total de observaciones para el género femenino
total_femenino <- nrow(df_femenino)
# Calcular la frecuencia de cada categoría de estado civil para el género femenino
frecuencia_estado_civil_femenino <- table(df_femenino$Estado_civil)
# Calcular los porcentajes para el género femenino
porcentajes_femenino <- (frecuencia_estado_civil_femenino / total_femenino) * 100
# Crear un DataFrame con los porcentajes para el género femenino
df_porcentajes_femenino <- data.frame(Estado_civil = names(porcentajes_femenino),
Porcentaje = porcentajes_femenino,
Genero = "Femenino")
# Graficar el gráfico de pastel para el género femenino
ggplot(df_porcentajes_femenino, aes(x = "", y = Porcentaje.Freq, fill = Estado_civil)) +
geom_bar(width = 1, stat = "identity") +
geom_text(aes(label = paste0(round(Porcentaje.Freq), "%")),
position = position_stack(vjust = 0.5), color = "white", size = 3) +
coord_polar(theta = "y") +
labs(title = "Estado Civil de los Trabajadores - Género Femenino", y = "Porcentaje") +
theme_void() +
scale_fill_manual(values = rainbow(length(unique(df_porcentajes_femenino$Estado_civil)))) +
theme(legend.position = "none") # Para ocultar la leyenda
# Filtrar datos por género masculino
df_masculino <- subset(df1, Género == "Masculino")
# Calcular el total de observaciones para el género masculino
total_masculino <- nrow(df_masculino)
# Calcular la frecuencia de cada categoría de estado civil para el género masculino
frecuencia_estado_civil_masculino <- table(df_masculino$Estado_civil)
# Calcular los porcentajes para el género masculino
porcentajes_masculino <- (frecuencia_estado_civil_masculino / total_masculino) * 100
# Crear un DataFrame con los porcentajes para el género masculino
df_porcentajes_masculino <- data.frame(Estado_civil = names(porcentajes_masculino),
Porcentaje = porcentajes_masculino,
Genero = "Masculino")
# Graficar el gráfico de pastel para el género masculino
ggplot(df_porcentajes_masculino, aes(x = "", y = Porcentaje.Freq, fill = Estado_civil)) +
geom_bar(width = 1, stat = "identity") +
geom_text(aes(label = paste0(round(Porcentaje.Freq), "%")),
position = position_stack(vjust = 0.5), color = "white", size = 3) +
coord_polar(theta = "y") +
labs(title = "Estado Civil de los Trabajadores - Género Masculino", y = "Porcentaje") +
theme_void() +
scale_fill_manual(values = rainbow(length(unique(df_porcentajes_masculino$Estado_civil)))) +
theme(legend.position = "none") # Para ocultar la leyenda
#Experiencia de Acoso en el Trabajo por Género
# Contar la cantidad de hombres y mujeres que han experimentado o no acoso en el trabajo
acoso_por_genero <- table(df1$Género, df1$p11)
# Obtener las categorías únicas de género y acoso
categorias_genero <- unique(df1$Género)
categorias_acoso <- unique(df1$p11)
# Crear un data frame para almacenar los resultados
df_acoso_por_genero <- data.frame(Género = character(), Acoso = character(), Count = numeric(), stringsAsFactors = FALSE)
# Completar el data frame con todas las combinaciones posibles de género y acoso
for (gen in categorias_genero) {
for (acos in categorias_acoso) {
count <- acoso_por_genero[gen, acos]
df_acoso_por_genero <- rbind(df_acoso_por_genero, data.frame(Género = gen, Acoso = acos, Count = count))
}
}
# Reordenar los niveles de la variable "Acoso" para que coincidan con el orden de los datos reales
df_acoso_por_genero$Acoso <- factor(df_acoso_por_genero$Acoso, levels = c("Si", "No", "Prefiero no decirlo"))
# Graficar la gráfica de barras
ggplot(df_acoso_por_genero, aes(x = Género, y = Count, fill = Acoso)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Experiencia de Acoso en el Trabajo por Género",
x = "Género",
y = "Cantidad",
fill = "Experiencia de Acoso") +
scale_fill_manual(values = c("Si" = "salmon", "No" = "lightblue", "Prefiero no decirlo" = "yellow")) +
theme_minimal()
#Experiencia de Acoso en el Trabajo por Estado Civil
# Contar la cantidad de hombres y mujeres que han experimentado o no acoso en el trabajo
acoso_por_genero <- table(df1$Estado_civil, df1$p11)
# Obtener las categorías únicas de género y acoso
categorias_genero <- unique(df1$Estado_civil)
categorias_acoso <- unique(df1$p11)
# Crear un data frame para almacenar los resultados
df_acoso_por_estado_civil <- data.frame(EstadoCivil = character(), Acoso = character(), Count = numeric(), stringsAsFactors = FALSE)
# Completar el data frame con todas las combinaciones posibles de género y acoso
for (gen in categorias_genero) {
for (acos in categorias_acoso) {
count <- acoso_por_genero[gen, acos]
df_acoso_por_estado_civil <- rbind(df_acoso_por_estado_civil, data.frame(EstadoCivil = gen, Acoso = acos, Count = count))
}
}
# Reordenar los niveles de la variable "Acoso" para que coincidan con el orden de los datos reales
df_acoso_por_estado_civil$Acoso <- factor(df_acoso_por_estado_civil$Acoso, levels = c("Si", "No", "Prefiero no decirlo"))
# Graficar la gráfica de barras
ggplot(df_acoso_por_estado_civil, aes(x = EstadoCivil, y = Count, fill = Acoso)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Experiencia de Acoso en el Trabajo por Género",
x = "Estado Civil",
y = "Cantidad",
fill = "Experiencia de Acoso") +
scale_fill_manual(values = c("Si" = "salmon", "No" = "lightblue", "Prefiero no decirlo" = "yellow")) +
theme_minimal()
La mayoría de los encuestados tienen entre 20 y 40 años de edad.
El 65% de las respuestas de esta encuesta corresponden al género femenino y el 35% restante al género masculino.
El 72% de los encuestados residen en el municipio de
Apodaca.
A excepción del municipio de Juárez, la mayoría de los encuestados con residencia en municipios diferentes a Apodaca consideran que se puede transportar de forma segura de su casa al trabajo y no les cuesta demasiado esfuerzo llegar.
La ubicación de la empresa es la principal razón por la que la mayoría de hombres y mujeres entran a este trabajo.
Otro y el salario son dos de las top 3 razones por las que el género masculino entra a este trabajo.
Razones personales y otro son dos de las top 3 razones por las que el género femenino entra a este trabajo.
El calor, las prestaciones y el salario son los aspectos menos
satisfactorios del puesto actual de la mayoría de los entrevistados
(esto no considera a colaboradores con una opinión positiva sobre su
puesto).
Los sentimiento con mayor frecuencia en los colaboradores de ambos géneros son alegría, confianza y anticipación. Además, el 34% (36/106) de los encuestados no califica alguno de los aspectos de su puesto actual como no satisfactorio, es decir, se sienten bien con su puesto de trabajo.
Ayudante general, administrativo, costurera, supervisor(a), operador y montacarguista son los puestos de trabajo para los cuales respondieron la encuesta un mayor número de personas (mínimo 3, máximo 46 personas).
A el 50% de los ayudantes generales, 43% de las costureras y 66% de los montacarguistas les molesta total o medianamente que haga mucho frío o calor en su área de trabajo.
¿Qué tipo de información / datos solicitarías al socio formador para mejorar EDA?
¿Qué tipo de información / datos de fuentes secundarias buscarías para mejorar EDA?
La(s) posible(s) estrategia(s) de predicción de la demanda de producto fabricados por la empresa FORM.
Librerías
library(foreign)
library(dygraphs)
library(dplyr) # data manipulation
library(forcats) # to work with categorical variables
library(ggplot2) # data visualization
library(readr) # read specific csv files
library(janitor) # data exploration and cleaning
library(Hmisc) # several useful functions for data analysis
library(psych) # functions for multivariate analysis
library(naniar) # summaries and visualization of missing values NA's
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(naniar) # identifying missing values
library(stargazer) # create publication quality tables
library(effects) # displays for linear and other regression models
library(tidyverse) # collection of R packages designed for data science
library(caret) # Classification and Regression Training
library(glmnet) # methods for prediction and plotting, and functions for cross-validation
library(xts)
library(zoo)
library(tseries)
library(stats)
library(forecast)
library(astsa)
library(AER)
library(dynlm)
library(vars)
library(TSstudio)
library(sarima)
library(DataExplorer)
library(corrplot) # correlation plots
library(readxl)
df <- read_excel("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\nearshoring_datos_series_de_tiempo_trimestral.xlsx")
head(df)
## # A tibble: 6 × 7
## Year Quarter New_FDI_Inflows Exchange_Rate new_fdi_inflows_mxn
## <dbl> <chr> <dbl> <dbl> <dbl>
## 1 2006 I 897. 10.8 15471.
## 2 2006 II 2110. 10.9 36790.
## 3 2006 III 1284. 10.9 22338.
## 4 2006 IV 2678. 10.9 46617.
## 5 2007 I 3108. 10.9 52252.
## 6 2007 II 2561. 10.9 42891.
## # ℹ 2 more variables: log_new_fdi_inflows_mxn <dbl>, INPC <dbl>
str(df)
## tibble [69 × 7] (S3: tbl_df/tbl/data.frame)
## $ Year : num [1:69] 2006 2006 2006 2006 2007 ...
## $ Quarter : chr [1:69] "I" "II" "III" "IV" ...
## $ New_FDI_Inflows : num [1:69] 897 2110 1284 2678 3108 ...
## $ Exchange_Rate : num [1:69] 10.8 10.9 10.9 10.9 10.9 ...
## $ new_fdi_inflows_mxn : num [1:69] 15471 36790 22338 46617 52252 ...
## $ log_new_fdi_inflows_mxn: num [1:69] 9.65 10.51 10.01 10.75 10.86 ...
## $ INPC : num [1:69] 60.7 60.7 61.2 62.3 63.2 ...
df$Date <- ymd(paste0(df$Year, "-",
ifelse(df$Quarter == "I", "01-01",
ifelse(df$Quarter == "II", "04-01",
ifelse(df$Quarter == "III", "07-01", "10-01")))))
df$Year <- as.Date(df$Year)
df$Quarter <- ifelse(df$Quarter == "I", "A", df$Quarter)
df$Quarter <- ifelse(df$Quarter == "II","B", df$Quarter)
df$Quarter <- ifelse(df$Quarter == "III","C", df$Quarter)
df$Quarter <- ifelse(df$Quarter == "IV","D", df$Quarter)
df$Quarter <- ifelse(df$Quarter == "A", 1, df$Quarter)
df$Quarter <- ifelse(df$Quarter == "B", 2, df$Quarter)
df$Quarter <- ifelse(df$Quarter == "C", 3, df$Quarter)
df$Quarter <- ifelse(df$Quarter == "D", 4, df$Quarter)
df$Quarter <- as.numeric(df$Quarter)
# Revisar por NAs
sum(is.na(df))
## [1] 0
summary(df$new_fdi_inflows_mxn)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -37081 33164 46617 51775 65069 237466
sd(df$new_fdi_inflows_mxn)
## [1] 37355.05
summary(df)
## Year Quarter New_FDI_Inflows Exchange_Rate
## Min. :1975-06-30 Min. :1.000 Min. :-2433 Min. :10.82
## 1st Qu.:1975-07-04 1st Qu.:1.000 1st Qu.: 1934 1st Qu.:12.65
## Median :1975-07-08 Median :2.000 Median : 2605 Median :13.65
## Mean :1975-07-08 Mean :2.478 Mean : 3001 Mean :15.59
## 3rd Qu.:1975-07-12 3rd Qu.:3.000 3rd Qu.: 3750 3rd Qu.:19.26
## Max. :1975-07-17 Max. :4.000 Max. :15445 Max. :21.60
## new_fdi_inflows_mxn log_new_fdi_inflows_mxn INPC
## Min. :-37081 Min. :-10.52 Min. : 60.69
## 1st Qu.: 33164 1st Qu.: 10.41 1st Qu.: 73.00
## Median : 46617 Median : 10.75 Median : 85.24
## Mean : 51775 Mean : 10.10 Mean : 87.59
## 3rd Qu.: 65069 3rd Qu.: 11.08 3rd Qu.:102.25
## Max. :237466 Max. : 12.38 Max. :127.92
## Date
## Min. :2006-01-01
## 1st Qu.:2010-04-01
## Median :2014-07-01
## Mean :2014-07-01
## 3rd Qu.:2018-10-01
## Max. :2023-01-01
var(df$new_fdi_inflows_mxn)
## [1] 1395399560
plot_histogram(df)
plot_intro(df)
boxplot(df$new_fdi_inflows_mxn,
main = "Box Plot of Flujos",
ylab = "IED_Flujos")
plot(df$Date,df$new_fdi_inflows_mxn,col="skyblue", lwd=2, xlab ="Date",ylab ="Flujos IED", main = "FDI")
#Conversion de data a series de tiempo
FDIts <- ts(df$new_fdi_inflows_mxn,start=c(2006,1),end=c(2023,1),frequency=4)
FDI_ts_decompose<-decompose(FDIts)
#Descomposicion de datos
plot(FDI_ts_decompose)
#Revisar Esacionaridad
adf.test(FDIts)
##
## Augmented Dickey-Fuller Test
##
## data: FDIts
## Dickey-Fuller = -5.4066, Lag order = 4, p-value = 0.01
## alternative hypothesis: stationary
# En este caso si hay presencia de estacionariedad.
#Revisar Autocorrelacion Serial
acf(df$new_fdi_inflows_mxn,main="Serial Autocorrelations")
# Parece que si hay presencia de Autocorrelacion serial
Para esto se aplicara un modelo ARMA y ARIMA y se escogera el mejor adaptado a los datos para realizar el pronostico.
summary(FDI_ARMA<-arma(df$new_fdi_inflows_mxn,order=c(1,1)))
##
## Call:
## arma(x = df$new_fdi_inflows_mxn, order = c(1, 1))
##
## Model:
## ARMA(1,1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -94534 -20819 1758 17359 151397
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|t|)
## ar1 0.5954 0.1342 4.436 9.14e-06 ***
## ma1 -0.8173 0.1136 -7.193 6.35e-13 ***
## intercept 21448.9889 7147.7797 3.001 0.00269 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Fit:
## sigma^2 estimated as 1.311e+09, Conditional Sum-of-Squares = 87863726846, AIC = 1650.41
plot(FDI_ARMA)
FDI_estimated<-FDI_ARMA$fitted.values
plot(FDI_estimated)
# Autocorrelation
acf(na.omit(FDI_ARMA$residuals),main="ACF - ARMA (1,1)")
#Normality of residuals
hist(FDI_ARMA$residuals, main = "Histogram of Residuals", xlab = "Residuals", ylab = "Frequency")
#Check for Serial Autoorrelation
FDI_ARMA_residuals<-FDI_ARMA$residuals
Box.test(FDI_ARMA_residuals,lag=5,type="Ljung-Box")
##
## Box-Ljung test
##
## data: FDI_ARMA_residuals
## X-squared = 4.1828, df = 5, p-value = 0.5234
#Chcek for Stationarity
adf.test(na.omit(FDI_estimated))
##
## Augmented Dickey-Fuller Test
##
## data: na.omit(FDI_estimated)
## Dickey-Fuller = -2.5562, Lag order = 4, p-value = 0.3492
## alternative hypothesis: stationary
FDI_ARIMA <- Arima(df$new_fdi_inflows_mxn,order=c(1,1,1))
print(FDI_ARIMA)
## Series: df$new_fdi_inflows_mxn
## ARIMA(1,1,1)
##
## Coefficients:
## ar1 ma1
## -0.0389 -1.0000
## s.e. 0.1229 0.0406
##
## sigma^2 = 1.434e+09: log likelihood = -814.47
## AIC=1634.95 AICc=1635.32 BIC=1641.61
plot(FDI_ARIMA$residuals,main="ARIMA(1,1,1) - FDI")
#Normality of Residuals
hist(FDI_ARIMA$residuals, main = "Histogram of Residuals", xlab = "Residuals", ylab = "Frequency")
#Check for serial autocorrelation
acf(FDI_ARIMA$residuals,main="ACF - ARIMA (1,1,1)")
#Check for Serial Autocorrelation
Box.test(FDI_ARIMA$residuals,lag=1,type="Ljung-Box")
##
## Box-Ljung test
##
## data: FDI_ARIMA$residuals
## X-squared = 0.016568, df = 1, p-value = 0.8976
#Check for Stationarity
adf.test(FDI_ARIMA$residuals)
##
## Augmented Dickey-Fuller Test
##
## data: FDI_ARIMA$residuals
## Dickey-Fuller = -4.8918, Lag order = 4, p-value = 0.01
## alternative hypothesis: stationary
Despues de analizar los diagnosticos de los 2 modelos se concluyo que el modelo mejor adaptado a los datos seria el modelo de ARIMA. Esto se debe a que los 2 modelos no presentan autocorrelacion serial, pero solo el modelo de ARIMA presenta estacionaridad. Lo cual es mejor a la hora de realizar los pronosticos.
FDI_ARIMA_forecast<-forecast(FDI_ARIMA,h=5)
FDI_ARIMA_forecast
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 70 53327.03 4447.107 102206.9 -21428.36 128082.4
## 71 51756.87 2867.109 100646.6 -23013.57 126527.3
## 72 51818.01 2927.175 100708.8 -22954.07 126590.1
## 73 51815.63 2924.834 100706.4 -22956.39 126587.6
## 74 51815.72 2924.925 100706.5 -22956.30 126587.7
plot(FDI_ARIMA_forecast)
autoplot(FDI_ARIMA_forecast)
Para los flujos de FDI, los datos son normales sin embargo existen dos valores atipicos, estos siendo el minimo y el maximo. Estos valores se ven reflejados a la hora de visualisalr los residuales de los modelos.
Hay una presnecia estadisiticamente significativa de estacionaridad, esto significa que los datos tienen propiedades estadisticas consistentes, lo cual facilita la aplicacion de los modelos de series de tiempo.
Los modelos ARMA y ARIMA no presentaron autocorrelacion serial, esto es un buen indicador para los modelos.
El modelo de ARMA no presento estacionaridad, pero el modelo de ARIMA si presento estacionaridad, esto es una buena señal para el modelo ARIMA y una mala señal para el modelo ARMA.
Los dos modelos ARMA y ARIMA presentaron normalidad en los residuales a esepcion de un valor atipico. Este valor probablemente es el valor atipico de los datos originales.
En base a el pronostico del modelo sleccionado, en este caso el modelo ARIMA, se espera que el valor de inversiones extranjeras directas incremente en los proximos 5 trimestres. Poniendo mas presión para FORM debido a que esto es una señal de que la competitividad en su industria estara incrementando por empresas extranjeras.
ventas_meses <- read.csv("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\totales_mensualesFORM.csv")
ventas_anuales <- read.csv("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\ventasanualesFORM.csv")
ventas_anuales$año <- as.Date(paste0(ventas_anuales$año, "-12-31"))
ultima_fila <- nrow(ventas_anuales)
ventas_anuales$año[ultima_fila] <- as.Date("2022-09-30")
head(ventas_anuales)
## año ventas
## 1 2017-12-31 61993858
## 2 2018-12-31 86978635
## 3 2019-12-31 81443008
## 4 2020-12-31 85914707
## 5 2021-12-31 89938901
## 6 2022-09-30 82963816
meses_español <- c("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio", "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
ventas_meses$año <- as.Date(paste0(ventas_meses$año, "-", match(ventas_meses$meses, meses_español), "-01")) + months(1) - days(1)
head(ventas_meses)
## año meses total_carton total_retornable total_servicios variacion
## 1 2020-01-31 Enero 0 0 0 0
## 2 2020-02-29 Febrero 0 0 0 0
## 3 2020-03-31 Marzo 0 0 0 0
## 4 2020-04-30 Abril 0 0 0 0
## 5 2020-05-31 Mayo 0 0 0 0
## 6 2020-06-30 Junio 0 0 0 0
## total_mensual
## 1 6059791
## 2 6643181
## 3 8368674
## 4 4925778
## 5 2235669
## 6 7842003
ventas_meses$total_mensual <- as.numeric(ventas_meses$total_mensual)
ventas_meses <- ventas_meses[, c("año", "meses", "total_mensual")]
str(ventas_anuales)
## 'data.frame': 6 obs. of 2 variables:
## $ año : Date, format: "2017-12-31" "2018-12-31" ...
## $ ventas: num 61993858 86978635 81443008 85914707 89938901 ...
str(ventas_meses)
## 'data.frame': 33 obs. of 3 variables:
## $ año : Date, format: "2020-01-31" "2020-02-29" ...
## $ meses : chr "Enero" "Febrero" "Marzo" "Abril" ...
## $ total_mensual: num 6059791 6643181 8368674 4925778 2235669 ...
sum(is.na(ventas_anuales))
## [1] 0
sum(is.na(ventas_meses))
## [1] 0
head(ventas_anuales)
## año ventas
## 1 2017-12-31 61993858
## 2 2018-12-31 86978635
## 3 2019-12-31 81443008
## 4 2020-12-31 85914707
## 5 2021-12-31 89938901
## 6 2022-09-30 82963816
head(ventas_meses)
## año meses total_mensual
## 1 2020-01-31 Enero 6059791
## 2 2020-02-29 Febrero 6643181
## 3 2020-03-31 Marzo 8368674
## 4 2020-04-30 Abril 4925778
## 5 2020-05-31 Mayo 2235669
## 6 2020-06-30 Junio 7842003
str(ventas_meses)
## 'data.frame': 33 obs. of 3 variables:
## $ año : Date, format: "2020-01-31" "2020-02-29" ...
## $ meses : chr "Enero" "Febrero" "Marzo" "Abril" ...
## $ total_mensual: num 6059791 6643181 8368674 4925778 2235669 ...
str(ventas_anuales)
## 'data.frame': 6 obs. of 2 variables:
## $ año : Date, format: "2017-12-31" "2018-12-31" ...
## $ ventas: num 61993858 86978635 81443008 85914707 89938901 ...
summary(ventas_anuales)
## año ventas
## Min. :2017-12-31 Min. :61993858
## 1st Qu.:2019-04-01 1st Qu.:81823210
## Median :2020-07-01 Median :84439262
## Mean :2020-06-15 Mean :81538821
## 3rd Qu.:2021-09-30 3rd Qu.:86712653
## Max. :2022-09-30 Max. :89938901
summary(ventas_meses)
## año meses total_mensual
## Min. :2020-01-31 Length:33 Min. : 2235669
## 1st Qu.:2020-09-30 Class :character 1st Qu.: 6358278
## Median :2021-05-31 Mode :character Median : 7872345
## Mean :2021-05-31 Mean : 7841740
## 3rd Qu.:2022-01-31 3rd Qu.: 9219847
## Max. :2022-09-30 Max. :12285123
print(ventas_meses$año)
## [1] "2020-01-31" "2020-02-29" "2020-03-31" "2020-04-30" "2020-05-31"
## [6] "2020-06-30" "2020-07-31" "2020-08-31" "2020-09-30" "2020-10-31"
## [11] "2020-11-30" "2020-12-31" "2021-01-31" "2021-02-28" "2021-03-31"
## [16] "2021-04-30" "2021-05-31" "2021-06-30" "2021-07-31" "2021-08-31"
## [21] "2021-09-30" "2021-10-31" "2021-11-30" "2021-12-31" "2022-01-31"
## [26] "2022-02-28" "2022-03-31" "2022-04-30" "2022-05-31" "2022-06-30"
## [31] "2022-07-31" "2022-08-31" "2022-09-30"
describe(ventas_anuales)
## Warning in FUN(newX[, i], ...): ningún argumento finito para min; retornando
## Inf
## Warning in FUN(newX[, i], ...): ningun argumento finito para max; retornando
## -Inf
## vars n mean sd median trimmed mad min max
## año 1 6 NaN NA NA NaN NA Inf -Inf
## ventas 2 6 81538821 10033411 84439262 81538821 4103560 61993858 89938901
## range skew kurtosis se
## año -Inf NA NA NA
## ventas 27945043 -1.09 -0.5 4096123
describe(ventas_meses)
## Warning in FUN(newX[, i], ...): ningún argumento finito para min; retornando
## Inf
## Warning in FUN(newX[, i], ...): ningun argumento finito para max; retornando
## -Inf
## vars n mean sd median trimmed mad
## año 1 33 NaN NA NA NaN NA
## meses* 2 33 6.36 3.46 6 6.33 4.45
## total_mensual 3 33 7841740.15 2227534.45 7872345 7845946.93 2108454.39
## min max range skew kurtosis se
## año Inf -Inf -Inf NA NA NA
## meses* 1 12 11 0.05 -1.23 0.6
## total_mensual 2235669 12285123 10049454 -0.10 -0.25 387764.0
var(ventas_anuales)
## año ventas
## año NA NA
## ventas NA 1.006693e+14
var(ventas_meses)
## año meses total_mensual
## año NA NA NA
## meses NA NA NA
## total_mensual NA NA 4.96191e+12
# Gráfico de ventas mensuales
ggplot(ventas_meses, aes(x = año, y = total_mensual)) +
geom_col(fill = "lightblue", color = "blue") +
labs(x = "Año", y = "Ventas", title = "Ventas Anuales")
ggplot(ventas_anuales, aes(x = año, y = ventas)) +
geom_col(fill = "salmon", color = "red") +
labs(x = "Año", y = "Ventas", title = "Ventas Anuales")
porcentaje_ventas <- ventas_anuales$ventas / sum(ventas_anuales$ventas) * 100
pie(ventas_anuales$ventas, labels = paste(ventas_anuales$año, ": ", round(porcentaje_ventas, 2), "%"),
main = "Distribución de Ventas Anuales")
ventas_mensuales_xts<-xts(ventas_meses$total_mensual,order.by=ventas_meses$año)
dygraph(ventas_mensuales_xts, main = "Ventas Mensuales") %>%
dyOptions(colors = RColorBrewer::brewer.pal(4, "Dark2")) %>%
dyShading(from = "2020-12-01",
to = "2020-12-31",
color = "#FFE6E6")
ventas_anuales_xts<-xts(ventas_anuales$ventas,order.by=ventas_anuales$año)
dygraph(ventas_anuales_xts, main = "Ventas Anuales") %>%
dyOptions(colors = RColorBrewer::brewer.pal(4, "Dark2")) %>%
dyShading(from = "2021-04-09",
to = "2021-12-31",
color = "#FFE6E6")
Este gráfico de líneas muestra los datos de ventas mensuales de la empresa desde enero de 2020 hasta Septiembre de 2022. El gráfico exhibe cuenta con picos y bajadas que ocurren en intervalos regulares, probablemente correspondientes a diferentes estaciones o períodos del año. Hay una tendencia general al alza en las ventas, con el pico más alto ocurriendo hacia el final del período de tiempo mostrado.
Podemos ver que las mejores ventas mensuales que ha tenido durante los años fueron las fechas de: * Diciembre del 2020 = $12,300,000 * Febrero del 2021 = $11,200,000 * Septiembre del 2022 = $11,600,000
Y de las mayores ventas anuales fue en el 2021. Exactamente en abril 10 de ese año, se cumple las ventas del 2018 que fueron 87,000,000, que para esos años era el año donde recibieron mayores ventas. Y acabando el año 2021 se llego a un nuevo record en ventas siendo mayores a $89,900,000, y fue tan solo hasta Septiembre de ese año, sin embargo FORM estimaba hasta 110 millones en ventas.
# Agregar filas para los años 2023 y 2024
ventas_anuales_nuevas <- rbind(ventas_anuales,
data.frame(año = as.Date("2023-12-31"), ventas = NA),
data.frame(año = as.Date("2024-12-31"), ventas = NA))
print(ventas_anuales_nuevas)
## año ventas
## 1 2017-12-31 61993858
## 2 2018-12-31 86978635
## 3 2019-12-31 81443008
## 4 2020-12-31 85914707
## 5 2021-12-31 89938901
## 6 2022-09-30 82963816
## 7 2023-12-31 NA
## 8 2024-12-31 NA
# Crear un vector con las fechas de final de los meses de Octubre 2022 a Septiembre 2023
fechas_nuevas <- seq(as.Date("2022-10-31"), as.Date("2023-09-30"), by = "month")
# Crear un nuevo dataframe con las fechas y ventas a NA
nuevas_filas <- data.frame(año = fechas_nuevas,
meses = format(fechas_nuevas, "%B"),
total_mensual = NA)
# Unir el nuevo dataframe con el original
ventas_meses_nuevas <- rbind(ventas_meses, nuevas_filas)
print(ventas_meses_nuevas)
## año meses total_mensual
## 1 2020-01-31 Enero 6059791
## 2 2020-02-29 Febrero 6643181
## 3 2020-03-31 Marzo 8368674
## 4 2020-04-30 Abril 4925778
## 5 2020-05-31 Mayo 2235669
## 6 2020-06-30 Junio 7842003
## 7 2020-07-31 Julio 5599913
## 8 2020-08-31 Agosto 8883507
## 9 2020-09-30 Septiembre 7452457
## 10 2020-10-31 Octubre 8078683
## 11 2020-11-30 Noviembre 7539929
## 12 2020-12-31 Diciembre 12285123
## 13 2021-01-31 Enero 9294478
## 14 2021-02-28 Febrero 11179236
## 15 2021-03-31 Marzo 10360017
## 16 2021-04-30 Abril 7872345
## 17 2021-05-31 Mayo 9219847
## 18 2021-06-30 Junio 5407600
## 19 2021-07-31 Julio 7936029
## 20 2021-08-31 Agosto 4733524
## 21 2021-09-30 Septiembre 6358278
## 22 2021-10-31 Octubre 5123874
## 23 2021-11-30 Noviembre 5913523
## 24 2021-12-31 Diciembre 6500150
## 25 2022-01-31 Enero 7534073
## 26 2022-02-28 Febrero 7898590
## 27 2022-03-31 Marzo 10597117
## 28 2022-04-30 Abril 8397928
## 29 2022-05-31 Mayo 7786912
## 30 2022-06-30 Junio 8623444
## 31 2022-07-31 Julio 9495207
## 32 2022-08-31 Agosto 11053017
## 33 2022-09-30 Septiembre 11577528
## 34 2022-10-31 octubre NA
## 35 2022-12-01 diciembre NA
## 36 2022-12-31 diciembre NA
## 37 2023-01-31 enero NA
## 38 2023-03-03 marzo NA
## 39 2023-03-31 marzo NA
## 40 2023-05-01 mayo NA
## 41 2023-05-31 mayo NA
## 42 2023-07-01 julio NA
## 43 2023-07-31 julio NA
## 44 2023-08-31 agosto NA
pronostico_mensuales_xts<-xts(ventas_meses_nuevas$total_mensual,order.by=ventas_meses_nuevas$año)
pronostico_anuales_xts<-xts(ventas_anuales_nuevas$ventas,order.by=ventas_anuales_nuevas$año)
promedio_movil_mensual <- rollmean(pronostico_mensuales_xts, k = 12, align = "right", fill = NA)
promedio_movil_anual <- rollapply(pronostico_anuales_xts, width = 3, FUN = mean, by = 1, align = "right", fill = NA)
# Convertir promedios móviles a objetos de serie temporal
promedio_movil_mensual_ts <- ts(coredata(promedio_movil_mensual), start = start(pronostico_mensuales_xts), frequency = frequency(pronostico_mensuales_xts))
promedio_movil_anual_ts <- ts(coredata(promedio_movil_anual), start = start(pronostico_anuales_xts), frequency = frequency(pronostico_anuales_xts))
# Gráfico de pronóstico de promedio móvil mensual
autoplot(promedio_movil_mensual_ts) +
labs(title = "Movimiento del Pronóstico de Promedio Móvil Mensual", x = "Fecha", y = "Ventas") +
theme_minimal()
# Gráfico de pronóstico de promedio móvil anual
autoplot(promedio_movil_anual_ts) +
labs(title = "Movimiento del Pronóstico de Promedio Móvil Anual", x = "Año", y = "Ventas") +
theme_minimal()
# Extender el promedio móvil en el futuro para hacer pronósticos
# Supongamos que queremos pronosticar 12 meses hacia adelante
nuevas_fechas_mensuales <- seq(max(index(pronostico_mensuales_xts)) + 1, length.out = 12, by = "months")
pronostico_mensual <- zoo(NA, order.by = nuevas_fechas_mensuales)
for (i in seq_along(nuevas_fechas_mensuales)) {
pronostico_mensual[i] <- mean(tail(pronostico_mensuales_xts, 12))
}
# Gráfico de pronóstico de ventas mensuales
plot(pronostico_mensuales_xts, main = "Pronóstico de Ventas Mensuales con Promedio Móvil", xlab = "Año", ylab = "Ventas")
lines(promedio_movil_mensual, col = "blue")
lines(pronostico_mensual, col = "red", lty = 2)
legend("topright", legend = c("Ventas Mensuales", "Promedio Móvil", "Pronóstico"), col = c("black", "blue", "red"), lty = c(1, 1, 2))
# Extender el promedio móvil en el futuro para hacer pronósticos
# Supongamos que queremos pronosticar 2 años hacia adelante
nuevas_fechas_anuales <- seq(max(index(pronostico_anuales_xts)) + 1, length.out = 2, by = "years")
pronostico_anual <- zoo(NA, order.by = nuevas_fechas_anuales)
for (i in seq_along(nuevas_fechas_anuales)) {
pronostico_anual[i] <- mean(tail(pronostico_anuales_xts, 3))
}
# Gráfico de pronóstico de ventas anuales
plot(pronostico_anuales_xts, main = "Pronóstico de Ventas Anuales con Promedio Móvil", xlab = "Año", ylab = "Ventas")
lines(promedio_movil_anual, col = "blue")
lines(pronostico_anual, col = "red", lty = 2)
legend("topright", legend = c("Ventas Anuales", "Promedio Móvil", "Pronóstico"), col = c("black", "blue", "red"), lty = c(1, 1, 2))
Las ventas mensuales reflejan un patrón cíclico con meses de alta demanda, probablemente por factores estacionales o promocionales, donde el pronóstico captura adecuadamente las tendencias pero requiere ajustes para mayor precisión. A nivel anual, las ventas muestran un crecimiento sostenido, a pesar de un año con descenso significativo, y el pronóstico sigue de cerca la tendencia real, aunque también necesita mejoras para reducir las discrepancias observadas.
ventas_clientes2021 <- read_xlsx("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\BASES ACTUALIZADAS\\VentasClientes2021.xlsx")
ventas_clientes2022 <- read_xlsx("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\BASES ACTUALIZADAS\\VentasClientes2022.xlsx")
ventas_clientes2023 <- read_xlsx("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\BASES ACTUALIZADAS\\VentasClientes2023.xlsx")
# Crear el gráfico de barras VENTAS 2021
ggplot(ventas_clientes2021, aes(x = fecha, y = unidades)) +
geom_bar(stat = "identity", fill = "blue") +
labs(x = "Fecha", y = "Unidades", title = "Ventas por Fecha en 2021") +
theme_minimal()
#TOP 5 CLIENTES 2021
# Agrupar por cliente y sumar las unidades
ventas_por_cliente <- ventas_clientes2021 %>%
group_by(cliente) %>%
summarise(total_unidades = sum(unidades))
# Ordenar por el total de unidades y seleccionar los 5 primeros
top_5_clientes <- ventas_por_cliente %>%
arrange(desc(total_unidades)) %>%
head(5)
# Mostrar el top 5 de clientes que más consumen
print(top_5_clientes)
## # A tibble: 5 × 2
## cliente total_unidades
## <chr> <dbl>
## 1 Stabilus 1001641
## 2 GRUPO ANTOLIN SALTILLO, S. de R.L de C.V. 877550
## 3 YANFENG INTERNATIONAL AUTOMOTIVE TECHNOLOGY MEXICO 77682
## 4 PO LIGHTING MEXICO 59690
## 5 HELLA AUTOMOTIVE MEXICO 58948
# Graficar el top 5 de clientes que más consumen
ggplot(top_5_clientes, aes(x = cliente, y = total_unidades)) +
geom_bar(stat = "identity", fill = "skyblue") +
labs(title = "Top 5 de Clientes que más Consumen 2021",
x = "Cliente",
y = "Total de Unidades Vendidas") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas del eje x para mejor legibilidad
# Crear el gráfico de barras VENTAS 2022
ggplot(ventas_clientes2022, aes(x = fecha, y = unidades)) +
geom_bar(stat = "identity", fill = "blue") +
labs(x = "Fecha", y = "Unidades", title = "Ventas por Fecha en 2022") +
theme_minimal()
#TOP 5 CLIENTES 2022
# Agrupar por cliente y sumar las unidades
ventas_por_cliente <- ventas_clientes2022 %>%
group_by(cliente) %>%
summarise(total_unidades = sum(unidades))
# Ordenar por el total de unidades y seleccionar los 5 primeros
top_5_clientes <- ventas_por_cliente %>%
arrange(desc(total_unidades)) %>%
head(5)
# Mostrar el top 5 de clientes que más consumen
print(top_5_clientes)
## # A tibble: 5 × 2
## cliente total_unidades
## <chr> <dbl>
## 1 Stabilus 1184928
## 2 HELLA AUTOMOTIVE MEXICO 315795
## 3 TOKAI RIKA MEXICO 86038
## 4 PO LIGHTING MEXICO 50697
## 5 DENSO MEXICO 32930
# Graficar el top 5 de clientes que más consumen
ggplot(top_5_clientes, aes(x = cliente, y = total_unidades)) +
geom_bar(stat = "identity", fill = "skyblue") +
labs(title = "Top 5 de Clientes que más Consumen 2022",
x = "Cliente",
y = "Total de Unidades Vendidas") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas del eje x para mejor legibilidad
# Crear el gráfico de barras VENTAS 2023
ggplot(ventas_clientes2023, aes(x = fecha, y = unidades)) +
geom_bar(stat = "identity", fill = "blue") +
labs(x = "Fecha", y = "Unidades", title = "Ventas por Fecha en 2023") +
theme_minimal()
#TOP 5 CLIENTES 2023
# Agrupar por cliente y sumar las unidades
ventas_por_cliente <- ventas_clientes2023 %>%
group_by(cliente) %>%
summarise(total_unidades = sum(unidades))
# Ordenar por el total de unidades y seleccionar los 5 primeros
top_5_clientes <- ventas_por_cliente %>%
arrange(desc(total_unidades)) %>%
head(5)
# Mostrar el top 5 de clientes que más consumen
print(top_5_clientes)
## # A tibble: 5 × 2
## cliente total_unidades
## <chr> <dbl>
## 1 Stabilus 1438773
## 2 Aptiv Services US, LLC 323696
## 3 HELLA AUTOMOTIVE MEXICO 199965
## 4 DENSO MEXICO 76593
## 5 TOKAI RIKA MEXICO 75154
# Graficar el top 5 de clientes que más consumen
ggplot(top_5_clientes, aes(x = cliente, y = total_unidades)) +
geom_bar(stat = "identity", fill = "skyblue") +
labs(title = "Top 5 de Clientes que más Consumen 2023",
x = "Cliente",
y = "Total de Unidades Vendidas") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas del eje x para mejor legibilidad
#Top 5 clientes Global
# Concatenar los datos de los tres años
ventas_totales <- rbind(ventas_clientes2021, ventas_clientes2022, ventas_clientes2023)
# Agrupar por cliente y sumar las unidades
ventas_por_cliente <- ventas_totales %>%
group_by(cliente) %>%
summarise(total_unidades = sum(unidades))
# Ordenar por el total de unidades y seleccionar los 5 primeros
top_5_clientes_general <- ventas_por_cliente %>%
arrange(desc(total_unidades)) %>%
head(5)
# Mostrar el top 5 de clientes que más consumen en general
print(top_5_clientes_general)
## # A tibble: 5 × 2
## cliente total_unidades
## <chr> <dbl>
## 1 Stabilus 3625342
## 2 GRUPO ANTOLIN SALTILLO, S. de R.L de C.V. 877550
## 3 HELLA AUTOMOTIVE MEXICO 574708
## 4 Aptiv Services US, LLC 323696
## 5 TOKAI RIKA MEXICO 203311
# Graficar el top 5 general de clientes que más consumen
ggplot(top_5_clientes_general, aes(x = cliente, y = total_unidades)) +
geom_bar(stat = "identity", fill = "skyblue") +
labs(title = "Top 5 de Clientes que más Consumen (2021-2023)",
x = "Cliente",
y = "Total de Unidades Vendidas") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas del eje x para mejor legibilidad
operativa_FORM2024 <- readxl::read_excel("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\BASES ACTUALIZADAS\\Datos_FORM_RH_FJ2024.xlsx", sheet = "Operativa")
## New names:
## • `` -> `...1`
## • `` -> `...2`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`
## • `` -> `...14`
## • `` -> `...15`
## • `` -> `...16`
## • `` -> `...17`
## • `` -> `...18`
## • `` -> `...19`
## • `` -> `...20`
## • `` -> `...21`
## • `` -> `...22`
## • `` -> `...23`
## • `` -> `...24`
## • `` -> `...25`
## • `` -> `...26`
## • `` -> `...27`
## • `` -> `...28`
## • `` -> `...29`
## • `` -> `...30`
operativa_FORM2024
## # A tibble: 613 × 30
## ...1 ...2 `BDD OPERATIVA` ...4 ...5 ...6 ...7 ...8 ...9 ...10 ...11
## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## 2 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## 3 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## 4 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## 5 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## 6 <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA> <NA>
## 7 No. Apelli… Nombre Fech… Géne… RFC Fech… Prim… Cuar… Fech… Pues…
## 8 10 Luna L… Yolanda Judith 31277 Feme… LULY… 42786 42816 42906 45201 Cost…
## 9 12 Suarez… Julio Cesar 25381 Masc… SURJ… 43070 43100 43190 44931 Gest…
## 10 13 Cruz R… Victor Abel 32680 Masc… CURV… 43182 43212 43302 45230 Chof…
## # ℹ 603 more rows
## # ℹ 19 more variables: ...12 <chr>, ...13 <chr>, ...14 <chr>, ...15 <chr>,
## # ...16 <chr>, ...17 <chr>, ...18 <chr>, ...19 <chr>, ...20 <chr>,
## # ...21 <chr>, ...22 <chr>, ...23 <chr>, ...24 <chr>, ...25 <chr>,
## # ...26 <chr>, ...27 <chr>, ...28 <chr>, ...29 <chr>, ...30 <chr>
# Eliminar las primeras 6 filas
operativa_FORM2024 <- operativa_FORM2024 %>%
slice(-(1:6))
operativa_FORM2024
## # A tibble: 607 × 30
## ...1 ...2 `BDD OPERATIVA` ...4 ...5 ...6 ...7 ...8 ...9 ...10 ...11
## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 No. Apel… Nombre Fech… Géne… RFC Fech… Prim… Cuar… Fech… Pues…
## 2 10 Luna… Yolanda Judith 31277 Feme… LULY… 42786 42816 42906 45201 Cost…
## 3 12 Suar… Julio Cesar 25381 Masc… SURJ… 43070 43100 43190 44931 Gest…
## 4 13 Cruz… Victor Abel 32680 Masc… CURV… 43182 43212 43302 45230 Chof…
## 5 14 Espa… Lucero Shanyeza 35754 Feme… EAPL… 43349 43379 43469 <NA> Lider
## 6 19 Garc… Yuliana Mireya 30913 Feme… GAPY… 43587 43617 43707 45342 Ayud…
## 7 20 Yabe… Mario Alberto 33048 Masc… YAAM… 43676 43706 43796 44944 Resi…
## 8 29 Lope… Martin 28548 Masc… LOTM… 44063 44093 44183 45004 Ayud…
## 9 32.501… Rodr… Nicolas De Jes… 33614 Masc… ROMN… 44138 44168 44258 <NA> Ayud…
## 10 34.650… Cele… Jaime 30104 Masc… CEBJ… 44243 44273 44363 45044 Pint…
## # ℹ 597 more rows
## # ℹ 19 more variables: ...12 <chr>, ...13 <chr>, ...14 <chr>, ...15 <chr>,
## # ...16 <chr>, ...17 <chr>, ...18 <chr>, ...19 <chr>, ...20 <chr>,
## # ...21 <chr>, ...22 <chr>, ...23 <chr>, ...24 <chr>, ...25 <chr>,
## # ...26 <chr>, ...27 <chr>, ...28 <chr>, ...29 <chr>, ...30 <chr>
# Tomar la primera fila como nombres de las columnas
nuevos_nombres <- as.character(unlist(operativa_FORM2024[1,]))
operativa_FORM2024 <- operativa_FORM2024[-1,] # Eliminar la primera fila
colnames(operativa_FORM2024) <- nuevos_nombres
# Usando names()
columnas <- names(operativa_FORM2024)
print(columnas)
## [1] "No." "Apellido"
## [3] "Nombre" "Fecha de nacimiento"
## [5] "Género" "RFC"
## [7] "Fecha de Alta" "Primer Mes"
## [9] "Cuarto Mes" "Fecha de Baja"
## [11] "Puesto" "Dpto"
## [13] "Imss" "SD"
## [15] "Factor de Crédito Infonavit" "No. De Crédito Infonavit"
## [17] "Lugar de Nacimiento" "CURP"
## [19] "Calle" "Número"
## [21] "Colonia" "Municipio"
## [23] "Estado" "CP"
## [25] "Estado Civil" "Número de Télefono"
## [27] "Banco" "Correo Electronico"
## [29] "Causa de Baja" "Observaciones de baja"
# Reenombrar la columna Estado Civil a Estado_Civil
operativa_FORM2024 <- rename(operativa_FORM2024, Estado_Civil = `Estado Civil`)
columnas <- names(operativa_FORM2024)
print(columnas)
## [1] "No." "Apellido"
## [3] "Nombre" "Fecha de nacimiento"
## [5] "Género" "RFC"
## [7] "Fecha de Alta" "Primer Mes"
## [9] "Cuarto Mes" "Fecha de Baja"
## [11] "Puesto" "Dpto"
## [13] "Imss" "SD"
## [15] "Factor de Crédito Infonavit" "No. De Crédito Infonavit"
## [17] "Lugar de Nacimiento" "CURP"
## [19] "Calle" "Número"
## [21] "Colonia" "Municipio"
## [23] "Estado" "CP"
## [25] "Estado_Civil" "Número de Télefono"
## [27] "Banco" "Correo Electronico"
## [29] "Causa de Baja" "Observaciones de baja"
# Contar la cantidad de trabajadores por estado civil
conteo_estado_civil <- operativa_FORM2024 %>%
group_by(Estado_Civil) %>%
summarise(Cantidad_Trabajadores = n())
# Ordenar los estados civiles
conteo_estado_civil <- conteo_estado_civil %>%
arrange(Estado_Civil)
# Crear el gráfico de barras
ggplot(conteo_estado_civil, aes(x = Estado_Civil, y = Cantidad_Trabajadores, fill = Estado_Civil)) +
geom_bar(stat = "identity") +
labs(x = "Estado Civil", y = "Cantidad de Trabajadores", title = "Distribución de Trabajadores por Estado Civil") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
library(readxl)
library(dplyr)
library(ggplot2)
# Registros por Genero
# Contar la cantidad de registros por género
conteo_genero <- operativa_FORM2024 %>%
group_by(Género) %>%
summarise(Cantidad = n())
# Calcular los porcentajes de género
conteo_genero <- conteo_genero %>%
mutate(Porcentaje = (Cantidad / sum(Cantidad)) * 100)
# Crear el gráfico de barras
ggplot(conteo_genero, aes(x = Género, y = Cantidad, fill = Género)) +
geom_bar(stat = "identity") +
geom_text(aes(label = paste(round(Porcentaje, 1), "%"), y = Cantidad), vjust = -0.5, size = 3, color = "black") +
labs(x = "Género", y = "Cantidad", title = "Distribución de Género") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
administrativa_FORM2024 <- readxl::read_excel("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\BASES ACTUALIZADAS\\Datos_FORM_RH_FJ2024.xlsx", sheet = "Administrativa")
administrativa_FORM2024
## # A tibble: 19 × 26
## No. Apellidos Nombre `Fecha de Nacimiento` Género RFC `Fecha de Alta`
## <dbl> <chr> <chr> <dttm> <chr> <chr> <dttm>
## 1 17 Ramirez … Sandr… 1990-02-11 00:00:00 FEMEN… RARS… 2022-08-22 00:00:00
## 2 30 De Luna … Lluvia 2002-06-12 00:00:00 FEMEN… LURL… 2023-10-23 00:00:00
## 3 31 Contrera… Melin… 1985-10-12 00:00:00 FEMEN… COLM… 2023-12-01 00:00:00
## 4 32 Romero R… Nayda… 1993-10-29 00:00:00 FEMEN… RORN… 2023-12-04 00:00:00
## 5 28 Granados… Sonia… 1984-06-22 00:00:00 FEMEN… GASS… 2023-08-21 00:00:00
## 6 28 Sauri Vi… Said 2001-12-05 00:00:00 MASCU… SAVS… 2023-08-16 00:00:00
## 7 31 Garcia V… Deysy… 1997-07-05 00:00:00 FEMEN… GAVD… 2023-09-26 00:00:00
## 8 21 Ayala Za… Valer… 2001-09-12 00:00:00 FEMEN… AAZV… 2023-03-07 00:00:00
## 9 17 Hidalgo … Miguel 1995-03-07 00:00:00 MASCU… HIMM… 2022-06-13 00:00:00
## 10 1 Del Ange… Victo… 1990-12-23 00:00:00 FEMEN… AEAV… 2019-10-28 00:00:00
## 11 24 Sanchez … Lilia… 1988-08-16 00:00:00 FEMEN… SAML… 2023-04-03 00:00:00
## 12 26 Echavarr… Maria… 1998-12-30 00:00:00 FEMEN… EAGM… 2023-04-03 00:00:00
## 13 18 Gonzalez… Luis … 1999-06-24 00:00:00 MASCU… GOBL… 2022-06-08 00:00:00
## 14 23 Ibarra G… Janet… 1989-11-18 00:00:00 FEMEN… IAGJ… 2022-07-05 00:00:00
## 15 25.4 Lopez Ca… Yosse… 1994-10-25 00:00:00 FEMEN… LOCY… 2022-11-09 00:00:00
## 16 9 Jara Ast… Rober… 1994-01-07 00:00:00 MASCU… JAAR… 2019-10-31 00:00:00
## 17 15 Rodrigue… Laura… 1987-01-15 00:00:00 FEMEN… ROAL… 2021-05-17 00:00:00
## 18 20 Lezama R… Rocio 1991-05-10 00:00:00 FEMEN… LERR… 2022-03-24 00:00:00
## 19 3 Gonzalez… Elia … 1995-09-22 00:00:00 FEMEN… GOCE… 2020-04-16 00:00:00
## # ℹ 19 more variables: `Cuarto Mes` <dttm>, Baja <dttm>, Puesto <chr>,
## # Dpto. <chr>, Imss <chr>, `Lugar de Nacimiento` <chr>, CURP <chr>,
## # Calle <chr>, Número <chr>, Colonia <chr>, Municipio <chr>, Estado <chr>,
## # CP <chr>, Estado_Civil <chr>, `Número de Télefono` <dbl>, Banco <chr>,
## # Correo_Electronico <chr>, Causa_de_Baja <lgl>, Observaciones_de_baja <chr>
# Contar la cantidad de trabajadores por estado civil
conteo_estado_civil <- administrativa_FORM2024 %>%
group_by(Estado_Civil) %>%
summarise(Cantidad_Trabajadores = n())
# Ordenar los estados civiles
conteo_estado_civil <- conteo_estado_civil %>%
arrange(Estado_Civil)
# Crear el gráfico de barras
ggplot(conteo_estado_civil, aes(x = Estado_Civil, y = Cantidad_Trabajadores, fill = Estado_Civil)) +
geom_bar(stat = "identity") +
labs(x = "Estado Civil", y = "Cantidad de Trabajadores", title = "Distribución de Trabajadores por Estado Civil") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
library(readxl)
library(dplyr)
library(ggplot2)
# Registros por Genero
# Contar la cantidad de registros por género
conteo_genero <- administrativa_FORM2024 %>%
group_by(Género) %>%
summarise(Cantidad = n())
# Calcular los porcentajes de género
conteo_genero <- conteo_genero %>%
mutate(Porcentaje = (Cantidad / sum(Cantidad)) * 100)
# Crear el gráfico de barras
ggplot(conteo_genero, aes(x = Género, y = Cantidad, fill = Género)) +
geom_bar(stat = "identity") +
geom_text(aes(label = paste(round(Porcentaje, 1), "%"), y = Cantidad), vjust = -0.5, size = 3, color = "black") +
labs(x = "Género", y = "Cantidad", title = "Distribución de Género") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
papelcarton <- read_xlsx("C:\\Users\\lesda_b5wfqqa\\Downloads\\ev1\\BASES ACTUALIZADAS\\ied_carton_papel_2023.xlsx")
papelcarton
## # A tibble: 99 × 5
## Year Quarter IED_Fab_Carton_Papel Tipo_Cambio INPC
## <dbl> <chr> <dbl> <chr> <dbl>
## 1 1999 I -61.3 9.5158000000000005 41.4
## 2 1999 II 1.85 9.4875000000000007 42.3
## 3 1999 III 6.79 9.3582000000000001 43.2
## 4 1999 IV 25.7 9.5221999999999998 44.3
## 5 2000 I 22.8 9.2331000000000003 45.6
## 6 2000 II 22.2 9.9537999999999993 46.3
## 7 2000 III 8.21 9.4290000000000003 47.1
## 8 2000 IV 22.8 9.5997000000000003 48.3
## 9 2001 I 3.04 9.5203000000000007 48.9
## 10 2001 II 22.0 9.09 49.3
## # ℹ 89 more rows
# Seleccionar las columnas "Year" y "Tipo_Cambio"
# Crea una trendline entre el Year y el Tipo_Cambio
trendline1 <- ggplot(papelcarton, aes(x = Year, y = Tipo_Cambio)) +
geom_smooth(method = "lm", se = FALSE) +
geom_point() +
labs(title = "Trendline de Tipo de Cambio por Año")
# Crea una gráfica por año y quarter
by_year_quarter <- ggplot(papelcarton, aes(x = Quarter, y = INPC, group = Year, color = factor(Year))) +
geom_line() +
geom_point() +
labs(title = "INPC por Quarters (Color por Año)", x = "Quarter")
# Crea una gráfica por año de IED Fab Carton Papel e INPC
by_year <- ggplot(papelcarton, aes(x = Year)) +
geom_line(aes(y = INPC, color = "INPC")) +
labs(title = "INPC por Año", y = "Valor") +
scale_color_manual(values = "red", labels = c( "INPC"))
# Mostrar las gráficas
print(trendline1)
## `geom_smooth()` using formula = 'y ~ x'
print(by_year_quarter)
print(by_year)
** Es necesario buscar una nueva alternativa para combatir el calor en las áreas de trabajo
** A nivel mensual, las ventas siguen un patrón cíclico, mientras que a nivel anual muestran una tendencia general ascendente.
** Aunque los valores reales de las ventas se ajustan a los patrones. Todavia se pueden hacer mejoras ya que se tienen discrepancias.
** Se tiene esperado un incremento significativo pero esperado en el nearshoring, incrementando la competitividad de la industria.
** Tomar medidas ante el acoso laboral hacia las trabajadoras y trabajadores solteros.
** Potenciar las fortalezas con menor enfoque que son de mayor importancia para evitar que el 65.1% de las trabajadoras decidan ya no continuar en la empresa.
** Con base al analisis de ventas definir metas a corto, mediano y largo plazo. Pues de esta manera lograremos observar a mayor medida el crecimiento de la empresa o las areas de mejora.
or, R. (2021, August 23). The Form Way -. Form. https://form.com.mx/the-form-way/
for, R. (2021, September 27). Form right form of packing. Form. https://form.com.mx/
for, R. (2021, August 23). ¿Por qué Nosotros? -. Forma. https://form.com.mx/por-que-nosotros/ El Economista. (2022, August 29). Pase para gol en Norteamérica: la Ley de Reducción de Inflación. El Economista; El Economista. https://www.eleconomista.com.mx/opinion/Pase-para-gol-en-Norteamerica-la-Ley-de-Reduccion-de-Inflacion-20220829-0044.html
Adrián Duhalt. (2024, January 23). México y la Ley para la Reducción de la Inflación en EU. Expansión. https://expansion.mx/opinion/2024/01/23/mexico-y-la-ley-para-la-reduccion-de-la-inflacion-en-eu DW Español. (2023). México, EE. UU. y Canadá quieren liderar la producción mundial de vehículos eléctricos [YouTube Video]. En YouTube. https://www.youtube.com/watch?v=RHp_jSssWMg
Ricardo, D. (2023, February 6). Tendencias en packaging y sostenibilidad para el 2023. Plastico; Plastico. https://www.plastico.com/es/noticias/tendencias-en-packaging-y-sostenibilidad-para-el-2023
Contreras, J., & Contreras, J. (2024b, enero 24). Marcas más valiosas del mundo 2024: Empresas mexicanas destacan en el ranking. Líder Empresarial.https://www.liderempresarial.com/marcas-mas-valiosas-del-mundo-2024-empresas-mexicanas-destacan-en-el-ranking/
Human verification. (s. f.). https://www.eleconomista.com.mx/economia/Inflacion-inicia-el-2024-acelerandose-a-4.90-hila-5-quincenas-al-alza-20240124-0018.html
Importancia de las tendencias de mecado 2024 - Bing. (s. f.). Bing. https://www.bing.com/search?q=Importancia+de+las+Tendencias+de+Mecado+2024&qs=n&form=QBRE&sp=-1&ghc=1&lq=0&pq=importancia+de+las+tendencias+de+mecado+202&sc=11-43&sk=&cvid=D94910A78070405D8C72239C816AFAF0&ghsh=0&ghacc=0&ghpl=
Innovación en la empresa: concepto, importancia y tipologías. (s. f.). UNIR México. https://mexico.unir.net/economia/noticias/innovacion-en-una-empresa/#:~:text=La%20innovaci%C3%B3n%20empresarial%20se%20ha%20vuelto%20clave%20derivado,8%20A%C3%B1ade%20valor%20a%20los%20productos%20o%20servicios.
¿Qué es la automatización? | IBM. (s. f.). https://www.ibm.com/mx-es/topics/automation
Empaques sustentables - Bing. (s. f.). Bing. https://www.bing.com/search?pglt=41&q=Empaques+Sustentables&cvid=81e1393f3b7d42429057e254cb1321cb&gs_lcrp=EgZjaHJvbWUyBggAEEUYOTIGCAEQABhAMgYIAhAAGEAyBggDEAAYQDIGCAQQABhA0gEHMzQyajBqMagCALACAA&FORM=ANNTA1&PC=LCTS
De las Mujeres, I. N. (s. f.). Las Madres en Cifras. gob.mx. https://www.gob.mx/inmujeres/articulos/las-madres-en-cifras
Alcaldes de México (2022, March 22). Nuevo León reduce presión del agua en área metropolitana por sequía. Alcaldes de México. [Imagen] https://www.alcaldesdemexico.com/notas-principales/nuevo-leon-reduce-presion-del-agua-en-area-metropolitana-por-sequia/