Grupo 601
Profesor David Saucedo
Alumna:
Avril Lobato Delgado A00833113
library(ggplot2)
library(dplyr)
library(readxl)
library(tidyr)
library(lubridate)
library(purrr)
library(plotly)
library(forecast)
library(readxl)
library(DataExplorer)
library(dplyr)
library(ggplot2)
library(tm)
library(wordcloud)
library(cluster)
library(factoextra)
library(gridExtra)
library(purrr)
library(pROC)
library(rpart)
library(rpart.plot)
library(e1071)
library(ggpubr)
library(dlookr)
library(zoo)
library(caret)
library(stats)
library(tseries)
library(readr)
library(vars)
library(syuzhet)
library(kableExtra)
library(plotly)
library(scales)
library(readxl)
¿Qué es un análisis exploratorio de los datos? El análisis exploratorio de datos (EDA) es una metodología para comprender, examinar y visualizar la estructura y características de un conjunto de datos antes de aplicar modelos, análisis y/o algoritmos estadísticos más avanzados. El objetivo principal es resumir y descubrir características relevantes de los datos mediante técnicas gráficas y estadísticas descriptivas, para obtener información inicial y detectar posibles patrones, tendencias, anomalías o relaciones que puedan ser relevantes para el problema en cuestión.
¿Cómo contribuye el análisis exploratorio de los datos a mejorar el proceso y los resultados de analítica descriptiva? El análisis exploratorio de datos contribuye a mejorar el proceso y los resultados de la analítica descriptiva mediante la identificación de patrones y tendencias lo que ayuda a comprender mejor el fenómeno que están representando y a generar hipótesis sobre posibles relaciones entre las variables. Asimismo, se detectan anomalías y errores puesto que se distinguen valores atípicos, errores de entrada o inconsistencias en los datos que deben ser corregidos antes de realizar análisis avanzados. De igual manera, al explorar la relación entre variables, es más sencillo seleccionar las variables más relevantes para incluir en análisis posteriores, lo que permite simplificar el modelo y mejorar su interpretabilidad. Inclusive, a través de visualizaciones se muestran relaciones entre variables que pueden ser exploradas más a fondo en análisis posteriores para formular y comprobar ciertas hipótesis. Igualmente, el EDA permite examinar la distribución de las variables, lo que funciona para determinar si los supuestos de ciertos modelos estadísticos son válidos y a elegir las técnicas adecuadas para estos.
Visión:
”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.”
Misión:
“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.”
Objetivos estratégicos:
Sustentabilidad colaborativa: Fomentar el uso de materiales de bajo impacto ambiental mientras optimizamos los recursos sin desperdiciar.
Efectividad colaborativa: Cumplir en tiempo y forma participando proactivamente.
Integridad colaborativa: Actitud de honestidad y transparencia dentro de todos nuestros procesos.
Innovación colaborativa: Constante búsqueda de nuevas y mejores formas de solucionar a través del ingenio y la experimentación.
Calidad colaborativa: Sin comprometer nuestros tiempos, cuidamos cada detalle, desde el espacio de trabajo hasta nuestro producto final.
Flexibilidad colaborativa: Siempre encontraremos el como sí, anticipándonos a las adversidades apoyados de la multidisciplina.
Con base en las gráficas presentes se muestra el Panorama Actual en EUA:
De igual manera, se muestra tendencia en el incremento de las ventas totales de vehículos en EE. UU. en los próximos años, impulsadas por la recuperación económica y la demanda de vehículos nuevos.
df <- read_xlsx("C:\\Users\\AVRIL\\Documents\\Automotriz_ALD.xlsx")
colnames(df)[5] <- "Total_domestic_sales"
df <- na.omit(df)
df <- unique(df)
df$Año <- as.numeric(as.character(df$Año))
plot_ly(df, x = ~Año) %>%
add_lines(y = ~Production_total, name = "Producción Total", line = list(color = "blue")) %>%
add_lines(y = ~Total_domestic_sales, name = "Ventas Totales", line = list(color = "red")) %>%
layout(title = "<b>Industria Automotriz en USA - Producción Total vs Ventas Totales</b>",
xaxis = list(title = "Año"),
yaxis = list(title = "Cantidad"),
legend = list(orientation = "h", x = 0.5, y = -0.2)) # Mover la leyenda a la parte inferior y centrarla
La exportación de vehículos desde México se da a una variedad de puntos, considerando principalmente países en Asia y Europa. Esto permite determinar el papel importante que cumple México en la industria automotriz y su comercialización a países extranjeros reconocidos, siendo el principal Arabia Saudita.
dfaz1 <-read_excel("C:\\Users\\AVRIL\\Documents\\mx_exportacion_vehiculos_pais_destino.xlsx")
dfaz1 <- dfaz1 %>%
rename(País_destino = `País destino`)
# Filtrar los datos para obtener solo las exportaciones de autos para el año 2023
df_2023 <- filter(dfaz1, Año == 2023)
# Calcular el total de exportaciones de autos a cada país destino
exportaciones_por_pais <- df_2023 %>%
group_by(País_destino) %>%
summarise(Total_exportaciones = sum(Cantidad)) %>%
arrange(desc(Total_exportaciones)) %>%
top_n(5)
# Crear el gráfico de barras
ggplot(exportaciones_por_pais, aes(y = reorder(País_destino, Total_exportaciones), x = Total_exportaciones, fill = Total_exportaciones)) +
geom_bar(stat = "identity") +
labs(title = "Top 5 de países destino para exportaciones de autos de México en 2023",
y = "País Destino",
x = "Cantidad de Exportaciones") +
scale_fill_gradient(low = "#F4AC88", high = "#FF5400") +
theme_minimal() +
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20,face = "bold"),
axis.title = element_text(size = 15))+
guides(fill = FALSE)
Las principales empresas que realizan exportaciones desde México corresponden a General Motors, Nissan y Ford. Esto muestra que el sector más destacado lo conforman principalmente empresas americanas (y 1 japonesa), siendo un aspecto relevante debido a la existencia de choques culturales con las compañías coreanas y chinas acorde al actual dueño de Form, Felipe. Determinando de esta forma, la posibilidad de mantener buenas relaciones con los principales líderes en exportación en México, con una mayor facilidad.
# Calcular el total de exportaciones de autos para cada marca
exportaciones_por_marca <- df_2023 %>%
group_by(Marca) %>%
summarise(Total_exportaciones = sum(Cantidad)) %>%
arrange(desc(Total_exportaciones)) %>%
top_n(5)
# Crear el gráfico de barras horizontal para las 10 marcas más exportadas
ggplot(exportaciones_por_marca, aes(y = reorder(Marca, Total_exportaciones), x = Total_exportaciones, fill = Total_exportaciones)) +
geom_bar(stat = "identity") +
labs(title = "Top 5 de marcas más exportadas de autos de México en 2023",
y = "Marca",
x = "Cantidad de Exportaciones") +
scale_fill_gradient(low = "#F4AC88", high = "#FF5400") +
theme_minimal() +
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20,face = "bold"),
axis.title = element_text(size = 15))+
guides(fill = FALSE)
Entre los vehículos que hacen uso de combustible alternativo (o complementario) a la gasolina destacan principalmente los híbridos no enchufables, representando los híbridos enchufables la más baja proporción de ventas en el mercado mexicano. Asimismo, los principales estados donde ocurrieron mayores ventas de este tipo de vehículos fueron Ciudad de México, Estado de México y Nuevo León, siendo algunos de los principales centros económicos que destacaron como pioneros en la integración de este tipo de vehículos. Esto genera una oportunidad para Form para la atención de este mercado ampliamente presente en su Estado de origen, pudiendo complementar sus operaciones al ofrecer el uso de sus soluciones de cartón para embalaje.
# Vehículos Eléctricos
dfve <- read.csv("C:\\Users\\AVRIL\\Documents\\mx_venta_vehiculos_hibridos_electricos_2023.csv")
dfve <- dfve[dfve$ID_ENTIDAD != 99, ]
# Crear un vector con los nombres reales de los estados
nombres_estados <- c("Aguascalientes", "Baja California", "Baja California Sur", "Campeche", "Coahuila", "Colima", "Chiapas", "Chihuahua", "Ciudad de México", "Durango", "Guanajuato", "Guerrero", "Hidalgo", "Jalisco", "Estado de México", "Michoacán", "Morelos", "Nayarit", "Nuevo León", "Oaxaca", "Puebla", "Querétaro", "Quintana Roo", "San Luis Potosí", "Sinaloa", "Sonora", "Tabasco", "Tamaulipas", "Tlaxcala", "Veracruz", "Yucatán", "Zacatecas")
# Crear un data frame con los ID_ENTIDAD y los nombres de los estados
estados_df <- data.frame(ID_ENTIDAD = 1:32, ESTADO = nombres_estados)
# Unir los data frames usando la función merge
dfve <- merge(dfve, estados_df, by = "ID_ENTIDAD", all.x = TRUE)
ventas_por_estado <- dfve %>%
group_by(ESTADO) %>%
summarise(Total_ventas_electricos = sum(VEH_ELECTR),
Total_ventas_hibridos = sum(VEH_HIBRIDAS),
Total_ventas_hibridos_enchufables = sum(VEH_HIBRIDAS_PLUGIN))
ventas_por_estado_long <- ventas_por_estado %>%
pivot_longer(cols = c(Total_ventas_electricos, Total_ventas_hibridos, Total_ventas_hibridos_enchufables),
names_to = "Tipo de Vehículo",
values_to = "Total de Ventas")
# Seleccionar los 10 principales estados con las mayores ventas totales
top5_estados <- ventas_por_estado %>%
slice_max(order_by = Total_ventas_electricos + Total_ventas_hibridos + Total_ventas_hibridos_enchufables, n = 5)
# Filtrar ventas_por_estado_long para incluir solo los 10 principales estados
ventas_top10 <- ventas_por_estado_long %>%
filter(ESTADO %in% top5_estados$ESTADO)
# Crear el gráfico de barras mostrando las ventas divididas por tipo de vehículo para los 10 principales estados
ggplot(ventas_top10, aes(y = reorder(ESTADO, `Total de Ventas`), x = `Total de Ventas`, fill = `Tipo de Vehículo`)) +
geom_bar(stat = "identity", position = "stack") +
labs(title = "Top 5 de estados con ventas de vehículos en México en 2023",
y = "Estado",
x = "Total de Ventas",
fill = "") +
theme_minimal() +
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20, face = "bold"),
axis.title = element_text(size = 15),
legend.title = element_text(size = 16, face = "bold"),
legend.text = element_text(size = 17),
legend.position = "top")
La industria automotriz en México presenta mayor producción local que importaciones, lo cual remarca la relevancia de la industria automotriz en México, siendo también considerable la cantidad unidades exportadas. Es importante destacar el descenso en la producción local debido a la pandemia por COVID-19 en el 2020, así como también su recuperación en años posteriores, siendo un buen indicativo para el futuro de la industria automotriz en el país.
dfaz2 <- mx_automotive_industry <- read_excel("C:\\Users\\AVRIL\\Documents\\mx_automotive_industry.xlsx", sheet = 1)
# Métricas de la Industria Automotriz en México
plot_ly(data = dfaz2, x = ~year) %>%
add_lines(y = ~total_local_production, color = I("blue"), name = "Producción Local") %>%
add_lines(y = ~total_exports, color = I("green"), name = "Exportaciones") %>%
add_lines(y = ~total_imports, color = I("red"), name = "Importaciones") %>%
layout(title = list(text = "<b>Evolución de métricas de Industria Automotriz en México</b>"),
xaxis = list(title = "Año"),
yaxis = list(title = "Valor"),
legend = list(x = 0.5, y = 1))
En relación al Panorama Actual de la industria de Autopartes en EUA se preveé que el promedio de nuevos pedidos de fabricantes: vehículos de motor y repuestos (AMVPNO) desde 1995 hasta 2023 ha sido mayor en el periodo de invierno donde jerárquicamente los meses con mayores ventas son: Enero, Diciembre, Noviembre, Octubre y Spetiembre; lo cual representa cierta estacionalidad en este periodo y una estimación mayor de producción antes de Septiembre.
Predicción de Nuevos pedidos de fabricantes: vehículos de motor y repuestos (AMVPNO) para 2025
En relación al Panorama Actual se muestra:
A partir del año 2020, se observa una estabilización en las ventas, lo que podría ser un indicio de maduración del mercado.
La industria de autopartes en EE. UU. ha experimentado un crecimiento constante en los últimos años, con un valor de mercado de aproximadamente $892 mil millones en 2022. Dicho crecimiento se ha visto impulsado por una serie de factores, como el aumento de la producción de vehículos en EUA, la creciente demanda de vehículos eléctricos e híbridos; y un mayor enfoque en la seguridad y las características tecnológicas en los vehículos.
Por lo tanto, las tendencias de mayor fuerza en esta industria son:
Crecimiento de industria impulsado por factores como el aumento del parque automotor, mayor demanda de vehículos usados y el desarrollo de nuevas tecnologías automotrices.
Se espera que la competencia en la industria nacional e internacional se intensifique, con la entrada de nuevos competidores, especialmente de países asiáticos.
Nuevas oportunidades ante el auge de vehículos eléctricos por ende, la innovación será clave para el éxito de las empresas en la industria de autopartes, ya que permitirá desarrollar productos y servicios más eficientes y competitivos.
df2 <- read_xls("C:\\Users\\AVRIL\\Documents\\Autopartes_ALD.xls")
df2 <- na.omit(df2)
df2 <- unique(df2)
df2$observation_date = as.Date(df2$observation_date)
#Promedio de Nuevos pedidos de fabricantes: vehículos de motor y repuestos (AMVPNO)
df2$Mes <- format(df2$observation_date, "%m")
#Predicción de Nuevos pedidos de fabricantes: vehículos de motor y repuestos (AMVPNO) para 2025
ts_ventas <- ts(df2$AMVPNO, frequency = 12, start = c(1992, 1))
df_ts_ventas <- data.frame(Año = as.Date(time(ts_ventas)), Ventas = as.numeric(ts_ventas))
plot_ly(df_ts_ventas, x = ~Año, y = ~Ventas, type = 'scatter', mode = 'lines', name = 'Ventas', color="orange") %>%
layout(title = "<b>Histórico de Ventas de Autopartes en Estados Unidos</b>",
xaxis = list(title = "Año"),
yaxis = list(title = "Ventas"))
# Ajustar el modelo de series de tiempo automáticamente
modelo <- auto.arima(ts_ventas)
# Generar predicciones hasta el cierre del año 2025 (36 meses más allá de los datos existentes)
predicciones <- forecast(modelo, h = 23)
predicciones
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2024 61033.07 58054.83 64011.32 56478.24 65587.91
## Feb 2024 61363.02 57090.37 65635.68 54828.56 67897.48
## Mar 2024 61494.39 56753.76 66235.02 54244.22 68744.56
## Apr 2024 61596.43 56581.21 66611.66 53926.31 69266.56
## May 2024 61698.47 56422.93 66974.02 53630.22 69766.73
## Jun 2024 61800.52 56276.90 67324.13 53352.87 70248.16
## Jul 2024 61902.56 56141.55 67663.57 53091.85 70713.26
## Aug 2024 62004.60 56015.60 67993.60 52845.21 71163.99
## Sep 2024 62106.64 55898.01 68315.27 52611.36 71601.92
## Oct 2024 62208.68 55787.93 68629.43 52389.00 72028.37
## Nov 2024 62310.73 55684.65 68936.80 52177.01 72444.44
## Dec 2024 62412.77 55587.53 69238.00 51974.47 72851.07
## Jan 2025 62514.81 55496.06 69533.55 51780.57 73249.05
## Feb 2025 62616.85 55409.79 69823.91 51594.61 73639.10
## Mar 2025 62718.89 55328.32 70109.47 51415.98 74021.80
## Apr 2025 62820.93 55251.29 70390.58 51244.16 74397.71
## May 2025 62922.98 55178.40 70667.55 51078.67 74767.28
## Jun 2025 63025.02 55109.38 70940.66 50919.09 75130.95
## Jul 2025 63127.06 55043.97 71210.15 50765.04 75489.07
## Aug 2025 63229.10 54981.97 71476.23 50616.20 75842.00
## Sep 2025 63331.14 54923.16 71739.12 50472.25 76190.04
## Oct 2025 63433.18 54867.38 71998.99 50332.91 76533.46
## Nov 2025 63535.23 54814.45 72256.00 50197.95 76872.51
Es posible observar que las principales plantas de autopartes en México durante el 2022 se concentraron en Coahuila y Puebla, destacando como los estados con mayor valor comercial en exportaciones. Ante esto es necesario considerar la cercanía de Coahuila con Nuevo León, estado en el que está presente la planta de Form. Esto supone una ventaja al mantener cercanía en uno de los puntos clave de la industria de autopartes en el país.
Al hacer la comparación entre el valor comercial del 2021 con el 2022, Coahuila vuelve a destacar como el estado con mayor valor total en la suma de ambos años. Esto reafirma lo mencionado en el punto anterior, siendo Coahuila un punto estrátegico en la industria de autopartes y la ventaja que eso representa para Form al estar próximo. Sin embargo, esto también tiene una consideración importante, siendo que a pesar de mantener el valor más elevado durante ambos años, este fue el mismo, es decir, no hubo un crecimiento, a diferencia de Puebla, en el cual sí hubo un crecimiento considerable con respecto al año previo, pero igualmente es un comportamiento favorable comparando con el resto de estados, en los cuales hubo decrecimiento.
dfap1 <- read.csv("C:\\Users\\AVRIL\\Documents\\mex_exports_autoparts.csv")
df_2021_2022 <- subset(dfap1, year %in% c(2021, 2022))
# Agrupar los datos por estado y año, y calcular el total del valor comercial para cada estado en cada año
state_trade <- df_2021_2022 %>%
group_by(State, year) %>%
summarise(total_trade = sum(trade_value))
# Seleccionar los 10 estados con el valor comercial más alto en ambos años
top10_states <- state_trade %>%
group_by(year) %>%
top_n(8, total_trade) %>%
arrange(year, desc(total_trade))
# Crear el gráfico de barras
ggplot(top10_states, aes(x = reorder(State, total_trade), y = total_trade, fill = factor(year))) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Comparación de valor comercial entre 2021 y 2022 (Top 8 estados)",
x = "Estado",
y = "Valor Comercial Total",
fill = "Año") +
theme_minimal() +
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20, face = "bold"),
axis.title = element_text(size = 15),
legend.title = element_text(size = 16, face = "bold"),
legend.text = element_text(size = 17),
axis.text = element_text(size = 12))
Finalmente, en la industria de autopartes en México a lo largo del tiempo se observó un impacto considerable debido a la pandemia por COVID-19 en 2020, sin embargo esta tuvo una recuperación considerable en años posteriores. Asimismo, se identificó que el valor de la producción local es mayor al de las importaciones de otros países. Esto muestra la magnitud de la importancia de la producción de autopartes como una industria sólida en el país.
dfap2 <- mx_automotive_industry <- read_excel("C:\\Users\\AVRIL\\Documents\\mx_automotive_industry.xlsx", sheet = "mx_autoparts_market")
# Crear el gráfico de líneas
plot_ly(dfap2, x = ~year) %>%
add_lines(y = ~total_local_production, color = I("blue"), name = "Producción Local") %>%
add_lines(y = ~total_exports, color = I("green"), name = "Exportaciones") %>%
add_lines(y = ~total_imports, color = I("red"), name = "Importaciones") %>%
layout(title = list(text = "<b>Evolución de métricas de Autopartes en México</b>"),
xaxis = list(title = "Año"),
yaxis = list(title = "Valor"),
legend = list(x = 0.5, y = 1))
Las siguientes dos gráficas, muestran que el Panorama Actual de la industria del cartón tiene como competencia la fabricación de fibra y papel donde este último es el primero en percibir mayores ingresos anuales. A pesar de esto se visualiza que:
La industria del cartón en Estados Unidos ha experimentado un crecimiento constante en los últimos años puesto que, entre 2012 y 2022, los ingresos anuales de la industria aumentaron en un 50%.
El crecimiento se ha desacelerado ligeramente en los últimos años, pero se espera que continúe en el futuro.
df3 <- read_xlsx("C:\\Users\\AVRIL\\Documents\\Carton_ALD.xlsx")
df3 <- na.omit(df3)
df3 <- unique(df3)
df3$Año <- as.numeric(df3$Año)
#Promedio de ingresos por año
ggplot(df3, aes(x = Año)) +
geom_bar(aes(y = paper_mills, fill = "Paper"), stat = "identity", position = "dodge") +
geom_bar(aes(y = pulp_mills, fill = "Pulp"), stat = "identity", position = "dodge") +
geom_bar(aes(y = paperboard_mills, fill = "Paperboard"), stat = "identity", position = "dodge") +
labs(title = "Ingresos de la industria de las fábricas de pulpa, papel y cartón en EE. UU. de 2012 a 2024",
x = "Año",
y = "Miles de millones de dólares estadounidenses",
fill = "Tipo") +
scale_fill_manual(values = c("Paper" = "red", "Pulp" = "lightblue", "Paperboard" = "green")) +
theme_minimal()+
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20, face = "bold"),
axis.title = element_text(size = 15),
legend.title = element_text(size = 16, face = "bold"),
legend.text = element_text(size = 17))
El valor comercial total de las importaciones de productos de cartón en México obtuvó el 2do valor más alto entre los países de América, superado únicamente por Estados Unidos. Esto permite comprobar la demanda en empresas con sede en México por soluciones de cartón.
dfcm <- read.csv("C:\\Users\\AVRIL\\Documents\\ImportersBoxes2020_2021.csv")
# Filtrar Países de Norte América
df_north_america <- subset(dfcm, Continent == "North America")
# Obtener el top 5 de países con mayor trade value
top5_tradevalue <- df_north_america %>%
arrange(desc(Trade.Value)) %>%
head(5)
# Crear el gráfico de barras comparando el valor comercial en América del Norte para el top 5 de países
ggplot(top5_tradevalue, aes(x = reorder(Country, Trade.Value), y = Trade.Value, fill = Country)) +
geom_bar(stat = "identity") +
geom_text(aes(label = comma(Trade.Value)), vjust = -0.5, size = 8, color = "black") +
labs(title = "Top 5 de países en valor comercial de cajas en América del Norte en 2021",
x = "País",
y = "Valor Comercial") +
scale_y_continuous(labels = comma) + # Formatear los números en el eje y
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(face = "bold", size = 20),
axis.title = element_text(size = 18),
axis.text = element_text(size = 18),
legend.position = "none")
El crecimiento anual entre 2020 y 2021 en el valor comercial del cartón en México se destacó con el tercer valor más alto entre los países en América. Este dato, junto con lo mencionado anteriormente, sugiere un aumento positivo en la demanda de estas soluciones, lo que remarca la relevancia de las operaciones de Form. Sin embargo, es importante tener en cuenta que en ambos casos (valor total y crecimiento), México es superado por Estados Unidos, lo cual es comprensible dada la potencia comercial que representa Estados Unidos.
# Obtener el top 5 de países con mayor crecimiento en valor
top5_tradegrowth <- df_north_america %>%
arrange(desc(Trade.Value.Growth.Value)) %>%
head(5)
# Crear el gráfico de barras comparando el valor del crecimiento del valor comercial en América del Norte para el top 5 de países
ggplot(top5_tradegrowth, aes(x = reorder(Country, Trade.Value.Growth.Value), y = Trade.Value.Growth.Value, fill = Country)) +
geom_bar(stat = "identity") +
geom_text(aes(label = comma(Trade.Value.Growth.Value)), vjust = -0.5, size = 8, color = "black") +
labs(title = "Top 5 de Países con Mayor Crecimiento de Valor Comercial de Cajas en América del Norte en 2021",
x = "País",
y = "Crecimiento del Valor Comercial") +
scale_y_continuous(labels = comma) + # Formatear los números en el eje y
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(face = "bold", size = 18),
axis.title = element_text(size = 20),
axis.text = element_text(size = 18),
legend.position = "none")
Acuerdos comerciales: Los tratados comerciales entre México y EE.UU., como el T-MEC, influyen directamente en las operaciones de nearshoring, facilitando o dificultando el comercio.
Regulaciones de importación/exportación: Cambios en las políticas pueden afectar la eficiencia y costos de las operaciones transfronterizas.
Nearshoring y relocalización: El aumento de empresas relocalizando su producción cerca de EE.UU. para reducir costos y tiempos de envío puede ser una oportunidad para FORM.
Tipo de cambio: Fluctuaciones entre el peso mexicano y el dólar estadounidense pueden impactar los costos y precios de los productos.
Innovaciones en materiales y procesos de empaque: Avances tecnológicos que permitan mejorar la eficiencia, reducir costos o incrementar la sostenibilidad pueden ser clave.
Digitalización y automatización: La integración de tecnologías digitales en la cadena de suministro puede mejorar la eficiencia operativa.
Normativas ambientales: Legislaciones más estrictas sobre materiales de empaque y reciclaje pueden requerir adaptaciones en los procesos de producción.
Regulaciones laborales: Cambios en las leyes laborales tanto en México como en EE.UU. pueden influir en los costos y operaciones.
Gestión de residuos y reciclaje: La presión para mejorar la sostenibilidad de los empaques puede llevar a buscar materiales más ecológicos.
Huella de carbono: La necesidad de reducir las emisiones de CO2 podría influir en las decisiones de logística y producción.
Innovación en empaques sostenibles: Desarrollar y promocionar soluciones de empaque que sean tanto funcionales como ambientalmente responsables, anticipándose a las tendencias del mercado y regulaciones. Esto puede incluir la investigación en materiales biodegradables o reciclables, y procesos de producción más eficientes.
Digitalización y mejora de la eficiencia operativa: Invertir en tecnología para la automatización de procesos y la digitalización de la cadena de suministro. Esto no solo puede mejorar la eficiencia operativa, sino también ofrecer mejor transparencia y trazabilidad, aspectos cada vez más valorados por los clientes.
Expansión de mercado y diversificación: Aunque la empresa tiene una presencia fuerte en San Antonio, explorar nuevos mercados en EE.UU. y otros países podría ser estratégico. Diversificar la cartera de productos para atender a otras industrias además de la automotriz también puede ayudar a mitigar riesgos y aprovechar nuevas oportunidades de nearshoring.
Situación Problema 1: Actualmente FORM tiene como reto la incertidumbre de la demanda para su predicción y eficiencia operatia, puesto que FORM tiene interés en prever la producción para anticipar la demanda diaria de sus proveedores. Esto permitirá planificar con precisión y satisfacer eficientemente los pedidos en tiempo y forma. Cabe destacar que para dicho análisis también se busca evaluar el impacto del Nearshoring en esta situación, con el fin de determinar cómo dicho efecto ayuda y/o afecta a la empresa a alcanzar sus objetivos y, por ende, generar estrategias efectivas.
Situación Problema 2: Asimismo, FORM se enfrenta a la alta rotación de empleados, que afecta a la empresa de manera generalizada. A pesar de implementar diversas medidas y herramientas en áreas como prestaciones y condiciones laborales, los empleados tienden a dejar sus puestos poco después de comenzar su contrato. Ante esta situación, la empresa busca comprender este comportamiento y desarrollar estrategias para mejorar la retención de su personal con el fin de evitar efectos a mediano y largo plazo como el aumento de costos, deterioro de cultura empresarial, etc.
# Leer y observar el archivo
rh_alt <- read_excel("C:\\Users\\AVRIL\\Documents\\Datos_FORM_RH_FJ2024.xlsx")
str(rh_alt)
## tibble [606 × 10] (S3: tbl_df/tbl/data.frame)
## $ Fecha de nacimiento: POSIXct[1:606], format: "1985-08-18" "1969-06-27" ...
## $ HOY : POSIXct[1:606], format: "2024-04-06" "2024-04-06" ...
## $ Género : chr [1:606] "Femenino" "Masculino" "Masculino" "Femenino" ...
## $ Fecha de Alta : POSIXct[1:606], format: "2017-02-20" "2017-12-01" ...
## $ Puesto : chr [1:606] "Costurera" "Gestor" "Chofer" "Lider" ...
## $ Dpto : chr [1:606] "Costura" "Embarques" "Embarques" "Produccion Cartón Mdl" ...
## $ SD : chr [1:606] "152.86" "176.72" "176.72" "144.45" ...
## $ Municipio : chr [1:606] "San Nicolas De Los G" "Monterrey" "Pesqueria" "Apodaca" ...
## $ Estado : chr [1:606] "Nuevo León" "Nuevo León" "Nuevo León" "Nuevo León" ...
## $ Estado Civil : chr [1:606] "Casado" "Casado" "Casado" "Soltero" ...
# Asignar nombres de columnas
colnames(rh_alt)<-c('fecha_nacimiento','fecha_actual','genero', 'fecha_alta','puesto','depto','salario_diario','mpio','estado','estado_civil')
# Reemplazar valores erróneos en la base de datos
rh_alt$estado_civil[rh_alt$estado_civil == "Soltera"] <- "Soltero"
rh_alt$estado_civil[rh_alt$estado_civil == "Casada"] <- "Casado"
rh_alt$estado_civil[rh_alt$estado_civil == "casado"] <- "Casado"
rh_alt$estado_civil[rh_alt$estado_civil == "Divorciada"] <- "Divorciado"
rh_alt$estado_civil[rh_alt$estado_civil == "Viuda"] <- "Viudo"
rh_alt$puesto[rh_alt$puesto == "Ayudante de embarques"] <- "Ayudante de Embarques"
rh_alt$puesto[rh_alt$puesto == "Ayud. De Embarques"] <- "Ayudante de Embarques"
rh_alt$puesto[rh_alt$puesto == "Auxiliar de Embarques"] <- "Ayudante de Embarques"
rh_alt$puesto[rh_alt$puesto == "Ayudante de soldador"] <- "Ayudante de Soldador"
rh_alt$puesto[rh_alt$puesto == "Ayu. De Soldador"] <- "Ayudante de Soldador"
rh_alt$puesto[rh_alt$puesto == "Ay. General"] <- "Ayudante General"
rh_alt$puesto[rh_alt$puesto == "Ayudante general"] <- "Ayudante General"
rh_alt$puesto[rh_alt$puesto == "Ayu. De Pintor"] <- "Ayudante de Pintor"
rh_alt$puesto[rh_alt$puesto == "Ayudante De Pintor"] <- "Ayudante de Pintor"
rh_alt$puesto[rh_alt$puesto == "Ayudante general-Cedis"] <- "Ayudante general CEDIS"
rh_alt$puesto[rh_alt$puesto == "Inspectora de Calidad"] <- "Calidad"
rh_alt$puesto[rh_alt$puesto == "Inspector de calidad"] <- "Calidad"
rh_alt$puesto[rh_alt$puesto == "Inspectora De Calidad"] <- "Calidad"
rh_alt$puesto[rh_alt$puesto == "Materialista"] <- "Materiales"
rh_alt$puesto[rh_alt$puesto == "Operador Sierra"] <- "Operador de Sierra"
rh_alt$puesto[rh_alt$puesto == "Materialista"] <- "Materiales"
rh_alt$puesto[rh_alt$puesto == "Costurera"] <- "Costura"
rh_alt$puesto[rh_alt$puesto == "Costurero"] <- "Costura"
rh_alt$estado[rh_alt$estado == "Nuevo Leon"] <- "Nuevo León"
rh_alt$mpio[rh_alt$mpio == "Ramoz Arizpe"] <- "Ramos Arizpe"
rh_alt$mpio[rh_alt$mpio == "San Nicolas De Los G"] <- "San Nicolas de los Garza"
rh_alt$mpio[rh_alt$mpio == "San Nicolas"] <- "San Nicolas de los Garza"
rh_alt$depto[rh_alt$depto == "Cedis"] <- "CEDIS"
rh_alt$depto[rh_alt$depto == "Ehs"] <- "EHS"
rh_alt$depto[rh_alt$depto == "Produccion Cartón MC"] <- "Producción Cartón MC"
rh_alt$depto[rh_alt$depto == "Produccion Cartón Mdl"] <- "Produccion Cartón MDL"
rh_alt$depto[rh_alt$depto == "Producción Retorn"] <- "Produccion Retornable"
rh_alt$depto[rh_alt$depto == "Paileria"] <- "Paileria y Pintura"
rh_alt <- rh_alt %>%
mutate(depto = ifelse(is.na(depto), "Área No Definida", depto))
# Convertir fechas en formato de fecha
rh_alt$fecha_nacimiento<-as.Date(rh_alt$fecha_nacimiento,format="%m/%d/%Y")
rh_alt$fecha_actual<-as.Date(rh_alt$fecha_actual,format="%m/%d/%Y")
# Crear columna edad
edad<-as.numeric(difftime(rh_alt$fecha_actual, rh_alt$fecha_nacimiento, units = "days") / 365)
rh_alt$edad<-edad
# Reemplazar outliers
mediana_edad <- median(rh_alt$edad, na.rm = TRUE)
rh_alt$edad <- ifelse(rh_alt$edad < 10, mediana_edad, rh_alt$edad)
# Conversión a factores
rh_alt$genero<-as.factor(rh_alt$genero)
rh_alt$puesto<-as.factor(rh_alt$puesto)
rh_alt$depto<-as.factor(rh_alt$depto)
rh_alt$mpio<-as.factor(rh_alt$mpio)
rh_alt$estado<-as.factor(rh_alt$estado)
rh_alt$estado_civil<-as.factor(rh_alt$estado_civil)
rh_alt$salario_diario<-as.numeric(rh_alt$salario_diario)
summary(rh_alt)
## fecha_nacimiento fecha_actual genero
## Min. :1962-12-29 Min. :2024-04-06 Femenino :335
## 1st Qu.:1983-12-04 1st Qu.:2024-04-06 Masculino:271
## Median :1994-03-22 Median :2024-04-06
## Mean :1991-08-17 Mean :2024-04-06
## 3rd Qu.:2000-08-06 3rd Qu.:2024-04-06
## Max. :2022-10-31 Max. :2024-04-06
##
## fecha_alta puesto
## Min. :2017-02-20 00:00:00.00 Ayudante General :497
## 1st Qu.:2023-01-10 00:00:00.00 Costura : 15
## Median :2023-06-15 12:00:00.00 Soldador : 15
## Mean :2023-04-15 08:54:39.21 Calidad : 14
## 3rd Qu.:2023-09-11 00:00:00.00 Montacarguista : 12
## Max. :2024-03-07 00:00:00.00 Ayudante de Embarques: 7
## (Other) : 46
## depto salario_diario mpio
## Área No Definida :371 Min. :144.4 Apodaca :418
## Produccion Cartón MDL: 55 1st Qu.:217.6 Pesqueria : 75
## Producción Cartón MC : 40 Median :217.6 Juarez : 58
## Paileria y Pintura : 26 Mean :211.2 Guadalupe : 25
## Materiales : 18 3rd Qu.:217.6 Ramos Arizpe : 18
## Produccion Retornable: 18 Max. :261.2 San Nicolas de los Garza: 3
## (Other) : 78 (Other) : 9
## estado estado_civil edad
## Coahuila : 19 Casado :162 Min. :18.43
## Nuevo León:587 Divorciado : 2 1st Qu.:23.77
## Soltero :280 Median :30.08
## Union Libre:159 Mean :32.71
## Unión libre: 1 3rd Qu.:40.37
## Viudo : 2 Max. :61.31
##
# Dataset para kmeans
rh_edad<-rh_alt %>%
dplyr::select(genero,estado_civil,salario_diario,edad)
rh_edad_norm<-scale(rh_edad[3:4]) # Escalar variables para evitar sesgo
# Calcular cantidad adecuada de clusters utilizando el método de wss
set.seed(123)
wss <- function(k) {
kmeans(rh_edad_norm, k, nstart = 10 )$tot.withinss
}
k.values <- 1:15
wss_values <- map_dbl(k.values, wss)
plot(k.values, wss_values,
type="b", pch = 19, frame = FALSE,
xlab="Number of clusters K",
ylab="Total within-clusters sum of squares")
# Creación de clusters mediante kmeans
set.seed(123)
edad_cluster<-kmeans(rh_edad_norm,3)
# Gráfica de clusters resultantes
fviz_cluster(edad_cluster, geom = "point", data = rh_edad_norm) + ggtitle("Clusters de Bajas en Form")
# Añadir el cluster al Dataframe
rh_clusters <- rh_alt %>%
mutate(Cluster = edad_cluster$cluster)
# Observar características del cluster
rh_clusters %>%
mutate(Cluster = edad_cluster$cluster) %>%
group_by(Cluster) %>%
summarise(max_edad = max(edad), mean_salario_diario = mean(salario_diario, na.rm = TRUE))
## # A tibble: 3 × 3
## Cluster max_edad mean_salario_diario
## <int> <dbl> <dbl>
## 1 1 54.4 178.
## 2 2 61.3 218.
## 3 3 37.1 222.
Tras haber realizado un proceso de clusterización por medio del algoritmo de K-means, se asignaron a la base de datos de bajas de rh para observar la composición de cada uno en base a determinadas características de los empleados que abandonan.
Se determina que la mayor parte de los empleados adultos que abandonaron son jovenes solteros o en unión libre, lo cual supone que tienen una mayor libertad e independencia para explorar otras oportunidades laborales al no existir un comrpomiso formal o familiar. A diferencia de esto, se puede observar que los adultos mayores que abandonan son en su mayoría casados, pudiendo implicar que esta característica no impacta en su decisión.
ggplot(rh_clusters, aes(x = estado_civil, fill = Cluster_Name)) +
geom_bar(position = "dodge", alpha = 0.7) +
labs(title = "Estado Civil por Cluster de Bajas en Form",
x = "Estado Civil",
y = "Count") +
theme_minimal() +
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20, face = "bold"),
axis.title = element_text(size = 15),
legend.title = element_text(size = 16, face = "bold"),
legend.text = element_text(size = 17),
axis.text = element_text(size = 15))
Se puede observar que los miembros del clúster adulto suelen tener un menor salario que los demás, lo cual puede tener una influencia en su razón para abandonar. Sin embargo, al comparar los clusters joven y adulto mayor, se observa tienen diferencias mínimas en su salario.
ggplot(rh_clusters, aes(x = edad, y = salario_diario, color = Cluster_Name)) +
geom_point() +
labs(title = "Salario Diario vs. Edad por Cluster de Bajas en Form",
x = "Edad",
y = "Salario Diario") +
theme_minimal()+
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20, face = "bold"),
axis.title = element_text(size = 15),
legend.title = element_text(size = 16, face = "bold"),
legend.text = element_text(size = 17),
axis.text = element_text(size = 15))
Tanto el cluster de adultos mayores como el de jóvenes que abandonan están mayormente compuestos por mujeres, lo cual puede suponer un problema en el clima organizacional percibido por estas, así como una posible falta de oportunidades de crecimiento (particularmente en el cluster jóven), entre otras situaciones. Esta situación parece no influir sobre el cluster de adultos, estando compuesto de manera igual por ambos géneros.
# Gráfico de Barras Apiladas de Género por Cluster_Name
ggplot(rh_clusters, aes(x = Cluster_Name, fill = genero)) +
geom_bar(position = "dodge", alpha = 0.7) +
labs(title = "Distribución de Género por Cluster de Bajas en Form",
x = "Cluster_Name",
y = "Count") +
theme_minimal()+
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20, face = "bold"),
axis.title = element_text(size = 15),
legend.title = element_text(size = 16, face = "bold"),
legend.text = element_text(size = 17),
axis.text = element_text(size = 15))
La mayor parte de los miembros de cada clúster proviene de Apodaca, esto pues es el municipio donde está presente la planta de Form, asi que es necesario reconocer que Apodaca contiene el 70% de parques industriales del estado de Nuevo León, por lo cual existe una variedad de plantas productivas cercanas. Esto otorga mayor libertad a los empleados a renunciar y explorar otras oportunidades sin implicar un impacto significativo en su rutina diaria respecto a los traslados.
# Crear el gráfico de barras apiladas municipio
ggplot(rh_clusters, aes(x = Cluster_Name, fill = mpio)) +
geom_bar(position = "stack", alpha = 0.7) +
labs(title = "Distribución de Municipio por Cluster de Bajas en Form",
x = "Cluster_Name",
y = "Count") +
theme_minimal() +
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20, face = "bold"),
axis.title = element_text(size = 15),
legend.title = element_text(size = 16, face = "bold"),
legend.text = element_text(size = 17),
axis.text = element_text(size = 15))
El departamento con mayor abandono en cada uno de los clusters corresponde al de Área No Identificad (compuesto mayormente del puesto de ayudante general), seguidos del de Producción Cartón MDL y MC, implicando una posible insatisfacción con las tareas particulares del puesto de ayudante general (predominante), pudiendo ser por la demanda de trabajo, la repetición continua de tareas o el clima laboral particular de este puesto. De acuerdo a lo comentado por Felipe, no existe una capacitación hacia estos sino la necesidad de aprendizaje visual por los nuevos empleados hacia los compañeros ya experimentados. Esto puede suponer dificultades para la adaptación al puesto, lo que guiaría a una temprana recesión por parte de estos.
ggplot(rh_clusters, aes(x = Cluster_Name, fill = depto)) +
geom_bar(position = "dodge", alpha = 0.7) +
ggtitle("Puestos de Colaboradores por Cluster") +
theme_minimal() +
theme(axis.text.y = element_text(hjust = 1, size= 18, face = "bold"),
plot.title = element_text(size = 20, face = "bold"),
axis.title = element_text(size = 15),
legend.title = element_text(size = 16, face = "bold"),
legend.text = element_text(size = 17),
axis.text = element_text(size = 15))
df<- read_excel("C:\\Users\\AVRIL\\Documents\\Encuesta_Datos_FORM_Fall2023.xlsx")
# Nombres, tipo y registros de las variables
str(df)
## tibble [106 × 23] (S3: tbl_df/tbl/data.frame)
## $ Encuesta : num [1:106] 1 2 3 4 5 6 7 8 9 10 ...
## $ Puesto de trabajo - Selected Choice : chr [1:106] "Administrativo" "Costurera" "Ayudante general" "Ayudante general" ...
## $ Puesto de trabajo - Otro - Text : chr [1:106] NA NA NA NA ...
## $ Antiguedad en la empresa - Meses : num [1:106] 9 36 4 2 1 36 36 36 36 1 ...
## $ ¿Cuál fue la principal razón por la que entraste a este trabajo? : chr [1:106] "Por el salario" "Otro" "Ubicación de la empresa" "Ubicación de la empresa" ...
## $ 1 - Considero que el salario que recibo es bueno para el trabajo que realizo : chr [1:106] "Totalmente de acuerdo" "Medianamente de acuerdo" "Medianamente en desacuerdo" "Totalmente de acuerdo" ...
## $ 2 - Mis prestaciones son algo que hace que me quede en la empresa : chr [1:106] "Medianamente de acuerdo" "Medianamente de acuerdo" "Totalmente en desacuerdo" "Medianamente de acuerdo" ...
## $ 3 - La jornada laboral no es excesiva : chr [1:106] "Totalmente de acuerdo" "Totalmente de acuerdo" "Totalmente en desacuerdo" "Totalmente de acuerdo" ...
## $ 4 - FORM me ha ofrecido las herramientas necesarias para mi desempeño y aprendizaje : chr [1:106] "Totalmente de acuerdo" "Medianamente de acuerdo" "Totalmente en desacuerdo" "Totalmente de acuerdo" ...
## $ 5 - Que haga mucho frío o calor en mi área de trabajo no es algo que me moleste : chr [1:106] "Medianamente en desacuerdo" "Ni de acuerdo ni en desacuerdo" "Ni de acuerdo ni en desacuerdo" "Medianamente de acuerdo" ...
## $ 6 - Mi nivel de estrés durante la jornada laboral es bajo : chr [1:106] "Totalmente de acuerdo" "Medianamente en desacuerdo" "Totalmente en desacuerdo" "Totalmente de acuerdo" ...
## $ 7 - Me puedo transportar de forma segura de mi casa a mi trabajo y no me cuesta demasiado esfuerzo llegar : chr [1:106] "Medianamente de acuerdo" "Medianamente en desacuerdo" "Medianamente de acuerdo" "Totalmente de acuerdo" ...
## $ 8 - Mi zona de trabajo es cómoda y segura para hacer mis actividades : chr [1:106] "Totalmente de acuerdo" "Medianamente de acuerdo" "Medianamente de acuerdo" "Totalmente de acuerdo" ...
## $ 9 - Es muy probable que siga trabajando en FORM en un futuro : chr [1:106] "Medianamente de acuerdo" "Totalmente de acuerdo" "Totalmente en desacuerdo" "Medianamente de acuerdo" ...
## $ ¿Has experimentado situaciones de conflicto, acoso o que te hayan hecho sentir inseguro durante tu tiempo en la empresa?: chr [1:106] "No" "No" "Si" "No" ...
## $ En 3 palabras o menos ¿Qué aspectos de tu puesto actual te resultan menos satisfactorios? : chr [1:106] "cotización ante imss, fecha de pago, comer a las 3pm" "Ninguno" "mucho trabajo, estrés" "Todo bien" ...
## $ ¿Cómo te sientes en FORM? : chr [1:106] "agusto, feliz" "Bien" "cómoda, no satisfecha" "Tranquila y contenta" ...
## $ Edad : chr [1:106] "30" "54" "21" "20" ...
## $ Género : chr [1:106] "Femenino" "Femenino" "Femenino" "Femenino" ...
## $ Estado civil : chr [1:106] "Unión libre" "Casado" "Soltero" "Casado" ...
## $ Municipio de residencia : chr [1:106] "Apodaca" "Apodaca" "Apodaca" "Apodaca" ...
## $ Nivel de escolaridad : chr [1:106] "Licenciatura" "Primaria" "Preparatoria" "Preparatoria" ...
## $ Número de dependientes económicos (personas que dependen de ti) : num [1:106] 0 0 0 0 0 2 1 0 0 2 ...
# Eliminar columna ID "Encuestas"
df$Encuesta <- NULL
# Actualizar nombre de columnas para que sea más manejable
colnames(df) <- c("puesto_de_trabajo", "puesto_de_trabajo_otro", "meses_antigüedad", "razon_trabajar_form", "escala_salario_justo", "escala_percepcion_prestaciones", "perpcepcion_peso_negativo_jornada", "percepcion_deserrollo_personal_form", "percepcion_comodidad_clima_area", "percepcion_estres_bajo", "percepcion_facilidad_traslado", "percepcion_comodidad_area_trabajo", "percepcion_probabilidad_seguir_form", "situaciones_acoso", "opinion_malos_aspectos", "opinion_trabajar_forms", "edad", "género", "estado_civil", "municipio", "nivel_escolaridad", "num_dependientes_económicos")
# Eliminar columna "puesto_trabajo_otro"
df$puesto_de_trabajo_otro <- NULL
# Cambiar variables cateóricas a factor
df$puesto_de_trabajo <- as.factor(df$puesto_de_trabajo)
df$razon_trabajar_form <- as.factor(df$razon_trabajar_form)
df$situaciones_acoso <- as.factor(df$situaciones_acoso)
df[, 17:20] <- lapply(df[, 17:20], as.factor)
# Cambiar etiqueta erronea en variable percepcion_facilidad_traslado
df$percepcion_facilidad_traslado[df$percepcion_facilidad_traslado == "Totalmende en desacuerdo"] <- "Totalmente en desacuerdo"
# Transformación de variables (5 a 13) de escala ordinal a valor numérico
niveles <- c("Totalmente en desacuerdo", "Medianamente en desacuerdo",
"Ni de acuerdo ni en desacuerdo", "Medianamente de acuerdo",
"Totalmente de acuerdo")
valores <- c(1, 2, 3, 4, 5)
df[, 4:12] <- lapply(df[, 4:12], function(x) {
match(x, niveles)
})
# Cambiar formato incorrecto en edad
df$edad[df$edad == "30 años"] <- "30"
df$edad <- as.numeric(df$edad)
# Extraer variables de texto libre
df_sentiment <- df[,14:15]
# Eliminar variables texto dataframe original
df$opinion_malos_aspectos <- NULL
df$opinion_trabajar_forms <- NULL
## # A tibble: 6 × 19
## puesto_de_trabajo meses_antigüedad razon_trabajar_form escala_salario_justo
## <fct> <dbl> <fct> <int>
## 1 Administrativo 9 Por el salario 5
## 2 Costurera 36 Otro 4
## 3 Ayudante general 4 Ubicación de la empre… 2
## 4 Ayudante general 2 Ubicación de la empre… 5
## 5 Ayudante general 1 Ubicación de la empre… 3
## 6 Ayudante general 36 Razones personales 4
## # ℹ 15 more variables: escala_percepcion_prestaciones <int>,
## # perpcepcion_peso_negativo_jornada <int>,
## # percepcion_deserrollo_personal_form <int>,
## # percepcion_comodidad_clima_area <int>, percepcion_estres_bajo <int>,
## # percepcion_facilidad_traslado <int>,
## # percepcion_comodidad_area_trabajo <int>,
## # percepcion_probabilidad_seguir_form <int>, situaciones_acoso <fct>, …
puesto_de_trabajo: Puesto actual en el que labora el empleado.
meses_antigüedad: Número de meses que el empleado ha laborado en la empresa.
razon_trabajar_form: Motivo por el cual los empleados decidieron trabajar en Form.
escala_salario_justo: Escala 1-5 (menor a mayor) sobre que tan justo se percibe el salario recibido por el trabajo realizado.
escala_percepcion_prestaciones: Escala 1-5 (menor a mayor) sobre que tan adecuadas se perciben las prestaciones recibidas.
perpcepcion_peso_negativo_jornada: Escala 1-5 (menor a mayor) sobre que tan ardua se siente la jornada laboral.
percepcion_deserrollo_personal_form: Escala 1-5 (menor a mayor) sobre que tanta influencia de Form se percibe en el desarrollo de habilidades profesionales.
percepcion_comodidad_clima_area: Escala 1-5 (menor a mayor) sobre que tan agradable se percibe el ambiente de trabajo.
percepcion_estres_bajo: Escala 1-5 (menor a mayor) sobre que la percepción de que el estrés laboral es bajo.
percepcion_facilidad_traslado: Escala 1-5 (menor a mayor) sobre que tan fácil y accesible es llegar de su casa a la planta y viceversa.
percepcion_comodidad_area_trabajo: Escala 1-5 (menor a mayor) sobre que tan agradable se percibe el espacio en el que se trabaja.
percepcion_probabilidad_seguir_form: Escala 1-5 (menor a mayor) sobre la confianza que se siente en continuar trabajando en Form en el largo plazo.
situaciones_acoso: Si se ha experimentado al menos una situación que haya hecho sentir incómoda a la persona.
edad: Número de años de la persona.
género: Género de la persona.
estado_civil: Estado civil de la persona.
municipio: Municipio de residencia de la persona.
nivel_escolaridad: Último grado de escolaridad cursado por la persona.
num_dependientes_económicos: El número de personas que dependen económicamente de la persona.
Hallazgos acorde a medidas descriptivas y de distribución:
Percepción_facilidad_traslado: Existe un rango intercuartílico relativamente amplio, lo que indica que a algunos empleados les resulta muy fácil trasladarse (en torno a 60) mientras que a otros les resulta difícil (en torno a 20).
Percepción_comodidad_área_trabajo: La mediana de empleados percibe un nivel de comodidad en su área de trabajo de alrededor de 30, con algunos empleados que encuentran su área de trabajo muy cómoda (alrededor de 60) y otros que la encuentran incómoda (alrededor de 10).
Percepcion_desarrollo_personal: La mediana de los empleados percibe pocas oportunidades de desarrollo personal (10 personas). Sin embargo, algunos empleados ven muchas oportunidades (alrededor de 30) mientras que otros ven muy pocas (alrededor de 0).
Num_dependientes_económicos: Algunos empleados tienen muchas personas a su cargo (cerca de 5) mientras que otros no tienen ninguna (en torno a 0).
Meses_antigüedad: La mediana es de 3 meses de antigüedad. Sin embargo, algunos empleados son muy nuevos (alrededor de 0 meses) mientras que otros llevan mucho tiempo en la empresa (alrededor de 20 meses).
Escala_salario_justo: La mediana de los empleados cree que su salario es justo (en torno a 3). Hay un rango intercuartílico relativamente pequeño, lo que implica que la mayoría de los empleados creen que su salario es relativamente justo (entre 2 y 4).
Escala_percepcion_prestaciones: La mediana de los empleados percibe las prestaciones de forma positiva (en torno a 3). No obstante, la mayoría de los empleados tienen una percepción neutra de las prestaciones (entre 2 y 4).
Percepcion_peso_negativo_jornada: La mediana de los empleados percibe un peso negativo de su jornada laboral (en torno a 2). Aunque, la mayoría de los empleados tienen una percepción neutra del peso de la jornada laboral.
Percepción_comodidad_clima_área: La mediana de los empleados percibe un nivel de comodidad neutro en su clima laboral. Sin embargo, existe un rango intercuartílico amplio, lo que implica que algunos empleados encuentran el clima cómodo (en torno a 4) mientras que otros lo encuentran incómodo (en torno a 0).
Percepcion_estres_bajo: La mediana de los empleados percibe un nivel moderado de estrés (en torno a 2); incluso la mayoría de los empleados tienen una percepción neutra del estrés.
## puesto_de_trabajo meses_antigüedad razon_trabajar_form
## Ayudante general:46 Min. : 1.00 Ambiente de trabajo :13
## Otro :25 1st Qu.: 1.00 Otro :21
## Administrativo :17 Median : 9.00 Por el salario :19
## Costurera : 7 Mean :14.08 Prestaciones : 2
## Supervisor : 6 3rd Qu.:34.50 Razones personales :19
## Limpieza : 2 Max. :36.00 Ubicación de la empresa:32
## (Other) : 3
## escala_salario_justo escala_percepcion_prestaciones
## Min. :1.000 Min. :1.000
## 1st Qu.:3.000 1st Qu.:2.000
## Median :4.000 Median :4.000
## Mean :3.792 Mean :3.274
## 3rd Qu.:5.000 3rd Qu.:5.000
## Max. :5.000 Max. :5.000
##
## perpcepcion_peso_negativo_jornada percepcion_deserrollo_personal_form
## Min. :1.00 Min. :1.000
## 1st Qu.:4.00 1st Qu.:3.000
## Median :5.00 Median :5.000
## Mean :4.16 Mean :3.877
## 3rd Qu.:5.00 3rd Qu.:5.000
## Max. :5.00 Max. :5.000
##
## percepcion_comodidad_clima_area percepcion_estres_bajo
## Min. :1.000 Min. :1.000
## 1st Qu.:1.000 1st Qu.:3.000
## Median :3.000 Median :4.000
## Mean :3.123 Mean :3.679
## 3rd Qu.:5.000 3rd Qu.:5.000
## Max. :5.000 Max. :5.000
##
## percepcion_facilidad_traslado percepcion_comodidad_area_trabajo
## Min. :1.000 Min. :1.000
## 1st Qu.:4.000 1st Qu.:4.000
## Median :5.000 Median :5.000
## Mean :4.009 Mean :4.311
## 3rd Qu.:5.000 3rd Qu.:5.000
## Max. :5.000 Max. :5.000
##
## percepcion_probabilidad_seguir_form situaciones_acoso
## Min. :1.000 No :89
## 1st Qu.:3.000 Prefiero no decirlo: 1
## Median :5.000 Si :16
## Mean :4.038
## 3rd Qu.:5.000
## Max. :5.000
##
## edad género estado_civil municipio
## Min. :18.00 Femenino :69 Casado :38 Apodaca :77
## 1st Qu.:25.25 Masculino:37 Divorciado : 1 Guadalupe: 4
## Median :33.50 Soltero :47 Juárez :12
## Mean :35.62 Unión libre:20 Monterrey: 3
## 3rd Qu.:45.00 Otro : 6
## Max. :68.00 Pesquería: 4
##
## nivel_escolaridad num_dependientes_económicos
## Licenciatura:24 Min. :0.000
## Otro : 3 1st Qu.:0.000
## Preparatoria:27 Median :1.000
## Primaria : 9 Mean :1.085
## Secundaria :43 3rd Qu.:2.000
## Max. :3.000
##
edad <- ggplot(data = df, aes(x = edad)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +
geom_density()
percepcion_facilidad_traslado <- ggplot(data = df, aes(x = percepcion_facilidad_traslado)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +
geom_density()
percepcion_comodidad_area_trabajo <- ggplot(data = df, aes(x = percepcion_comodidad_area_trabajo)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +
geom_density()
percepcion_deserrollo_personal_form <- ggplot(data = df, aes(x = percepcion_deserrollo_personal_form)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +
geom_density()
num_dependientes_economicos <- ggplot(data = df, aes(x = num_dependientes_económicos)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +
geom_density()
meses_antiguedad <- ggplot(data = df, aes(x = meses_antigüedad)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +
geom_density()
escala_salario_justo <- ggplot(data = df, aes(x = escala_salario_justo)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +geom_density()
escala_percepcion_prestaciones <- ggplot(data = df, aes(x = escala_percepcion_prestaciones)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +geom_density()
perpcepcion_peso_negativo_jornada <- ggplot(data = df, aes(x = perpcepcion_peso_negativo_jornada)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +geom_density()
percepcion_comodidad_clima_area <- ggplot(data = df, aes(x = percepcion_comodidad_clima_area)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +geom_density()
percepcion_estres_bajo <- ggplot(data = df, aes(x = percepcion_estres_bajo)) +
geom_histogram( color = "red", fill = "blue", alpha = 0.1) +geom_density()
ggarrange(
edad, percepcion_facilidad_traslado, percepcion_comodidad_area_trabajo, percepcion_deserrollo_personal_form,
num_dependientes_economicos, meses_antiguedad, escala_salario_justo,
escala_percepcion_prestaciones, perpcepcion_peso_negativo_jornada,
percepcion_comodidad_clima_area, percepcion_estres_bajo,
ncol = 3, nrow = 4
)
df_numeric <- df %>%
select_if(is.numeric)
dispersion_sd <- sapply(df_numeric, sd)
print(dispersion_sd)
## meses_antigüedad escala_salario_justo
## 14.471448 1.336071
## escala_percepcion_prestaciones perpcepcion_peso_negativo_jornada
## 1.552467 1.258395
## percepcion_deserrollo_personal_form percepcion_comodidad_clima_area
## 1.559627 1.722141
## percepcion_estres_bajo percepcion_facilidad_traslado
## 1.397598 1.508675
## percepcion_comodidad_area_trabajo percepcion_probabilidad_seguir_form
## 1.221733 1.279319
## edad num_dependientes_económicos
## 12.160399 1.096470
## meses_antigüedad escala_salario_justo escala_percepcion_prestaciones
## [1,] 1 1 1
## [2,] 36 5 5
## perpcepcion_peso_negativo_jornada percepcion_deserrollo_personal_form
## [1,] 1 1
## [2,] 5 5
## percepcion_comodidad_clima_area percepcion_estres_bajo
## [1,] 1 1
## [2,] 5 5
## percepcion_facilidad_traslado percepcion_comodidad_area_trabajo
## [1,] 1 1
## [2,] 5 5
## percepcion_probabilidad_seguir_form edad num_dependientes_económicos
## [1,] 1 18 0
## [2,] 5 68 3
#Rango intercuartílico de cada columna
dispersion_iqr <- sapply(df_numeric, IQR)
print(dispersion_iqr)
## meses_antigüedad escala_salario_justo
## 33.50 2.00
## escala_percepcion_prestaciones perpcepcion_peso_negativo_jornada
## 3.00 1.00
## percepcion_deserrollo_personal_form percepcion_comodidad_clima_area
## 2.00 4.00
## percepcion_estres_bajo percepcion_facilidad_traslado
## 2.00 1.00
## percepcion_comodidad_area_trabajo percepcion_probabilidad_seguir_form
## 1.00 2.00
## edad num_dependientes_económicos
## 19.75 2.00
outlier_ratio <- dispersion_sd / dispersion_iqr
# Columna con la proporción más alta
max_outlier_column <- names(outlier_ratio)[which.max(outlier_ratio)]
print(outlier_ratio)
## meses_antigüedad escala_salario_justo
## 0.4319835 0.6680354
## escala_percepcion_prestaciones perpcepcion_peso_negativo_jornada
## 0.5174889 1.2583950
## percepcion_deserrollo_personal_form percepcion_comodidad_clima_area
## 0.7798133 0.4305351
## percepcion_estres_bajo percepcion_facilidad_traslado
## 0.6987989 1.5086751
## percepcion_comodidad_area_trabajo percepcion_probabilidad_seguir_form
## 1.2217334 0.6396596
## edad num_dependientes_económicos
## 0.6157164 0.5482349
## [1] "La variable con más outliers es: percepcion_facilidad_traslado"
Hallazgos acorde a correlaciones:
Edad: La edad parece ser un factor importante que afecta la comodidad y el estrés de los empleados en el trabajo; donde a mayor edad, los empleados experimentan menor comodidad en el área de trabajo, menor facilidad de traslado y mayor estrés laboral.
Antigüedad: La antigüedad se asocia con una mayor satisfacción con el salario y las prestaciones; por ende, a mayor antigüedad en la empresa, los empleados perciben un salario más justo y mejores prestaciones.
Clima laboral: Un mejor clima laboral se relaciona con una mayor
comodidad en el área de trabajo y una mayor facilidad de traslado.
Dependientes económicos: Tener más dependientes económicos puede afectar negativamente la probabilidad de que los empleados continúen en la empresa.
Desarrollo personal: Una mayor percepción de desarrollo personal en la empresa puede aumentar la probabilidad de que los empleados continúen siendo parte de la organización.
Prestaciones: Una mejor percepción de las prestaciones puede reducir la percepción negativa del impacto de la jornada laboral en la vida personal.
A través de la exploración de la columna de texto libre sobre aquellos aspectos menos atractivos de Form, se pudo comprobar que los aspectos que tienen un mayor impacto negativo sobre los empleados fueron las altas temperaturas, las compensaciones recibidas tanto en salario como prestaciones, así como la percepción de las actividades laborales (incluyendo el sábado) que resulta en estrés. Igualmente, esto último puede reflejarse en el análisis de sentimientos, relacionando estos aspectos con la ansiedad (anticipation), como la 3ra emoción predominante.
texto_negativo <- df_sentiment$opinion_malos_aspectos
# Crear un Corpus con los comentarios
corpus <- Corpus(VectorSource(texto_negativo))
# Limpiar el texto
corpus <- tm_map(corpus, content_transformer(tolower)) # Convertir a minúsculas
corpus <- tm_map(corpus, removePunctuation) # Eliminar puntuación
corpus <- tm_map(corpus, removeNumbers) # Eliminar números
corpus <- tm_map(corpus, removeWords, stopwords("spanish")) # Eliminar stopwords en español
corpus <- tm_map(corpus, removeWords, c("bien", "ninguno")) # Eliminar palabra "bien"
# Crear la matriz término-documento
tdm <- TermDocumentMatrix(corpus)
m <- as.matrix(tdm) #Cuenta las veces que aparece cada palabra por renglón
frecuencia <- sort(rowSums(m), decreasing = TRUE) #Cuenta la frecuencia de cada palabra en el texto completo
frecuencia_df <- data.frame(word=names(frecuencia), freq=frecuencia) # Convierte la frecuencia en un data frame
# Top 10 Palabras
ggplot(head(frecuencia_df, 10), aes(x = reorder(word, -freq), y = freq)) +
geom_bar(stat = "identity", fill = "lightblue")+
labs(x= "Palabra", y = "Frecuencia", title = "Top 10 Palabras Negativas de Form")+
geom_text(aes(label = freq), vjust = -0.5) +
ylim(0,10)+
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(face = "bold", size = 18),
axis.title = element_text(size = 20),
axis.text = element_text(size = 18),
legend.position = "none")
# Nube de Palabras
set.seed(123)
wordcloud(words= frecuencia_df$word, freq=frecuencia_df$freq, min.freq = 2, random.order = FALSE, colors = brewer.pal(8, "Spectral"))
# Análisis de Sentimientos
texto_palabras <- get_tokens(corpus)
emociones_df <- get_nrc_sentiment(texto_palabras, language = "spanish")
emociones_prop <- colSums(prop.table(emociones_df[1:8]))
emociones_df <- data.frame(Emocion = names(emociones_prop), Proporcion = emociones_prop)
ggplot(emociones_df, aes(x = Emocion, y = Proporcion, fill = Emocion)) +
geom_bar(stat = "identity") +
labs(title = "Distribución de emociones en los comentarios negativos de FORM",
x = "Emoción",
y = "Proporción") +
theme_minimal() + # Estilo minimalista
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(face = "bold", size = 18),
axis.title = element_text(size = 20),
axis.text = element_text(size = 18),
legend.position = "none")
Al analizar la opinión general de los empleados de Form, se obtienen resultados positivos, los cuales mencionan una percepción agradable y cómoda sobre la empresa, destacando aspectos como el ambiente laboral y la oportunidad de crecimiento. Asimismo, mediante el análisis de sentimientos se observa que estos comentarios están relacionados en su mayoría con emociones de felicidad y confianza.
texto_positivo <- df_sentiment$opinion_trabajar_forms
# Crear un Corpus con los comentarios
corpus <- Corpus(VectorSource(texto_positivo))
# Limpiar el texto
corpus <- tm_map(corpus, content_transformer(tolower)) # Convertir a minúsculas
corpus <- tm_map(corpus, removePunctuation) # Eliminar puntuación
corpus <- tm_map(corpus, removeNumbers) # Eliminar números
corpus <- tm_map(corpus, removeWords, stopwords("spanish")) # Eliminar stopwords en español
corpus <- tm_map(corpus, removeWords, c("bien")) # Eliminar palabra "bien"
# Crear la matriz término-documento
tdm <- TermDocumentMatrix(corpus)
m <- as.matrix(tdm) #Cuenta las veces que aparece cada palabra por renglón
frecuencia <- sort(rowSums(m), decreasing = TRUE)
frecuencia_df <- data.frame(word=names(frecuencia), freq=frecuencia)
# Gráfica Top 10 Palabras
ggplot(head(frecuencia_df, 10), aes(x = reorder(word, -freq), y = freq)) +
geom_bar(stat = "identity", fill = "lightblue")+
labs(x= "Palabra", y = "Frecuencia", title = "Top 10 Palabras Positivas de Form")+
geom_text(aes(label = freq), vjust = -0.5) +
ylim(0,15) +
theme_minimal() + # Estilo minimalista
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(face = "bold", size = 18),
axis.title = element_text(size = 20),
axis.text = element_text(size = 18),
legend.position = "none")
# Nube de Palabras
set.seed(123)
wordcloud(words= frecuencia_df$word, freq=frecuencia_df$freq, min.freq = 2, random.order = FALSE, colors = brewer.pal(8, "PRGn"))
# Análisis de Sentimientos
texto_palabras <- get_tokens(texto_positivo)
emociones_df <- get_nrc_sentiment(texto_palabras, language = "spanish")
emociones_prop <- colSums(prop.table(emociones_df[1:8]))
emociones_df <- data.frame(Emocion = names(emociones_prop), Proporcion = emociones_prop)
ggplot(emociones_df, aes(x = Emocion, y = Proporcion, fill = Emocion)) +
geom_bar(stat = "identity") +
labs(title = "Distribución de emociones en los comentarios de FORM",
x = "Emoción",
y = "Proporción") +
theme_minimal() + # Estilo minimalista
theme(axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(face = "bold", size = 18),
axis.title = element_text(size = 20),
axis.text = element_text(size = 18),
legend.position = "none")
Se determina que es más probable que los empleados de FORM que sean mujeres y tengan una percepción positiva tanto de su salario como de sus prestaciones tienen alta probabilidad de permanecer en la empresa. Por lo tanto, establecer estrategias de retención para este segmento generaría un mayor sentido de pertenencia a la compañía. Asimismo, se requiere establecer alternativas de atracción y retención enfocadas en mejorar la percepción del salario y prestaciones que ofrece la empresa como una ventaja competitiva en comparación con otras compañías del sector, especialmente en la ubicación de Apodaca.
df_models <- df %>% mutate(percepcion_probabilidad_seguir_form = ifelse(percepcion_probabilidad_seguir_form < 3, "no seguir", "si seguir"))
frecuencia_seguirform <- table(df_models$percepcion_probabilidad_seguir_form)
frecuencia_seguirform
##
## no seguir si seguir
## 14 92
El primer modelo construido corresponde a la regresión logística, empleando variables como el número de dependientes económicos, la edad, las distintas percepciones sobre Form, los meses de antigüedad y el género.
set.seed(123)
formula <- percepcion_probabilidad_seguir_form ~ num_dependientes_económicos + edad + percepcion_comodidad_area_trabajo + percepcion_facilidad_traslado + percepcion_estres_bajo + percepcion_comodidad_clima_area + percepcion_deserrollo_personal_form + perpcepcion_peso_negativo_jornada + escala_percepcion_prestaciones + escala_salario_justo + meses_antigüedad + género
model_glm <- glm(formula, family = "binomial", data = train)
summary(model_glm)
##
## Call:
## glm(formula = formula, family = "binomial", data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.10375 3.68543 -0.571 0.5681
## num_dependientes_económicos -0.16856 0.71556 -0.236 0.8138
## edad 0.08846 0.08021 1.103 0.2701
## percepcion_comodidad_area_trabajo 0.29968 0.60336 0.497 0.6194
## percepcion_facilidad_traslado -0.35084 0.55057 -0.637 0.5240
## percepcion_estres_bajo -0.33029 0.51703 -0.639 0.5229
## percepcion_comodidad_clima_area -0.78769 0.41672 -1.890 0.0587 .
## percepcion_deserrollo_personal_form 1.26752 0.68996 1.837 0.0662 .
## perpcepcion_peso_negativo_jornada -0.01763 0.45721 -0.039 0.9692
## escala_percepcion_prestaciones 0.88876 0.58006 1.532 0.1255
## escala_salario_justo -0.38422 0.60744 -0.633 0.5270
## meses_antigüedad 0.11741 0.06923 1.696 0.0899 .
## géneroMasculino -1.31964 1.61401 -0.818 0.4136
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 58.901 on 74 degrees of freedom
## Residual deviance: 25.694 on 62 degrees of freedom
## AIC: 51.694
##
## Number of Fisher Scoring iterations: 8
## Overall
## num_dependientes_económicos 0.23555712
## edad 1.10286472
## percepcion_comodidad_area_trabajo 0.49668732
## percepcion_facilidad_traslado 0.63722380
## percepcion_estres_bajo 0.63883115
## percepcion_comodidad_clima_area 1.89019331
## percepcion_deserrollo_personal_form 1.83708562
## perpcepcion_peso_negativo_jornada 0.03855666
## escala_percepcion_prestaciones 1.53219319
## escala_salario_justo 0.63252556
## meses_antigüedad 1.69600213
## géneroMasculino 0.81761680
El modelo demuestra tener un desempeño inicial adecuado, prediciendo acertadamente el 83.87% de los casos en que un empleado tiene una percepción de continuar o no en la empresa.. Este resultado es relevante debido a que tiene un kappa del .3515, es decir, no es una predicción aleatoria.
prediccion_glm <- predict(model_glm, test, type = "response")
confusion_glm <- confusionMatrix(as.factor(ifelse(prediccion_glm>0.5, "si seguir", "no seguir")), test$percepcion_probabilidad_seguir_form, positive = "no seguir")
print(confusion_glm)
## Confusion Matrix and Statistics
##
## Reference
## Prediction no seguir si seguir
## no seguir 2 3
## si seguir 2 24
##
## Accuracy : 0.8387
## 95% CI : (0.6627, 0.9455)
## No Information Rate : 0.871
## P-Value [Acc > NIR] : 0.7966
##
## Kappa : 0.3515
##
## Mcnemar's Test P-Value : 1.0000
##
## Sensitivity : 0.50000
## Specificity : 0.88889
## Pos Pred Value : 0.40000
## Neg Pred Value : 0.92308
## Prevalence : 0.12903
## Detection Rate : 0.06452
## Detection Prevalence : 0.16129
## Balanced Accuracy : 0.69444
##
## 'Positive' Class : no seguir
##
Mediante la curva ROC para el modelo logístico, se reafirma el punto anterior, pues al resultar en un AUC con valor de 0.86, se determina que la predicción del modelo es mejor que una predicción aleatoria.
# Curva ROC y valor de AUC
## Obtener las puntuaciones de probabilidad
prediccion_prob_glm <- predict(model_glm, test, type = "response")
## Generar la curva ROC
roc_obj_glm <- roc(test$percepcion_probabilidad_seguir_form, as.numeric(prediccion_prob_glm))
## Dibujar la curva ROC
plot.roc(roc_obj_glm, main = "Curva ROC", col = "blue")
## Area under the curve: 0.8611
El modelo de Naive Bayes demuestra igualmente, tener un desempeño inicial adecuado, prediciendo acertadamente el 80.65% de los casos en que un empleado tiene una percepción de continuar o no en la empresa. Este resultado es relevante debido a que tiene un kappa del 0.2901 (mayor a 0), es decir, no es una predicción aleatoria.
modelo_nb <- naiveBayes(formula, data = train)
# Matriz de Confusión
prediccion_nb <- predict(modelo_nb, test)
confusion_nb <- confusionMatrix(prediccion_nb, test$percepcion_probabilidad_seguir_form,positive = "no seguir")
print(confusion_nb)
## Confusion Matrix and Statistics
##
## Reference
## Prediction no seguir si seguir
## no seguir 2 4
## si seguir 2 23
##
## Accuracy : 0.8065
## 95% CI : (0.6253, 0.9255)
## No Information Rate : 0.871
## P-Value [Acc > NIR] : 0.9040
##
## Kappa : 0.2901
##
## Mcnemar's Test P-Value : 0.6831
##
## Sensitivity : 0.50000
## Specificity : 0.85185
## Pos Pred Value : 0.33333
## Neg Pred Value : 0.92000
## Prevalence : 0.12903
## Detection Rate : 0.06452
## Detection Prevalence : 0.19355
## Balanced Accuracy : 0.67593
##
## 'Positive' Class : no seguir
##
El punto anterior se reafirmar mediante la curva ROC del modelo bayesiano, obteniendo un AUC de 0.76 (mayor a .5), determinando nuevamente que el modelo es mejor a una predicción aleatoria.
# Curva ROC y valor de AUC
## Obtener las puntuaciones de probabilidad
prediccion_prob_nb <- predict(modelo_nb, test, type = "raw")
## Si el resultado es una matriz, selecciona la columna que corresponde a la clase 'Yes' o '1'
prediccion_prob_true_nb <- prediccion_prob_nb[, "no seguir"]
## Generar la curva ROC
roc_obj_nb <- roc(test$percepcion_probabilidad_seguir_form, prediccion_prob_true_nb)
## Dibujar la curva ROC
plot.roc(roc_obj_nb, main="Curva ROC", col="blue")
## Area under the curve: 0.7685
Debido a la falta de significancia en las variables del modelo logístico, considerando el buen desempeño del modelo de Naive Bayes, en conjunto con su principio de independencia, se analizarán sus resultados a través de las tablas de probabilidad condicional y distribución para determinar el impacto de las variables independientes sobre la percepción de continuar o no trabajando en Form.
Los empleados de género femenino tienen mayor probabilidad de considerar seguir trabajando en Form.
Los empleados de mayor edad tienen mayor probabilidad de considerar seguir trabajando en Form.
Los empleados que han trabajado por un periodo más largo tienen mayor probabilidad de considerar seguir trabajando en Form.
Los empleados que perciben su salario y prestaciones como más justos, tienen mayor probabilidad de considerar seguir trabajando en Form.
Los empleados que perciben su nivel de estrés como bajo, tienen mayor probabilidad de considerar seguir trabajando en Form.
Los empleados que perciben buena facilidad de traslado, tienen mayor probabilidad de considerar seguir trabajando en Form.
## Tablas de Probabilidad Condicional (FACTORES/CATEGORIAS)
barplot(modelo_nb$tables$género, legend.text = TRUE, beside = TRUE, col = c("black", "lightgray"), main = "Género")
## Tablas de Media y Desviación Estándar para Variables Continuas (NUMEROS)
barplot(modelo_nb$tables$edad, legend.text = TRUE, beside = TRUE, col = c("black", "lightgray"), names.arg = c("Media", "Desviación estándar"), main = "Edad")
barplot(modelo_nb$tables$meses_antigüedad, legend.text = TRUE, beside = TRUE, col = c("black", "lightgray"), names.arg = c("Media", "Desviación estándar"), main = "Meses")
barplot(modelo_nb$tables$escala_salario_justo, legend.text = TRUE, beside = TRUE, col = c("black", "lightgray"), names.arg = c("Media", "Desviación estándar"), main = "Salario justo")
barplot(modelo_nb$tables$escala_percepcion_prestaciones, legend.text = TRUE, beside = TRUE, col = c("black", "lightgray"), names.arg = c("Media", "Desviación estándar"), main = "Prestaciones")
barplot(modelo_nb$tables$percepcion_estres_bajo, legend.text = TRUE, beside = TRUE, col = c("black", "lightgray"), names.arg = c("Media", "Desviación estándar"), main = "Percepción estrés bajo")
barplot(modelo_nb$tables$percepcion_facilidad_traslado, legend.text = TRUE, beside = TRUE, col = c("black", "lightgray"), names.arg = c("Media", "Desviación estándar"), main = "Percepción facilidad de traslado")
# Cargar Base de Datos
nearshoring_data <- read.csv("C:\\Users\\AVRIL\\Documents\\nearshoring_data.csv")
# Tipos de Variables
summary(nearshoring_data)
## Año IED_Flujos Exportaciones Empleo
## Min. :1997 Min. : 8374 Min. : 9088 Length:26
## 1st Qu.:2003 1st Qu.:21367 1st Qu.:13260 Class :character
## Median :2010 Median :27698 Median :21188 Mode :character
## Mean :2010 Mean :26770 Mean :23601
## 3rd Qu.:2016 3rd Qu.:32183 3rd Qu.:31601
## Max. :2022 Max. :48354 Max. :46478
## Educación Salario_Diario Innovación Inseguridad_Robo
## Length:26 Min. : 24.30 Length:26 Min. :120.5
## Class :character 1st Qu.: 41.97 Class :character 1st Qu.:148.3
## Mode :character Median : 54.48 Mode :character Median :181.8
## Mean : 65.16 Mean :185.4
## 3rd Qu.: 72.31 3rd Qu.:209.9
## Max. :172.87 Max. :314.8
## Inseguridad_Homicidio Tipo_de_Cambio Peso_Nominal
## Length:26 Min. : 8.064 Min. : 83228
## Class :character 1st Qu.:10.752 1st Qu.:237047
## Mode :character Median :13.016 Median :344938
## Mean :13.910 Mean :393485
## 3rd Qu.:18.489 3rd Qu.:629635
## Max. :20.664 Max. :703096
## Pesos_Nom__divididos_INPC Pesos_actuales_MXN Densidad_Carretera
## Min. :2108 Min. :210849 Min. :0.05205
## 1st Qu.:3684 1st Qu.:368434 1st Qu.:0.05954
## Median :4971 Median :497116 Median :0.06989
## Mean :4936 Mean :493603 Mean :0.07106
## 3rd Qu.:5788 3rd Qu.:578789 3rd Qu.:0.08275
## Max. :7542 Max. :754160 Max. :0.09020
## Densidad_Población CO2_Emisiones PIB_Per_Cápita INPC
## Min. :47.44 Length:26 Min. :126739 Min. : 33.28
## 1st Qu.:52.78 Class :character 1st Qu.:130964 1st Qu.: 56.15
## Median :58.09 Mode :character Median :136845 Median : 73.35
## Mean :57.33 Mean :138550 Mean : 75.17
## 3rd Qu.:61.39 3rd Qu.:146148 3rd Qu.: 91.29
## Max. :65.60 Max. :153236 Max. :126.48
nearshoring_data$Empleo <- as.numeric(nearshoring_data$Empleo)
nearshoring_data$Educación <- as.numeric(nearshoring_data$Educación)
nearshoring_data$Innovación <- as.numeric(nearshoring_data$Innovación)
nearshoring_data$Inseguridad_Homicidio <- as.numeric(nearshoring_data$Inseguridad_Homicidio)
nearshoring_data$Empleo <- as.numeric(nearshoring_data$Empleo)
nearshoring_data$CO2_Emisiones <- as.numeric(nearshoring_data$CO2_Emisiones)
nearshoring_data$CO2_Emisiones <- as.numeric(nearshoring_data$CO2_Emisiones)
# Imputar la Media a Valores Nulos
nearshoring_data <- na.aggregate(nearshoring_data, FUN = median)
# Conversión a Números Reales
nearshoring_data$IED_Flujos_Reales <- ((nearshoring_data$IED_Flujos * nearshoring_data$Tipo_de_Cambio) / nearshoring_data$INPC)*100
# Eliminar columnas innecesarias
nearshoring_data <- subset(nearshoring_data, select = -c(IED_Flujos))
# Verificar los resultados
head(nearshoring_data)
## Año Exportaciones Empleo Educación Salario_Diario Innovación
## 1 1997 9087.616 96.53 7.197968 24.30 11.30141
## 2 1998 9875.065 96.53 7.311587 31.91 11.37221
## 3 1999 10990.013 96.53 7.427924 31.91 12.45897
## 4 2000 12482.963 97.83 7.560000 35.12 13.14556
## 5 2001 11300.439 97.36 7.678270 37.57 13.46812
## 6 2002 11923.099 97.66 7.803418 39.74 12.79893
## Inseguridad_Robo Inseguridad_Homicidio Tipo_de_Cambio Peso_Nominal
## 1 266.5065 14.554142 8.0640 97942.12
## 2 314.7762 14.319399 9.9395 83228.40
## 3 272.8936 12.641071 9.5222 132932.94
## 4 216.9808 10.857846 9.5997 175181.93
## 5 214.5269 10.249509 9.1692 275600.31
## 6 197.8004 9.938719 10.3613 249699.11
## Pesos_Nom__divididos_INPC Pesos_actuales_MXN Densidad_Carretera
## 1 2942.983 294298.3 0.05205217
## 2 2108.491 210849.1 0.05295475
## 3 2998.340 299834.0 0.05501698
## 4 3626.379 362637.9 0.05522774
## 5 5464.476 546447.6 0.05646070
## 6 4683.914 468391.4 0.05758828
## Densidad_Población CO2_Emisiones PIB_Per_Cápita INPC IED_Flujos_Reales
## 1 47.43650 3.675330 127570.1 33.27987 294298.3
## 2 48.76163 3.853045 126738.8 39.47297 210849.1
## 3 49.48089 3.686918 129164.7 44.33552 299834.0
## 4 50.57930 3.874147 130874.9 48.30767 362637.9
## 5 51.27675 3.811393 128083.4 50.43490 546447.6
## 6 51.95311 3.824969 128205.9 53.30993 468391.4
# Extraer variables más importantes con modelo OLS
ols_model <- lm(IED_Flujos_Reales ~., nearshoring_data)
summary(ols_model)
##
## Call:
## lm(formula = IED_Flujos_Reales ~ ., data = nearshoring_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.341e-05 -2.019e-05 -1.932e-06 2.728e-05 7.014e-05
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.083e-02 2.041e-01 -1.020e-01 0.92097
## Año 1.530e-05 1.024e-04 1.490e-01 0.88453
## Exportaciones -8.321e-09 2.575e-08 -3.230e-01 0.75392
## Empleo -3.374e-05 4.738e-05 -7.120e-01 0.49448
## Educación 3.178e-04 2.696e-04 1.179e+00 0.26873
## Salario_Diario 8.107e-07 5.648e-06 1.440e-01 0.88904
## Innovación 2.076e-05 3.014e-05 6.890e-01 0.50834
## Inseguridad_Robo -2.507e-06 8.103e-07 -3.094e+00 0.01284 *
## Inseguridad_Homicidio 2.542e-05 9.037e-06 2.813e+00 0.02027 *
## Tipo_de_Cambio 8.803e-06 2.146e-05 4.100e-01 0.69125
## Peso_Nominal -6.801e-11 1.362e-09 -5.000e-02 0.96127
## Pesos_Nom__divididos_INPC 1.000e+02 1.044e-07 9.577e+08 < 2e-16 ***
## Pesos_actuales_MXN NA NA NA NA
## Densidad_Carretera 1.189e-02 1.752e-02 6.790e-01 0.51440
## Densidad_Población -2.991e-04 9.844e-05 -3.038e+00 0.01406 *
## CO2_Emisiones 8.872e-04 2.326e-04 3.814e+00 0.00413 **
## PIB_Per_Cápita 2.466e-09 1.158e-08 2.130e-01 0.83613
## INPC 4.048e-05 1.465e-05 2.763e+00 0.02201 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.959e-05 on 9 degrees of freedom
## Multiple R-squared: 1, Adjusted R-squared: 1
## F-statistic: 9.102e+18 on 16 and 9 DF, p-value: < 2.2e-16
## Overall
## Año 1.494041e-01
## Exportaciones 3.232116e-01
## Empleo 7.120496e-01
## Educación 1.178724e+00
## Salario_Diario 1.435226e-01
## Innovación 6.887545e-01
## Inseguridad_Robo 3.094160e+00
## Inseguridad_Homicidio 2.813158e+00
## Tipo_de_Cambio 4.102052e-01
## Peso_Nominal 4.993176e-02
## Pesos_Nom__divididos_INPC 9.576816e+08
## Densidad_Carretera 6.787070e-01
## Densidad_Población 3.038013e+00
## CO2_Emisiones 3.813951e+00
## PIB_Per_Cápita 2.129191e-01
## INPC 2.762858e+00
IED_FLujos_ts<-ts(nearshoring_data$IED_Flujos_Reales,start=c(1997, 1),end=c(2022, 1),frequency=1)
InseguridadRobo_ts<-ts(nearshoring_data$Inseguridad_Robo,start=c(1997, 1),end=c(2022, 1),frequency=1)
InseguridadHomicidio_ts<-ts(nearshoring_data$Inseguridad_Homicidio,start=c(1997, 1),end=c(2022, 1),frequency=1)
Educacion_ts <- ts(nearshoring_data$Educación,start=c(1997, 1),end=c(2022, 1),frequency=1)
Innovacion_ts <- ts(nearshoring_data$Innovación,start=c(1997, 1),end=c(2022, 1),frequency=1)
DensidadPoblacion_ts <- ts(nearshoring_data$Densidad_Población,start=c(1997, 1),end=c(2022, 1),frequency=1)
CO2_ts <- ts(nearshoring_data$CO2_Emisiones,start=c(1997, 1),end=c(2022, 1),frequency=1)
autoplot(IED_FLujos_ts)
Los resultados del modelo para la variable IED_Flujos_Reales muestran capturar el 34% de su variabilidad (R-ajustada), sin embargo el estadístico F muestra que esta relación no es significativa (p-value > 0.05). Asimismo, los resultados muestran en su mayoría que valores mayores de las variables explicativas en periodos anteriores conducen a disminuir el valor actual de los flujos de IED, exceptuando las innovaciones y la educación. Es decir, valores elevados en periodos previos para estos últimos casos, contribuyen a aumentar los flujos de IED. Asimismo, es importante reconocer que ninguno de los valores se muestra significativo tampoco (p-value > 0.05).
data_ts <- cbind(nearshoring_data$IED_Flujos_Reales, nearshoring_data$Inseguridad_Robo, nearshoring_data$Inseguridad_Homicidio, nearshoring_data$Educación, nearshoring_data$Innovación, nearshoring_data$Densidad_Población, nearshoring_data$CO2_Emisiones)
colnames(data_ts) <- c("IED_Flujos_Reales", "Inseguridad_Robo","Inseguridad_Homicidio", "Educación", "Innovación", "Densidad_Población", "CO2_emisiones")
#data_ts_diff <- log(data_ts+.0000000001)
VAR_model <- VAR(data_ts, p = 2, type = "const")
summary(VAR_model)
##
## VAR Estimation Results:
## =========================
## Endogenous variables: IED_Flujos_Reales, Inseguridad_Robo, Inseguridad_Homicidio, Educación, Innovación, Densidad_Población, CO2_emisiones
## Deterministic variables: const
## Sample size: 24
## Log Likelihood: -323.468
## Roots of the characteristic polynomial:
## 1.095 1.095 1.011 0.8566 0.8566 0.8202 0.8202 0.7582 0.7198 0.7198 0.4667 0.4667 0.3963 0.3963
## Call:
## VAR(y = data_ts, p = 2, type = "const")
##
##
## Estimation results for equation IED_Flujos_Reales:
## ==================================================
## IED_Flujos_Reales = IED_Flujos_Reales.l1 + Inseguridad_Robo.l1 + Inseguridad_Homicidio.l1 + Educación.l1 + Innovación.l1 + Densidad_Población.l1 + CO2_emisiones.l1 + IED_Flujos_Reales.l2 + Inseguridad_Robo.l2 + Inseguridad_Homicidio.l2 + Educación.l2 + Innovación.l2 + Densidad_Población.l2 + CO2_emisiones.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## IED_Flujos_Reales.l1 -5.779e-01 3.565e-01 -1.621 0.139
## Inseguridad_Robo.l1 4.488e+02 1.526e+03 0.294 0.775
## Inseguridad_Homicidio.l1 -1.520e+04 2.553e+04 -0.595 0.566
## Educación.l1 9.420e+04 1.514e+05 0.622 0.549
## Innovación.l1 8.970e+04 6.474e+04 1.386 0.199
## Densidad_Población.l1 -1.269e+05 1.496e+05 -0.848 0.419
## CO2_emisiones.l1 2.016e+05 3.315e+05 0.608 0.558
## IED_Flujos_Reales.l2 1.995e-01 4.166e-01 0.479 0.643
## Inseguridad_Robo.l2 1.735e+03 1.596e+03 1.087 0.305
## Inseguridad_Homicidio.l2 -4.630e+03 1.928e+04 -0.240 0.816
## Educación.l2 2.764e+04 1.984e+05 0.139 0.892
## Innovación.l2 -3.907e+04 5.300e+04 -0.737 0.480
## Densidad_Población.l2 1.665e+05 1.226e+05 1.358 0.208
## CO2_emisiones.l2 -4.215e+05 3.201e+05 -1.317 0.220
## const -2.354e+06 2.307e+06 -1.020 0.334
##
##
## Residual standard error: 105400 on 9 degrees of freedom
## Multiple R-Squared: 0.7423, Adjusted R-squared: 0.3415
## F-statistic: 1.852 on 14 and 9 DF, p-value: 0.1774
##
##
## Estimation results for equation Inseguridad_Robo:
## =================================================
## Inseguridad_Robo = IED_Flujos_Reales.l1 + Inseguridad_Robo.l1 + Inseguridad_Homicidio.l1 + Educación.l1 + Innovación.l1 + Densidad_Población.l1 + CO2_emisiones.l1 + IED_Flujos_Reales.l2 + Inseguridad_Robo.l2 + Inseguridad_Homicidio.l2 + Educación.l2 + Innovación.l2 + Densidad_Población.l2 + CO2_emisiones.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## IED_Flujos_Reales.l1 -2.713e-05 8.881e-05 -0.305 0.767
## Inseguridad_Robo.l1 6.472e-01 3.800e-01 1.703 0.123
## Inseguridad_Homicidio.l1 -2.267e-01 6.358e+00 -0.036 0.972
## Educación.l1 -1.659e+00 3.771e+01 -0.044 0.966
## Innovación.l1 1.426e+00 1.613e+01 0.088 0.931
## Densidad_Población.l1 1.969e+01 3.727e+01 0.528 0.610
## CO2_emisiones.l1 6.420e+01 8.257e+01 0.777 0.457
## IED_Flujos_Reales.l2 2.268e-05 1.038e-04 0.219 0.832
## Inseguridad_Robo.l2 5.111e-01 3.975e-01 1.286 0.231
## Inseguridad_Homicidio.l2 -2.060e+00 4.802e+00 -0.429 0.678
## Educación.l2 -2.618e+01 4.942e+01 -0.530 0.609
## Innovación.l2 1.152e+01 1.320e+01 0.873 0.406
## Densidad_Población.l2 -1.169e+01 3.054e+01 -0.383 0.711
## CO2_emisiones.l2 -4.651e+00 7.973e+01 -0.058 0.955
## const -6.378e+02 5.746e+02 -1.110 0.296
##
##
## Residual standard error: 26.24 on 9 degrees of freedom
## Multiple R-Squared: 0.8041, Adjusted R-squared: 0.4994
## F-statistic: 2.639 on 14 and 9 DF, p-value: 0.07357
##
##
## Estimation results for equation Inseguridad_Homicidio:
## ======================================================
## Inseguridad_Homicidio = IED_Flujos_Reales.l1 + Inseguridad_Robo.l1 + Inseguridad_Homicidio.l1 + Educación.l1 + Innovación.l1 + Densidad_Población.l1 + CO2_emisiones.l1 + IED_Flujos_Reales.l2 + Inseguridad_Robo.l2 + Inseguridad_Homicidio.l2 + Educación.l2 + Innovación.l2 + Densidad_Población.l2 + CO2_emisiones.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## IED_Flujos_Reales.l1 -1.024e-06 4.597e-06 -0.223 0.8287
## Inseguridad_Robo.l1 4.133e-02 1.967e-02 2.102 0.0649 .
## Inseguridad_Homicidio.l1 4.790e-01 3.291e-01 1.456 0.1795
## Educación.l1 -5.888e-01 1.952e+00 -0.302 0.7698
## Innovación.l1 -1.237e+00 8.347e-01 -1.482 0.1726
## Densidad_Población.l1 4.459e+00 1.929e+00 2.312 0.0461 *
## CO2_emisiones.l1 -4.245e+00 4.274e+00 -0.993 0.3466
## IED_Flujos_Reales.l2 -1.139e-05 5.371e-06 -2.120 0.0631 .
## Inseguridad_Robo.l2 2.174e-02 2.057e-02 1.057 0.3182
## Inseguridad_Homicidio.l2 -4.574e-01 2.485e-01 -1.840 0.0988 .
## Educación.l2 5.524e+00 2.558e+00 2.160 0.0591 .
## Innovación.l2 1.972e+00 6.832e-01 2.886 0.0180 *
## Densidad_Población.l2 -3.466e+00 1.581e+00 -2.193 0.0560 .
## CO2_emisiones.l2 1.735e+00 4.126e+00 0.420 0.6841
## const -8.954e+01 2.974e+01 -3.011 0.0147 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 1.358 on 9 degrees of freedom
## Multiple R-Squared: 0.9867, Adjusted R-squared: 0.966
## F-statistic: 47.7 on 14 and 9 DF, p-value: 1.067e-06
##
##
## Estimation results for equation Educación:
## ==========================================
## Educación = IED_Flujos_Reales.l1 + Inseguridad_Robo.l1 + Inseguridad_Homicidio.l1 + Educación.l1 + Innovación.l1 + Densidad_Población.l1 + CO2_emisiones.l1 + IED_Flujos_Reales.l2 + Inseguridad_Robo.l2 + Inseguridad_Homicidio.l2 + Educación.l2 + Innovación.l2 + Densidad_Población.l2 + CO2_emisiones.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## IED_Flujos_Reales.l1 9.409e-07 6.852e-07 1.373 0.2030
## Inseguridad_Robo.l1 3.531e-03 2.932e-03 1.204 0.2591
## Inseguridad_Homicidio.l1 6.197e-04 4.906e-02 0.013 0.9902
## Educación.l1 4.180e-01 2.910e-01 1.437 0.1847
## Innovación.l1 -1.629e-02 1.244e-01 -0.131 0.8987
## Densidad_Población.l1 7.558e-02 2.876e-01 0.263 0.7986
## CO2_emisiones.l1 8.652e-01 6.371e-01 1.358 0.2076
## IED_Flujos_Reales.l2 1.024e-06 8.007e-07 1.278 0.2331
## Inseguridad_Robo.l2 7.513e-03 3.067e-03 2.449 0.0368 *
## Inseguridad_Homicidio.l2 -9.187e-02 3.705e-02 -2.480 0.0350 *
## Educación.l2 6.506e-02 3.813e-01 0.171 0.8683
## Innovación.l2 -1.634e-01 1.019e-01 -1.604 0.1432
## Densidad_Población.l2 9.209e-02 2.357e-01 0.391 0.7050
## CO2_emisiones.l2 3.338e-01 6.151e-01 0.543 0.6005
## const -9.023e+00 4.434e+00 -2.035 0.0723 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 0.2025 on 9 degrees of freedom
## Multiple R-Squared: 0.9563, Adjusted R-squared: 0.8884
## F-statistic: 14.08 on 14 and 9 DF, p-value: 0.0001932
##
##
## Estimation results for equation Innovación:
## ===========================================
## Innovación = IED_Flujos_Reales.l1 + Inseguridad_Robo.l1 + Inseguridad_Homicidio.l1 + Educación.l1 + Innovación.l1 + Densidad_Población.l1 + CO2_emisiones.l1 + IED_Flujos_Reales.l2 + Inseguridad_Robo.l2 + Inseguridad_Homicidio.l2 + Educación.l2 + Innovación.l2 + Densidad_Población.l2 + CO2_emisiones.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## IED_Flujos_Reales.l1 -1.172e-06 2.833e-06 -0.414 0.689
## Inseguridad_Robo.l1 1.045e-02 1.212e-02 0.862 0.411
## Inseguridad_Homicidio.l1 -2.924e-01 2.029e-01 -1.441 0.183
## Educación.l1 -1.030e+00 1.203e+00 -0.856 0.414
## Innovación.l1 4.092e-01 5.145e-01 0.795 0.447
## Densidad_Población.l1 6.284e-01 1.189e+00 0.528 0.610
## CO2_emisiones.l1 5.402e-01 2.634e+00 0.205 0.842
## IED_Flujos_Reales.l2 8.894e-07 3.311e-06 0.269 0.794
## Inseguridad_Robo.l2 9.992e-03 1.268e-02 0.788 0.451
## Inseguridad_Homicidio.l2 1.168e-02 1.532e-01 0.076 0.941
## Educación.l2 1.440e+00 1.577e+00 0.914 0.385
## Innovación.l2 -4.196e-01 4.211e-01 -0.996 0.345
## Densidad_Población.l2 -2.219e-01 9.744e-01 -0.228 0.825
## CO2_emisiones.l2 8.059e-01 2.544e+00 0.317 0.759
## const -1.766e+01 1.833e+01 -0.963 0.361
##
##
## Residual standard error: 0.8373 on 9 degrees of freedom
## Multiple R-Squared: 0.7131, Adjusted R-squared: 0.2667
## F-statistic: 1.598 on 14 and 9 DF, p-value: 0.2424
##
##
## Estimation results for equation Densidad_Población:
## ===================================================
## Densidad_Población = IED_Flujos_Reales.l1 + Inseguridad_Robo.l1 + Inseguridad_Homicidio.l1 + Educación.l1 + Innovación.l1 + Densidad_Población.l1 + CO2_emisiones.l1 + IED_Flujos_Reales.l2 + Inseguridad_Robo.l2 + Inseguridad_Homicidio.l2 + Educación.l2 + Innovación.l2 + Densidad_Población.l2 + CO2_emisiones.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## IED_Flujos_Reales.l1 8.171e-07 1.067e-06 0.766 0.4635
## Inseguridad_Robo.l1 3.020e-04 4.567e-03 0.066 0.9487
## Inseguridad_Homicidio.l1 4.072e-03 7.642e-02 0.053 0.9587
## Educación.l1 -1.021e-01 4.533e-01 -0.225 0.8269
## Innovación.l1 -1.504e-01 1.938e-01 -0.776 0.4576
## Densidad_Población.l1 1.112e+00 4.480e-01 2.482 0.0349 *
## CO2_emisiones.l1 -1.618e+00 9.924e-01 -1.630 0.1375
## IED_Flujos_Reales.l2 -1.118e-06 1.247e-06 -0.897 0.3932
## Inseguridad_Robo.l2 -6.592e-06 4.777e-03 -0.001 0.9989
## Inseguridad_Homicidio.l2 -8.481e-02 5.771e-02 -1.469 0.1758
## Educación.l2 3.107e-01 5.939e-01 0.523 0.6135
## Innovación.l2 -9.514e-02 1.587e-01 -0.600 0.5635
## Densidad_Población.l2 -5.020e-02 3.671e-01 -0.137 0.8942
## CO2_emisiones.l2 4.945e-01 9.582e-01 0.516 0.6182
## const 4.482e+00 6.907e+00 0.649 0.5326
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 0.3154 on 9 degrees of freedom
## Multiple R-Squared: 0.9984, Adjusted R-squared: 0.9958
## F-statistic: 391.6 on 14 and 9 DF, p-value: 9.151e-11
##
##
## Estimation results for equation CO2_emisiones:
## ==============================================
## CO2_emisiones = IED_Flujos_Reales.l1 + Inseguridad_Robo.l1 + Inseguridad_Homicidio.l1 + Educación.l1 + Innovación.l1 + Densidad_Población.l1 + CO2_emisiones.l1 + IED_Flujos_Reales.l2 + Inseguridad_Robo.l2 + Inseguridad_Homicidio.l2 + Educación.l2 + Innovación.l2 + Densidad_Población.l2 + CO2_emisiones.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## IED_Flujos_Reales.l1 -5.199e-07 3.843e-07 -1.353 0.209
## Inseguridad_Robo.l1 -2.041e-03 1.644e-03 -1.241 0.246
## Inseguridad_Homicidio.l1 -6.944e-03 2.751e-02 -0.252 0.806
## Educación.l1 1.691e-01 1.632e-01 1.036 0.327
## Innovación.l1 -5.344e-02 6.978e-02 -0.766 0.463
## Densidad_Población.l1 4.973e-02 1.613e-01 0.308 0.765
## CO2_emisiones.l1 1.251e-01 3.573e-01 0.350 0.734
## IED_Flujos_Reales.l2 -6.829e-07 4.490e-07 -1.521 0.163
## Inseguridad_Robo.l2 -1.371e-03 1.720e-03 -0.797 0.446
## Inseguridad_Homicidio.l2 3.580e-03 2.078e-02 0.172 0.867
## Educación.l2 1.854e-02 2.138e-01 0.087 0.933
## Innovación.l2 1.946e-02 5.712e-02 0.341 0.741
## Densidad_Población.l2 -6.054e-02 1.322e-01 -0.458 0.658
## CO2_emisiones.l2 1.720e-01 3.450e-01 0.499 0.630
## const 3.512e+00 2.487e+00 1.412 0.191
##
##
## Residual standard error: 0.1136 on 9 degrees of freedom
## Multiple R-Squared: 0.8408, Adjusted R-squared: 0.5931
## F-statistic: 3.395 on 14 and 9 DF, p-value: 0.03547
##
##
##
## Covariance matrix of residuals:
## IED_Flujos_Reales Inseguridad_Robo Inseguridad_Homicidio
## IED_Flujos_Reales 1.110e+10 6.446e+05 7528.47472
## Inseguridad_Robo 6.446e+05 6.888e+02 18.16607
## Inseguridad_Homicidio 7.528e+03 1.817e+01 1.84523
## Educación 1.328e+04 9.145e-01 -0.12689
## Innovación 2.620e+04 5.288e+00 -0.37343
## Densidad_Población -1.294e+04 5.792e-01 0.10822
## CO2_emisiones -6.840e+03 -4.171e-02 0.04558
## Educación Innovación Densidad_Población CO2_emisiones
## IED_Flujos_Reales 1.328e+04 2.620e+04 -1.294e+04 -6.840e+03
## Inseguridad_Robo 9.145e-01 5.288e+00 5.792e-01 -4.171e-02
## Inseguridad_Homicidio -1.269e-01 -3.734e-01 1.082e-01 4.558e-02
## Educación 4.101e-02 1.100e-01 -4.927e-03 -1.131e-02
## Innovación 1.100e-01 7.011e-01 1.093e-01 -3.192e-02
## Densidad_Población -4.927e-03 1.093e-01 9.950e-02 5.201e-03
## CO2_emisiones -1.131e-02 -3.192e-02 5.201e-03 1.290e-02
##
## Correlation matrix of residuals:
## IED_Flujos_Reales Inseguridad_Robo Inseguridad_Homicidio
## IED_Flujos_Reales 1.0000 0.23309 0.0526
## Inseguridad_Robo 0.2331 1.00000 0.5096
## Inseguridad_Homicidio 0.0526 0.50956 1.0000
## Educación 0.6225 0.17207 -0.4613
## Innovación 0.2970 0.24062 -0.3283
## Densidad_Población -0.3895 0.06997 0.2526
## CO2_emisiones -0.5717 -0.01399 0.2955
## Educación Innovación Densidad_Población CO2_emisiones
## IED_Flujos_Reales 0.62249 0.2970 -0.38947 -0.57166
## Inseguridad_Robo 0.17207 0.2406 0.06997 -0.01399
## Inseguridad_Homicidio -0.46130 -0.3283 0.25257 0.29546
## Educación 1.00000 0.6488 -0.07713 -0.49171
## Innovación 0.64878 1.0000 0.41380 -0.33571
## Densidad_Población -0.07713 0.4138 1.00000 0.14520
## CO2_emisiones -0.49171 -0.3357 0.14520 1.00000
Comentario: Al obtener un p-value mayor a 0.05, no se rechaza la hipotésis nula, por lo que no es estacionario.
##
## Augmented Dickey-Fuller Test
##
## data: VAR_model_residuals$IED_Flujos_Reales
## Dickey-Fuller = -2.9795, Lag order = 2, p-value = 0.1993
## alternative hypothesis: stationary
Comentario: Al obtener un p-value mayor a 0.05, no se rechaza la hipotésis nula, por lo que no hay evidencia suficiente para rechazar la hipótesis nula, lo que sugiere que los residuos son independientes en el tiempo (es decir, no hay autocorrelación significativa en los residuos).
##
## Box-Ljung test
##
## data: VAR_model_residuals$IED_Flujos_Reales
## X-squared = 3.093, df = 1, p-value = 0.07863
De acuerdo a la predicción del modelo VAR considerando las variables de Inseguridad_Robo, Inseguridad_Homocidio, Educación, Innovación, Densidad de Población y Emisiones de CO2, la inversión extranjera aumentará en 2023-2025, implicando la posible llegada del Nearshoring a México.
# Predicción para los siguientes 5 periodos
forecast_var <- predict(VAR_model, n.ahead = 5, ci = 0.95)
print(forecast_var)
## $IED_Flujos_Reales
## fcst lower upper CI
## [1,] 679071.9 472560.2 885583.7 206511.7
## [2,] 945926.3 681680.4 1210172.3 264246.0
## [3,] 876913.4 597928.1 1155898.6 278985.2
## [4,] 975301.1 680691.1 1269911.0 294610.0
## [5,] 880087.3 566958.6 1193216.0 313128.7
##
## $Inseguridad_Robo
## fcst lower upper CI
## [1,] 139.0026 87.56386 190.4414 51.43877
## [2,] 178.4376 112.83425 244.0410 65.60336
## [3,] 239.4771 160.26714 318.6870 79.20993
## [4,] 288.9116 200.27919 377.5441 88.63244
## [5,] 293.1862 202.35990 384.0125 90.82629
##
## $Inseguridad_Homicidio
## fcst lower upper CI
## [1,] 14.88182 12.21942 17.54422 2.662403
## [2,] 15.76456 10.81427 20.71485 4.950291
## [3,] 22.35452 15.10353 29.60550 7.250983
## [4,] 38.51716 28.77466 48.25967 9.742507
## [5,] 51.91323 40.15613 63.67034 11.757106
##
## $Educación
## fcst lower upper CI
## [1,] 8.292997 7.896102 8.689892 0.3968948
## [2,] 9.482927 8.958817 10.007037 0.5241096
## [3,] 10.279152 9.590625 10.967679 0.6885266
## [4,] 10.964642 10.177749 11.751534 0.7868930
## [5,] 11.541229 10.690334 12.392124 0.8508951
##
## $Innovación
## fcst lower upper CI
## [1,] 15.47487 13.833766 17.11597 1.641102
## [2,] 17.21466 15.225872 19.20345 1.988789
## [3,] 15.94986 13.842973 18.05674 2.106884
## [4,] 15.14525 12.675598 17.61491 2.469655
## [5,] 12.33944 9.429624 15.24925 2.909813
##
## $Densidad_Población
## fcst lower upper CI
## [1,] 65.87577 65.25754 66.49401 0.6182330
## [2,] 66.66732 65.79697 67.53767 0.8703505
## [3,] 67.64033 66.63758 68.64307 1.0027421
## [4,] 68.77211 67.61861 69.92561 1.1535021
## [5,] 70.27890 69.02417 71.53364 1.2547353
##
## $CO2_emisiones
## fcst lower upper CI
## [1,] 4.034558 3.811976 4.257140 0.2225821
## [2,] 3.759601 3.463986 4.055216 0.2956150
## [3,] 3.576053 3.218478 3.933629 0.3575758
## [4,] 3.396823 2.970887 3.822758 0.4259354
## [5,] 3.212011 2.755855 3.668167 0.4561558
fanchart(forecast_var, names = "IED_Flujos_Reales", main = "Pronóstico de Flujos de IED en México (VAR)",
xlab = "Periodo", ylab = "IED Flujos Reales")
# Cargando los datos de flujos de IED
ied_flujos <- read.csv("C:\\Users\\AVRIL\\Documents\\IED_Flujos.csv")
summary(ied_flujos)
## Año Trimestre IED_Flujos Tipo_Cambio INPC
## Min. :1999 Min. :1.00 Min. : 1341 Min. : 9.02 Min. : 41.39
## 1st Qu.:2005 1st Qu.:1.75 1st Qu.: 4351 1st Qu.:10.85 1st Qu.: 58.66
## Median :2010 Median :2.50 Median : 6238 Median :13.01 Median : 75.05
## Mean :2010 Mean :2.50 Mean : 7036 Mean :14.08 Mean : 76.96
## 3rd Qu.:2016 3rd Qu.:3.25 3rd Qu.: 8053 3rd Qu.:18.46 3rd Qu.: 92.71
## Max. :2022 Max. :4.00 Max. :22794 Max. :23.51 Max. :126.48
# Crear una nueva columna para los flujos en números reales
ied_flujos$IED_Numero_Real <- ((ied_flujos$IED_Flujos * ied_flujos$Tipo_Cambio) / ied_flujos$INPC)*100
# Obtener los últimos 20 valores del pronóstico (5 años)
ultimos_valores <- tail(ied_flujos$IED_Numero_Real, 20)
# Calcular el promedio de los últimos 20 valores (5 años)
promedio_flujos <- mean(ultimos_valores)
# Convertir a serie de tiempo
ied_flujos <- ts(ied_flujos$IED_Numero_Real, start = c(min(ied_flujos$Año), 1), frequency = 4)
plot(ied_flujos)
Comentario: Con un valor de p de 0.02, se puede rechazar la hipótesis nula de que se tiene una raíz unitaria, lo que significa que es estacionaria.
#Prueba de estacionariedad (ADF Test)
adf_test <- adf.test(ied_flujos, alternative = "stationary")
adf_test
##
## Augmented Dickey-Fuller Test
##
## data: ied_flujos
## Dickey-Fuller = -3.831, Lag order = 4, p-value = 0.02051
## alternative hypothesis: stationary
Comentario: Con un valor de p de 0.9449, no hay evidencia suficiente para rechazar la hipótesis nula, lo que sugiere que los residuos son independientes en el tiempo (es decir, no hay autocorrelación significativa en los residuos).
##
## Box-Ljung test
##
## data: ied_flujos
## X-squared = 0.0047773, df = 1, p-value = 0.9449
De acuerdo a la función auto.arima, los parámetros del modelo fueron optimizados con los valores (0,0,0)(0,1,2), esto indica parámetros diferentes a 0 únicamente en el componente estacional. En este componente posee 0 autoregresiones, 1 diferencia, y 2 promedios móvil, generando así un modelo SARIMA con mejor desempeño que otros modelos, teniendo un RMSE de 53,266 y un AIC de 2276.
## Series: ied_flujos
## ARIMA(0,0,0)(0,1,2)[4]
##
## Coefficients:
## sma1 sma2
## -0.7624 0.1890
## s.e. 0.1118 0.1203
##
## sigma^2 = 3.026e+09: log likelihood = -1134.95
## AIC=2275.89 AICc=2276.16 BIC=2283.46
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 6346.076 53266.06 35483.89 -13.21456 34.96835 0.7572764
## ACF1
## Training set -0.07016946
##
## Call:
## arima(x = ied_flujos, order = c(0, 1, 0))
##
##
## sigma^2 estimated as 1.011e+10: log likelihood = -1229.04, aic = 2460.08
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -577.3496 100018 70315.79 -27.61468 63.36953 0.9895955 -0.3927458
De acuerdo a lo visto por el pronóstico del modelo sarima para los siguiente 8 periodos (2024 y 2025), se pueden observar picos tanto positivos como negativos en los flujos de IED, subiendo y bajando el promedio de los últimos 5 años, lo cual hace incierta la llegada del Nearshoring a México.
# Predicciones para 4 trimestres del 2023, 2024 y 2025
forecast_arima <- forecast(auto_arima_model, h=14) # h es el número de periodos a pronosticar
forecast_arima
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 2023 Q1 331742.27 261240.336 402244.2 223918.8660 439565.7
## 2023 Q2 128644.44 58142.506 199146.4 20821.0363 236467.8
## 2023 Q3 83032.63 12530.693 153534.6 -24790.7769 190856.0
## 2023 Q4 52832.71 -17669.222 123334.6 -54990.6925 160656.1
## 2024 Q1 343630.00 271165.571 416094.4 232805.2214 454454.8
## 2024 Q2 127831.42 55366.996 200295.8 17006.6462 238656.2
## 2024 Q3 77119.44 4655.013 149583.9 -33705.3366 187944.2
## 2024 Q4 44531.82 -27932.603 116996.2 -66292.9527 155356.6
## 2025 Q1 343630.00 265171.625 422088.4 223638.2720 463621.7
## 2025 Q2 127831.42 49373.050 206289.8 7839.6968 247823.1
## 2025 Q3 77119.44 -1338.933 155577.8 -42872.2860 197111.2
## 2025 Q4 44531.82 -33926.549 122990.2 -75459.9020 164523.5
## 2026 Q1 343630.00 259604.172 427655.8 215123.5876 472136.4
## 2026 Q2 127831.42 43805.597 211857.2 -674.9876 256337.8
# Crear el gráfico
grafico <- autoplot(forecast_arima) +
labs(title = "Pronóstico de flujos de IED en México", x = "Periodo", y = "Flujos de IED")
# Agregar la línea del promedio al gráfico
grafico_con_promedio <- grafico +
geom_hline(yintercept = promedio_flujos, linetype = "dashed", color = "red")
# Mostrar el gráfico
print(grafico_con_promedio)
# Cargando los datos de flujos de IED
ied_flujos <- read_excel("C:\\Users\\AVRIL\\Documents\\ied_carton_papel_2023.xlsx")
summary(ied_flujos)
## Year Quarter IED_Fab_Carton_Papel Tipo_Cambio
## Min. :1999 Length:99 Min. :-61.305 Min. : 9.016
## 1st Qu.:2005 Class :character 1st Qu.: -2.874 1st Qu.:10.858
## Median :2011 Mode :character Median : 8.999 Median :13.012
## Mean :2011 Mean : 13.198 Mean :14.191
## 3rd Qu.:2017 3rd Qu.: 22.506 3rd Qu.:18.271
## Max. :2023 Max. :317.684 Max. :23.512
## INPC
## Min. : 41.39
## 1st Qu.: 58.77
## Median : 75.72
## Mean : 78.53
## 3rd Qu.: 95.53
## Max. :130.12
# Crear una nueva columna para los flujos en números reales
ied_flujos$IED_Fab_Carton_Papel_Numero_Real <- ((ied_flujos$IED_Fab_Carton_Papel * ied_flujos$Tipo_Cambio) / ied_flujos$INPC)*100
# Obtener los últimos 20 valores del pronóstico (5 años)
ultimos_valores <- tail(ied_flujos$IED_Fab_Carton_Papel_Numero_Real, 20)
# Calcular el promedio de los últimos 20 valores (5 años)
promedio_flujos <- mean(ultimos_valores)
# Convertir a serie de tiempo
ied_flujos <- ts(ied_flujos$IED_Fab_Carton_Papel_Numero_Real, start = c(min(ied_flujos$Year), 1), frequency = 4)
plot(ied_flujos)
Comentario: Con un valor de p de 0.01, se puede rechazar la hipótesis nula de que se tiene una raíz unitaria, lo que significa que es estacionaria.
#Prueba de estacionariedad (ADF Test)
adf_test <- adf.test(ied_flujos, alternative = "stationary")
adf_test
##
## Augmented Dickey-Fuller Test
##
## data: ied_flujos
## Dickey-Fuller = -4.3846, Lag order = 4, p-value = 0.01
## alternative hypothesis: stationary
Comentario: Con un valor de p de 0.5739, no hay evidencia suficiente para rechazar la hipótesis nula, lo que sugiere que los residuos son independientes en el tiempo (es decir, no hay autocorrelación significativa en los residuos).
##
## Box-Ljung test
##
## data: ied_flujos
## X-squared = 0.31621, df = 1, p-value = 0.5739
De acuerdo a la función auto.arima, los parámetros del modelo fueron optimizados con los valores (0,0,0)(2,0,0), esto indica parámetros diferentes a 0 únicamente en el componente estacional. En este componente posee 2 autoregresiones, 0 diferencias, y 0 promedios móvil, generando así un modelo SARIMA con mejor desempeño que otros modelos, teniendo un RMSE de 708 y un AIC de 1589
## Series: ied_flujos
## ARIMA(0,0,0)(2,0,0)[4] with non-zero mean
##
## Coefficients:
## sar1 sar2 mean
## 0.1779 0.2418 231.3254
## s.e. 0.0977 0.0975 117.4993
##
## sigma^2 = 517050: log likelihood = -790.52
## AIC=1589.05 AICc=1589.47 BIC=1599.43
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 6.74125 708.083 372.0405 -20.35875 346.8635 0.7589269 -0.02059353
##
## Call:
## arima(x = ied_flujos, order = c(0, 1, 0))
##
##
## sigma^2 estimated as 1184680: log likelihood = -824.32, aic = 1650.64
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 15.84571 1082.919 600.1467 323.1185 498.6854 0.9899225 -0.4903256
De acuerdo a lo visto por el pronóstico del modelo sarima para los siguiente 8 periodos (2024 y 2025), se puede observar únicamente un pico tanto positivo en los flujos de IED para la industria de cartón y papel que sobresale del promedio de los últimos 5 años, lo cual determina que no estaría presente el efecto del Nearshoring en esta industria en México (de acuerdo al modelo).
# Predicciones para 4 trimestres del 2024 y 2025
forecast_arima <- forecast(auto_arima_model, h=9) # h es el número de periodos a pronosticar
forecast_arima
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 2023 Q4 118.270285 -803.2444 1039.7849 -1291.0647 1527.605
## 2024 Q1 63.172193 -858.3425 984.6868 -1346.1628 1472.507
## 2024 Q2 428.659314 -492.8553 1350.1740 -980.6757 1837.994
## 2024 Q3 257.420841 -664.0938 1178.9355 -1151.9142 1666.756
## 2024 Q4 7.801776 -928.1791 943.7827 -1423.6575 1439.261
## 2025 Q1 197.496264 -738.4847 1133.4772 -1233.9630 1628.956
## 2025 Q2 312.299567 -623.6814 1248.2805 -1119.1597 1743.759
## 2025 Q3 218.929689 -717.0512 1154.9106 -1212.5296 1650.389
## 2025 Q4 164.229054 -805.0733 1133.5314 -1318.1910 1646.649
# Crear el gráfico
grafico <- autoplot(forecast_arima) +
labs(title = "Pronóstico de flujos de IED en la Industria de Cartón y Papel en México", x = "Periodo", y = "Flujos de IED")
# Agregar la línea del promedio al gráfico
grafico_con_promedio <- grafico +
geom_hline(yintercept = promedio_flujos, linetype = "dashed", color = "red")
# Mostrar el gráfico
print(grafico_con_promedio)
# Dataset de Ventas de Forms
df_ventas <- read_excel("C:\\Users\\AVRIL\\Documents\\FORM - Ventas.xlsx")
df_ventas <- head(df_ventas, -3) # Eliminar últimos 3 periodos incompletos
head(df_ventas)
## # A tibble: 6 × 7
## Ano Mes Total Total_carton Total_retornable Servicios Muestras
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2020 Ene 6059791. 0 0 0 0
## 2 2020 Feb 6643181. 0 0 0 0
## 3 2020 Mar 8368674. 0 0 0 0
## 4 2020 Abr 4925778. 0 0 0 0
## 5 2020 May 2235669. 0 0 0 0
## 6 2020 Jun 7842003. 0 0 0 0
## Ano Mes Total Total_carton
## Min. :2020 Length:33 Min. : 2235669 Min. : 0
## 1st Qu.:2020 Class :character 1st Qu.: 6358278 1st Qu.: 0
## Median :2021 Mode :character Median : 7872345 Median :5055607
## Mean :2021 Mean : 7858459 Mean :3860008
## 3rd Qu.:2022 3rd Qu.: 9219847 3rd Qu.:6295172
## Max. :2022 Max. :12285123 Max. :8873296
## Total_retornable Servicios Muestras
## Min. : 0 Min. : 0 Min. : 0.00
## 1st Qu.: 0 1st Qu.: 0 1st Qu.: 0.00
## Median : 803742 Median : 0 Median : 0.00
## Mean :1261055 Mean : 133844 Mean : 74.99
## 3rd Qu.:1993289 3rd Qu.: 40000 3rd Qu.: 0.00
## Max. :5304410 Max. :1375979 Max. :2474.59
df_ventas <- df_ventas %>% dplyr::select(Ano, Mes, Total)
# Iniciar conversión a Formato de Time Series
meses <- c("Ene", "Feb", "Mar", "Abr", "May", "Jun", "Jul", "Ago", "Sep", "Oct", "Nov", "Dic")
df_ventas$Mes <- factor(df_ventas$Mes, levels = meses)
# Combinar la columna Ano con la columna Mes
df_ventas$Fecha <- as.Date(paste(df_ventas$Ano, as.numeric(df_ventas$Mes), "01", sep = "-"))
df_ventas <- df_ventas %>%
dplyr::select(Fecha, Total)
# Crear la time series
df_ventas <- ts(df_ventas$Total, start = c(min(year(df_ventas$Fecha)), 1), frequency = 12)
# Descomponer la serie de tiempo en sus componentes
Porcomponente <- stats::decompose(df_ventas)
tend <- Porcomponente$trend
estac <- Porcomponente$seasonal
error <- Porcomponente$random
plot(Porcomponente)
Al obtener un valor de p-value=0.6462; no se rechaza la hipotésis nula, por lo que es posible decir que NO es estacionaria.
##
## Augmented Dickey-Fuller Test
##
## data: df_ventas
## Dickey-Fuller = -1.8104, Lag order = 3, p-value = 0.6462
## alternative hypothesis: stationary
El p-value resultante es: 0.01477. Por lo que al analizarlo, se determina que es posible rechazar la hipótesis nula, por lo que se dice que Hay autocorrelación serial.
# Prueba de Box-Ljung
box_ljung_test <- Box.test( df_ventas, type = "Ljung-Box")
print(box_ljung_test)
##
## Box-Ljung test
##
## data: df_ventas
## X-squared = 5.9438, df = 1, p-value = 0.01477
Para realizar el pronósitico de las ventas mensuales de Form se empleó el método de suavización exponencial, considerando un alpha de 0.99, es decir, otorgando un mayor peso a los valores más recientes que a los datos históricos. Esto implica que para prever las ventas mensuales de Form, las predicciones reflejarán de manera más precisa las tendencias recientes en las ventas.
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## HoltWinters(x = df_ventas, alpha = 0.99)
##
## Smoothing parameters:
## alpha: 0.99
## beta : 0
## gamma: 1
##
## Coefficients:
## [,1]
## a 12406683.50
## b 45417.64
## s1 -477921.08
## s2 -1396969.64
## s3 3101872.80
## s4 208552.22
## s5 2095374.61
## s6 1544632.18
## s7 -811668.75
## s8 706601.75
## s9 -2733150.23
## s10 -2118022.84
## s11 746162.03
## s12 -829155.51
##
## Ljung-Box test
##
## data: Residuals from HoltWinters
## Q* = 14.824, df = 4, p-value = 0.005081
##
## Model df: 0. Total lags used: 4
Al realizar el pronóstico base mediante el modelo de suavización exponencial, este resultó en una tendencia creciente en las ventas futuras de Form a través de los siguientes meses. Sin embargo es necesario considerar la diferencia entre la línea trazada del pronóstico, y el sombreado del error, existiendo una incertidumbre considerable considerando los intervalores de confianza del 80 y 95, pudiendo no ser un pronóstico certero para medir el desempeño futuro con exactitud, y debería complementarse con otros factores.
predicciones <- forecast(modelo_expsmooth, h = 18) # Predicción de 18 periodos (meses) hacia adelante
print(predicciones)
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Oct 2022 11974180 8630764.47 15317596 6860867.2 17087493
## Nov 2022 11100549 6395827.58 15805271 3905298.4 18295800
## Dec 2022 15644809 9892385.20 21397233 6847235.9 24442383
## Jan 2023 12796906 6160163.17 19433649 2646883.6 22946929
## Feb 2023 14729146 7312790.31 22145502 3386808.6 26071484
## Mar 2023 14223822 6102349.16 22345294 1803101.4 26644542
## Apr 2023 11912938 3142858.96 20683018 -1499740.6 25325617
## May 2023 13476626 4102712.16 22850541 -859538.3 27812791
## Jun 2023 10082292 141153.03 20023431 -5121368.1 25285952
## Jul 2023 10742837 265135.89 21220538 -5281424.1 26767098
## Aug 2023 13652440 2664346.07 24640533 -3152399.3 30457278
## Sep 2023 12122540 646731.38 23598348 -5428194.6 29673274
## Oct 2023 12519192 566258.89 24472125 -5761241.5 30799625
## Nov 2023 11645561 -757204.23 24048326 -7322831.5 30613953
## Dec 2023 16189821 3352977.13 29026665 -3442437.5 35822079
## Jan 2024 13341918 85201.36 26598635 -6932480.5 33616316
## Feb 2024 15274158 1610464.78 28937851 -5622657.5 36170973
## Mar 2024 14768833 709939.61 28827727 -6732389.1 36270056
# Dataset de Ventas de Forms
df <- read_excel("C:\\Users\\AVRIL\\Documents\\Datos_FORM_Ventas_FJ2024 (1).xlsx")
# Remover columnas innecesarias
df_ventas <- df[, !names(df) %in% c("Folio_Factura", "No_Cliente", "Ref_cliente", "Estado")]
# Convertir variables categóricas a factores
df_ventas$Producto <- as.factor(df_ventas$Producto)
df_ventas$Cliente <- as.factor(df_ventas$Cliente)
df_ventas$Categoria_Producto <- as.factor(df_ventas$Categoria_Producto)
# Convertir la columna Fecha a formato de fecha
df_ventas$Fecha <- as.Date(df_ventas$Fecha)
# Resumen del dataframe
summary(df_ventas)
## Fecha Cliente
## Min. :2021-01-04 Stabilus :6655
## 1st Qu.:2021-06-04 GRUPO ANTOLIN SALTILLO, S. de R.L de C.V. :2022
## Median :2022-05-09 PO LIGHTING MEXICO :1820
## Mean :2022-05-10 DENSO MEXICO :1693
## 3rd Qu.:2023-03-03 TOKAI RIKA MEXICO :1458
## Max. :2023-12-22 YANFENG INTERNATIONAL AUTOMOTIVE TECHNOLOGY MEXICO:1147
## (Other) :1768
## Producto
## [MX989402-0020] 19419. Toyota. MCV. Pallet : 419
## [TR14085 KIT 95161] KIT 95161 : 210
## [MX989002-0020-1] CAJA EMPTY MCV - 19638 V.I : 187
## [429296 AS 30 99 0000 00 000 INSERTO - INSERT TMC 150 TESLA] 14783. TMC150. Inserto.: 179
## [939308 FS 30 99 0000 00 000 CARTÓN - BOX 939308 SIZE 48"] 48’’. Caja Terminada. : 179
## [TR12440 TAPA P558] 18842. P558. Tapa. : 177
## (Other) :15212
## Cantidad Categoria_Producto
## Min. : 1.0 Cartón / Producto Terminado (Cartón) :10427
## 1st Qu.: 30.0 Cartón / Kit (Cartón) : 3752
## Median : 80.0 Cartón / Producto Comercialización (Cartón) : 1097
## Mean : 360.6 Retornable / Producto Terminado (Retornable) : 841
## 3rd Qu.: 250.0 Servicios : 411
## Max. :36220.0 Retornable / Producto Comercialización (Retornable): 26
## (Other) : 9
# Extraer Mes y Año de la fecha
df_ventas <- df_ventas %>%
mutate(Mes_Año = format(Fecha, "%m-%Y")) %>% # Combinar Mes y Año en una sola columna
arrange(Fecha)
# Convertir Mes_Año a factor para ordenar adecuadamente
df_ventas$Mes_Año <- factor(df_ventas$Mes_Año, levels = unique(df_ventas$Mes_Año))
# Agrupar por Cliente, Mes_Año y calcular la suma de ventas mensuales
df_ventas_agrupado <- df_ventas %>%
group_by(Mes_Año, Cliente) %>%
summarise(Total_Ventas = sum(Cantidad))
# Ver el resultado
head(df_ventas_agrupado)
## # A tibble: 6 × 3
## # Groups: Mes_Año [1]
## Mes_Año Cliente Total_Ventas
## <fct> <fct> <dbl>
## 1 01-2021 DENSO MEXICO 70
## 2 01-2021 GRUPO ABC DE MEXICO SA DE CV 279
## 3 01-2021 GRUPO ANTOLIN SALTILLO, S. de R.L de C.V. 145049
## 4 01-2021 HELLA AUTOMOTIVE MEXICO 86
## 5 01-2021 IACNA MEXICO V S DE RL DE CV 109
## 6 01-2021 JOHNSON CONTROLS ENTERPRISES MEXICO, SRL DE CV 42
# Calcular las ventas totales por producto
ventas_por_cliente <- df_ventas %>%
group_by(Cliente) %>%
summarise(Ventas = sum(Cantidad)) %>%
arrange(desc(Ventas)) %>%
top_n(10)
# Gráfico de barras de los productos con mayores ventas
ggplot(ventas_por_cliente, aes(x = reorder(Cliente, Ventas), y = Ventas)) +
geom_bar(stat = "identity", fill = "orange") +
labs(x = "Cliente", y = "Ventas", title = "Top 10 de Cliente con mayores ventas") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Calcular las ventas totales por producto
ventas_por_producto <- df_ventas %>%
group_by(Producto) %>%
summarise(Ventas = sum(Cantidad)) %>%
arrange(desc(Ventas)) %>%
top_n(5)
# Gráfico de barras de los productos con mayores ventas
ggplot(ventas_por_producto, aes(x = reorder(Producto, Ventas), y = Ventas)) +
geom_bar(stat = "identity", fill = "skyblue") +
labs(x = "Producto", y = "Ventas", title = "Top 5 de productos con mayores ventas") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Calcular las ventas totales por categoría de producto
ventas_por_categoria <- df_ventas %>%
group_by(Categoria_Producto) %>%
summarise(Ventas = sum(Cantidad)) %>%
arrange(desc(Ventas)) %>%
top_n(5)
# Gráfico de barras de las categorías de productos con mayores ventas
ggplot(ventas_por_categoria, aes(x = reorder(Categoria_Producto, Ventas), y = Ventas)) +
geom_bar(stat = "identity", fill = "lightgreen") +
labs(x = "Categoría de Producto", y = "Ventas", title = "Categorías de productos con mayores ventas") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
df_ventas_agrupado_total <- df_ventas %>%
group_by(Mes_Año) %>%
summarise(Total_Ventas = sum(Cantidad))
df_ventas_ts_total <- ts(df_ventas_agrupado_total$Total_Ventas, start = c(2021, 1), end = c(2023,12), frequency = 12)
# Graficar la serie de tiempo
plot(df_ventas_ts_total, main = "Serie de tiempo", ylab = "Cantidad", col = "blue")
# Realizar la descomposición de la serie de tiempo
Porcomponente1 <- stats::decompose(df_ventas_ts_total)
# Graficar las componentes
plot(Porcomponente1)
Al tener un valor de p menor a 0.05, se rechaza la hipotésis nula, por lo que existe estacionariedad.
##
## Augmented Dickey-Fuller Test
##
## data: df_ventas_ts_total
## Dickey-Fuller = -4.5932, Lag order = 3, p-value = 0.01
## alternative hypothesis: stationary
Al tener un valor de p menor a 0.05, se rechaza la hipotésis nula, por lo que existe autocorrelación serial
# Prueba de Box-Ljung
box_ljung_test1 <- Box.test(df_ventas_ts_total, type = "Ljung-Box")
print(box_ljung_test1)
##
## Box-Ljung test
##
## data: df_ventas_ts_total
## X-squared = 17.207, df = 1, p-value = 3.352e-05
# Plot ACF
acf_plot1 <- acf(df_ventas_ts_total, main = "Función de Autocorrelación (ACF) de Ventas")
Dentro de la estimación del modelo, al utilizar la función auto.arima, los parámetros optimizados corresponden a 1 autocorrelacion, 0 diferencias y 0 promedios móviles, determinando un modelo con un AIC de 873 y RMSE de 40838.33.
## Series: df_ventas_ts_total
## ARIMA(1,0,0) with non-zero mean
##
## Coefficients:
## ar1 mean
## 0.7468 170341.61
## s.e. 0.1183 25033.96
##
## sigma^2 = 1.766e+09: log likelihood = -433.72
## AIC=873.43 AICc=874.18 BIC=878.18
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -3459.526 40838.33 31931.35 -8.167996 21.44947 0.5004715
## ACF1
## Training set -0.08431919
modelo_sarima2 <- arima(df_ventas_ts_total, order = c(0,1,1), seasonal = c(0,1,1))
summary(modelo_sarima2)
##
## Call:
## arima(x = df_ventas_ts_total, order = c(0, 1, 1), seasonal = c(0, 1, 1))
##
## Coefficients:
## ma1 sma1
## -0.2704 0.0660
## s.e. 0.1843 0.2924
##
## sigma^2 estimated as 2.684e+09: log likelihood = -282.37, aic = 570.74
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 6784.491 41408.93 25821.3 2.479361 17.34954 0.7707029 -0.09075112
Al predecir la producción mensual de Form mediante el modelo obtenido, los resultados no muestran seguir un patrón o tendencia bien definido, resultando en un pronóstico ligeramente creciente, pudiendo ser considerado parcialmente flat. Ante esto, es necesario analizar su comportamiento mediante enfoques alternativos. En este caso, a continuación se buscará pronosticar el comportamiento de la producción solicitada por los 3 principales clientes en Form.
predicciones1 <- forecast(modelo_arima1, h = 24) # Predicción de 24 periodos (meses) hacia adelante
print(predicciones1)
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2024 124530.3 70676.60 178384.1 42168.15 206892.5
## Feb 2024 136128.2 68913.15 203343.2 33331.67 238924.7
## Mar 2024 144789.8 71168.42 218411.3 32195.60 257384.1
## Apr 2024 151258.7 74295.33 228222.0 33553.40 268963.9
## May 2024 156089.8 77324.05 234855.6 35627.97 276551.6
## Jun 2024 159697.9 79944.49 239451.3 37725.59 281670.2
## Jul 2024 162392.5 82093.53 242691.5 39585.82 285199.2
## Aug 2024 164404.9 83803.27 245006.6 41135.32 287674.6
## Sep 2024 165907.9 85137.89 246677.9 42380.82 289435.0
## Oct 2024 167030.4 86166.61 247894.1 43359.92 290700.8
## Nov 2024 167868.7 86952.66 248784.7 44118.32 291619.0
## Dec 2024 168494.7 87549.61 249439.8 44699.85 292289.6
## Jan 2025 168962.3 88000.93 249923.7 45142.58 292782.0
## Feb 2025 169311.5 88341.07 250281.9 45477.93 293145.1
## Mar 2025 169572.3 88596.82 250547.7 45730.99 293413.6
## Apr 2025 169767.0 88788.77 250745.3 45921.45 293612.6
## May 2025 169912.5 88932.65 250892.4 46064.51 293760.5
## Jun 2025 170021.1 89040.41 251001.9 46171.80 293870.5
## Jul 2025 170102.3 89121.06 251083.5 46252.19 293952.4
## Aug 2025 170162.9 89181.37 251144.4 46312.36 294013.4
## Sep 2025 170208.1 89226.47 251189.8 46357.38 294058.9
## Oct 2025 170241.9 89260.19 251223.6 46391.05 294092.8
## Nov 2025 170267.2 89285.38 251248.9 46416.22 294118.1
## Dec 2025 170286.0 89304.20 251267.8 46435.03 294137.0
Al realizar la suma de las ventas para cada uno de los clientes de Form, fue posible identificar a los clientes más sobresalientes. Para esta selección se busco observar la suma de sus compras a través de los tres años, determinando si existió o no compras del cliente para todos los años. De esta forma, los clientes seleccionados serían aquellos con las compras más altas, pero que también tuvieron relación comercial con la empresa en cada uno de los 3 años previos. Estos clientes son: Stabilus, HELLA Automotive Mexico, y Tokai Rika Mexico.
top_clientes <- df_ventas_agrupado %>%
group_by(Cliente) %>%
summarise(Total_Ventas = sum(Total_Ventas)) %>%
top_n(5, Total_Ventas) %>%
pull(Cliente)
# Agrupar por Cliente y Año y calcular la suma de las ventas
df_ventas_agrupado_anual <- df_ventas_agrupado %>%
group_by(Año, Cliente) %>%
summarise(Total_Ventas = sum(Total_Ventas))
# Encontrar los tres principales clientes
top_clientes <- df_ventas_agrupado_anual %>%
group_by(Cliente) %>%
summarise(Total_Ventas = sum(Total_Ventas)) %>%
top_n(5, Total_Ventas) %>%
pull(Cliente)
# Filtrar los datos solo para los tres principales clientes
df_top_clientes <- df_ventas_agrupado_anual %>%
filter(Cliente %in% top_clientes)
# Crear la gráfica de barras
ggplot(df_top_clientes, aes(x = Año, y = Total_Ventas, fill = Cliente)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Ventas de Form por Cliente y Año",
x = "Año",
y = "Total Ventas",
fill = "Cliente") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 15),
plot.title = element_text(face= "bold", size = 18))
df_ventas_ts1 <- ts(Stabilus$Total_Ventas, start = c(2021, 1), end = c(2023,12), frequency = 12)
df_ventas_ts2 <- ts(HELLA$Total_Ventas, start = c(2021, 1), end = c(2023,12), frequency = 12)
df_ventas_ts3 <- ts(TOKAI$Total_Ventas, start = c(2021, 1), end = c(2023,12), frequency = 12)
df_ventas_ts <- list(df_ventas_ts1, df_ventas_ts2, df_ventas_ts3)
for (i in 1:3) {
cliente <- c("Stabilus", "HELLA AUTOMOTIVE MEXICO", "TOKAI RIKA MEXICO")[i]
plot(df_ventas_ts[[i]], main = paste("Serie de tiempo -", cliente), ylab = "Cantidad", col = "blue")
}
# Realizar la descomposición estacional para cada serie de tiempo
for (i in 1:3) {
cliente <- c("Stabilus", "HELLA AUTOMOTIVE MEXICO", "TOKAI RIKA MEXICO")[i]
Porcomponente[[i]] <- stats::decompose(df_ventas_ts[[i]])
}
# Trazar las componentes de la descomposición estacional para cada cliente
for (i in 1:3) {
cliente <- c("Stabilus", "HELLA AUTOMOTIVE MEXICO", "TOKAI RIKA MEXICO")[i]
plot(Porcomponente[[i]])
mtext(paste("Descomposición -", cliente), side = 3, line = 1, cex = 1)
}
Dickey Fuller
Stabilus: Al tener un valor de p mayor a 0.05, no se rechaza la hipotésis nula, por lo que no existe estacionariedad.
Hella: Al tener un valor de p mayor a 0.05, no se rechaza la hipotésis nula, por lo que no existe estacionariedad.
Tokai Rika: Al tener un valor de p mayor a 0.05, no se rechaza la hipotésis nula, por lo que no existe estacionariedad.
Box - Ljung
Stabilus: Al tener un valor de p mayor a 0.05, no se rechaza la hipotésis nula, por lo que no existe autocorrelación.
Hella: Al tener un valor de p menor a 0.05, se rechaza la hipotésis nula, por lo que existe autocorrelación.
Tokai Rika: Al tener un valor de p menor a 0.05, se rechaza la hipotésis nula, por lo que existe autocorrelación.
# Prueba de Dickey-Fuller para cada serie de tiempo
for (i in 1:3) {
cliente <- c("Stabilus", "HELLA AUTOMOTIVE MEXICO", "TOKAI RIKA MEXICO")[i]
cat("Cliente:", cliente, "\n")
adf_result <- adf.test(df_ventas_ts[[i]])
print(adf_result)
cat("\n")
}
## Cliente: Stabilus
##
## Augmented Dickey-Fuller Test
##
## data: df_ventas_ts[[i]]
## Dickey-Fuller = -3.2052, Lag order = 3, p-value = 0.1042
## alternative hypothesis: stationary
##
##
## Cliente: HELLA AUTOMOTIVE MEXICO
##
## Augmented Dickey-Fuller Test
##
## data: df_ventas_ts[[i]]
## Dickey-Fuller = -0.91304, Lag order = 3, p-value = 0.9372
## alternative hypothesis: stationary
##
##
## Cliente: TOKAI RIKA MEXICO
##
## Augmented Dickey-Fuller Test
##
## data: df_ventas_ts[[i]]
## Dickey-Fuller = -0.87803, Lag order = 3, p-value = 0.9425
## alternative hypothesis: stationary
# Prueba de Box-Ljung para cada serie de tiempo
for (i in 1:3) {
cliente <- c("Stabilus", "HELLA AUTOMOTIVE MEXICO", "TOKAI RIKA MEXICO")[i]
cat("Cliente:", cliente, "\n")
box_ljung_test <- Box.test(df_ventas_ts[[i]], type = "Ljung-Box")
print(box_ljung_test)
cat("\n")
}
## Cliente: Stabilus
##
## Box-Ljung test
##
## data: df_ventas_ts[[i]]
## X-squared = 0.34643, df = 1, p-value = 0.5561
##
##
## Cliente: HELLA AUTOMOTIVE MEXICO
##
## Box-Ljung test
##
## data: df_ventas_ts[[i]]
## X-squared = 4.3405, df = 1, p-value = 0.03722
##
##
## Cliente: TOKAI RIKA MEXICO
##
## Box-Ljung test
##
## data: df_ventas_ts[[i]]
## X-squared = 13.372, df = 1, p-value = 0.0002554
# Graficar la función de autocorrelación para cada serie de tiempo
for (i in 1:3) {
cliente <- c("Stabilus", "HELLA AUTOMOTIVE MEXICO", "TOKAI RIKA MEXICO")[i]
cat("Cliente:", cliente, "\n")
acf_plot <- acf(df_ventas_ts[[i]], plot = FALSE)
plot(acf_plot)
mtext(paste(cliente), side = 3, line = 1, cex = 1)
cat("\n")
}
## Cliente: Stabilus
##
## Cliente: HELLA AUTOMOTIVE MEXICO
##
## Cliente: TOKAI RIKA MEXICO
La estimación de los modelos para cada uno de los principales clientes se realizó con base en lo revisado previamente y los parámetros empleados se eligieron debio a que la serie temporal tiene ciertas características particulares que no son bien manejadas por los métodos automáticos como algunos cambios estructurales o con patrones relativamente complejos. Lo anterior se realizó con el fin de observar un comportamiento más definido y preciso a través de los meses. Por lo tanto, se optó por realizar un modelo estacional (SARIMA) para adaptarse al comportamiento entre meses. No obstante, a futuro se planea realizar otros modelos predictivos con el fin de optimizar los resultados obtenidos.
El ajuste de parámetros para la producción solicitada por Stabilus fue (0,0,1)(0,0,1), ajustando un modelo SARIMA, es decir, que considera el componente estacional, con 1 promedio móvil tanto en el componente order como en el seasonal.
El ajuste de parámetros para la producción solicitada por Hella Automotive fue (0,0,1)(0,0,1), ajustando un modelo SARIMA, es decir, que considera el componente estacional, con 1 promedio móvil tanto en el componente order como en el seasonal.
El ajuste de parámetros para la producción solicitada por Tokai Rika fue (0,1,0)(0,0,1), ajustando un modelo SARIMA, es decir, que considera el componente estacional, con 1 diferencia en el componente order, y 1 promedio móvil en el componente seasonal.
#Stabilus
# Ajustar el modelo ARIMA a la serie temporal
modelo_arima_ts1 <- arima(df_ventas_ts1, order = c(0, 0, 1), seasonal = c(0, 0, 1))
summary(modelo_arima_ts1)
##
## Call:
## arima(x = df_ventas_ts1, order = c(0, 0, 1), seasonal = c(0, 0, 1))
##
## Coefficients:
## ma1 sma1 intercept
## 0.0683 0.3519 99831.964
## s.e. 0.1463 0.3252 5428.938
##
## sigma^2 estimated as 5.99e+08: log likelihood = -415.67, aic = 839.34
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 1277.278 24474.78 19850.74 -5.142236 21.26204 0.7211767
## ACF1
## Training set 0.007015912
#HELLA
# Ajustar el modelo ARIMA a la serie temporal
modelo_arima_ts2 <- arima(df_ventas_ts2, order = c(0, 0, 1), seasonal = c(0, 0, 1))
summary(modelo_arima_ts2)
##
## Call:
## arima(x = df_ventas_ts2, order = c(0, 0, 1), seasonal = c(0, 0, 1))
##
## Coefficients:
## ma1 sma1 intercept
## 0.1623 -0.1710 16179.171
## s.e. 0.1450 0.1956 2351.459
##
## sigma^2 estimated as 179166981: log likelihood = -393.34, aic = 794.68
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -429.8283 13385.33 10610.74 -1693.441 1721.395 1.041435 0.06032071
#TOKAI RIKA
# Ajustar el modelo ARIMA a la serie temporal
modelo_arima_ts3 <- arima(df_ventas_ts3, order = c(0, 1, 0), seasonal = c(0, 0, 1))
summary(modelo_arima_ts3)
##
## Call:
## arima(x = df_ventas_ts3, order = c(0, 1, 0), seasonal = c(0, 0, 1))
##
## Coefficients:
## sma1
## 0.5580
## s.e. 0.3019
##
## sigma^2 estimated as 3903297: log likelihood = -317.44, aic = 638.87
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -21.20438 1948.043 1509.663 -22.24132 45.85809 0.8312205
## ACF1
## Training set -0.1317307
De acuerdo al modelo SARIMA, la producción solicitada por Stabilus tiene un patrón incremento y descenso, lo cual puede ser incierto para Form al ser su cliente principal. Ante esto, puede suponerse cierto nivel de riesgo, existiendo un decrecimiento considerable con respecto a su demanda al final de cada año.
De acuerdo al modelo SARIMA, la producción solicitada por Hella Automotive supondrá un comportamiento con ligero crecimiento, con un valle en Junio del 2025, continuando con la tendencia de crecimiento en los niveles de producción durante el resto del año.
De acuerdo al modelo ARIMA, la producción solicituda por Tokai Rika supondrá un comportamiento con ligero decrecimiento constante, con picos mínimos en comparación con el comportamiento del resto del año.
#Stabilus
# Realizar predicciones con el modelo ajustado
predicciones <- forecast(modelo_arima_ts1, h = 12)
predicciones
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2024 112339.66 80970.63 143708.7 64364.86 160314.4
## Feb 2024 98026.47 66584.51 129468.4 49940.15 146112.8
## Mar 2024 105922.52 74480.56 137364.5 57836.19 154008.8
## Apr 2024 93357.92 61915.96 124799.9 45271.59 141444.2
## May 2024 117341.28 85899.32 148783.2 69254.96 165427.6
## Jun 2024 119719.19 88277.23 151161.1 71632.86 167805.5
## Jul 2024 103757.82 72315.86 135199.8 55671.49 151844.1
## Aug 2024 110523.36 79081.40 141965.3 62437.03 158609.7
## Sep 2024 99769.99 68328.04 131212.0 51683.67 147856.3
## Oct 2024 102345.99 70904.03 133787.9 54259.67 150432.3
## Nov 2024 113015.67 81573.72 144457.6 64929.35 161102.0
## Dec 2024 85368.80 53926.85 116810.7 37282.49 133455.1
# Graficar las predicciones
plot(predicciones, main = "Predicciones de Ventas - STABILUS", xlab = "Tiempo", ylab = "Cantidad")
#HELLA
# Realizar predicciones con el modelo ajustado
predicciones <- forecast(modelo_arima_ts2, h = 12)
predicciones
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2024 14356.60 -2797.3938 31510.60 -11878.172 40591.38
## Feb 2024 13753.73 -3624.7391 31132.19 -12824.343 40331.79
## Mar 2024 15401.96 -1976.5019 32780.43 -11176.106 41980.03
## Apr 2024 13863.66 -3514.8013 31242.13 -12714.405 40441.73
## May 2024 17810.09 431.6291 35188.56 -8767.975 44388.16
## Jun 2024 10421.16 -6957.3078 27799.62 -16156.911 36999.23
## Jul 2024 16962.60 -415.8650 34341.07 -9615.469 43540.67
## Aug 2024 16669.28 -709.1837 34047.75 -9908.787 43247.35
## Sep 2024 17152.33 -226.1320 34530.80 -9425.736 43730.40
## Oct 2024 17490.65 112.1816 34869.11 -9087.422 44068.72
## Nov 2024 16411.79 -966.6792 33790.25 -10166.283 42989.85
## Dec 2024 19219.12 1840.6518 36597.58 -7358.952 45797.19
# Graficar las predicciones
plot(predicciones, main = "Predicciones de Ventas - HELLA AUTOMOTIVE", xlab = "Tiempo", ylab = "Cantidad")
#TOKAI RIKA
# Realizar predicciones con el modelo ajustado
predicciones <- forecast(modelo_arima_ts3, h = 12)
predicciones
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2024 4202.861 1643.9492 6761.772 289.3432 8116.378
## Feb 2024 4307.876 702.2457 7913.505 -1206.4595 9822.211
## Mar 2024 5189.544 778.9770 9600.112 -1555.8364 11934.925
## Apr 2024 4080.669 -1009.0897 9170.428 -3703.4452 11864.783
## May 2024 4344.536 -1343.8895 10032.961 -4355.1599 13044.231
## Jun 2024 3852.280 -2377.5445 10082.106 -5675.4147 13379.976
## Jul 2024 2831.773 -3896.0249 9559.570 -7457.5057 13121.051
## Aug 2024 2385.075 -4806.2945 9576.445 -8613.1756 13383.326
## Sep 2024 2952.464 -4674.3526 10579.281 -8711.7456 14616.674
## Oct 2024 2855.788 -5182.9226 10894.499 -9438.3591 15149.936
## Nov 2024 2961.073 -5469.4314 11391.578 -9932.2711 15854.418
## Dec 2024 2708.306 -6096.5765 11513.188 -10757.5995 16174.211
# Graficar las predicciones
plot(predicciones, main = "Predicciones de Ventas - TOKAI RIKA", xlab = "Tiempo", ylab = "Cantidad")
El pronóstico de ventas de FORM, en términos monetarios, fue mediante el modelo de suavización exponencial, el cual resultó en una tendencia creciente en las ventas futuras a través de los siguientes meses. A pesar de esto, se presentan varios valles durante dicho periodo lo que implica cierto comportamiento en los clientes de la industria automotriz y sus derivados.
El pronóstico de ventas de FORM, en términos de cantidad de productos, determina que las ventas generales tendrán cierto decaimiento pero continuará con un aumento mensual. Esto se muestra con la predicción de los tres principales clientes claves de FORM que tienen presencia cada año en las ventas, ya que las tres empresas tienen un comportamiento que sube y baja pero se diferencia en la medida de ls picos y valles. De igual manera, se muestra que Stabilus tendrá una reducción en su nivel de ventas en 2025; además coinciden en que habrá en sus ventas del 2025 en comparación con años anteriores. Pero esto no implica que siga existiendo cierto aumento ligero conforme pasa cada periodo. Acorde a esto, se requiere establecer estrategias para reducir los efectos de esta dependencia y aprovechar el incremento de demanda generalizado.
Existe un desafío de Retención en Empleados Jóvenes y Solteros, ya que el análisis de clustering revela que la mayoría de los empleados que abandonan Form resultó en 3 perfiles de edad. Esto permitió observar que la mayor parte de empleados que terminan su relación laboral en la empresa son jóvenes solteros o en unión libre, considerando la libertad brindada por las posibles oportunidades disponibles y la falta de un compromiso familiar (responsabilidad de la situación financiera de la familia). En estos perfiles de abadono, se identifica también el mayor abandono al residir en Apodaca (principal municipio de parques industriales) y ser mujeres jovenes (posiblemente buscando oportunidades de crecimiento).
La fuerza laboral de Form está conformada principalmente por empleados con las siguientes características: Mujeres, residentes de Apodaca, educación secundaria, con la principal razón para trabajar siendo la ubicación de la empresa.
El análisis de Text Mining sobre los comentarios de los empleados por medio de las frecuencias determinó que los principales factores negativos al trabajar en Form son: calor, salario, prestaciones y estrés. Asimismo, el Análisis de Sentimientos también relacionó que estos comentarios negativos tienen una relación con la principal emoción negativa siendo la ansiedad. Por lo tanto, se debe mejorar el bienestar laboral abordando estas preocupaciones por medio de la implementación de medidas para reducir el estrés, mejorar las condiciones de trabajo y ofrecer compensaciones competitivas.
El modelo más apropiado para analizar el abandono de los empleados en Form corresponde a Naive Bayes, debido a su capacidad de analizar cada factor de forma independiente, así como su desempeño considerable en las métricas. Accuracy:0. 80, Kappa: .29 y AUC: 0.77.
De acuerdo al modelo Naive Bayes, las variables explicativas estiman las siguientes cualidades para determinar la permanencia/retención de los empleados en Form: El empleado es mujer, está en una edad adulta (media 35), trabajó ya más de un año en la empresa (promedio 14 meses), considera que recibe una retribución justa de salario y prestaciones para sus labores realizadas, perciben su estrés bajo y una buena facilidad de traslado.
El acontecimiento del Nearshoring será casi nulo en México, ya que se estima que ocurre pero en un nivel poco significativo para la industria en menor medida. Aunuqe existe cierta incertidumbre el respecto dependiendo ciertos factores externos políticos y económicos. Acorde a esto, se estima que tendrá un impacto negativo en la producción de empaques de cartón para autopartes en México y, por ende, en FORM, puesto que este efecto podría aumentar la rotación de empleados y disminuir la demanda de empaques de cartón. La probabilidad del aumento de la rotación de empleados sería más alta si FORM no ofrece condiciones de trabajo atractivas en relación a sus competidores y/o si no tiene un plan integral de crecimiento claro. Asimismo, acorde a las estimaciones de las ventas del top 3 de clientes de FORM junto con la predicción de ventas general de la empresa, se estima que habrá una cierto crecimiento en sus ventas de producto y monetarias lo que implica que la empresa sea más susceptible a las fluctuaciones en la demanda del mercado local; además de tener ciertas complicaciones con empresas internacionales con fuerte posicionamiento y/o que utilizan una estrategia de reducción de costos. Por lo tanto, se recomienda desarrollar planes de contingencia para adaptarse a diferentes escenarios y generar estrategias para mitigar la alta dependencia a los tres principales clientes ya que, representan aproximadamente el 70% de las ventas totales lo que implica graves afectaciones de rentabilidad a la empresa.
Form. (2021) The form way. https://form.com.mx/the-form-way/https://form.com.mx/the-form-way/
Mercado de cajas de cartón corrugado, tamaño, cuota 2024-2032. (s. f.). Expert Market Research. https://www.informesdeexpertos.com/informes/mercado-de-cajas-de-carton-corrugado
NuvoCargo. (2024). Nearshoring to Mexico: A golden opportunity for auto, packaging, and electronics. NuvoCargo. Recuperado el 5 de marzo de 2024 de: https://www.nuvocargo.com/en/content/blog-posts/nearshoring-to-mexico-a-golden-opportunity-for-auto-packaging-and-electronics
Patil, P. (2018, March 23). What is Exploratory Data Analysis? - Towards Data Science. Medium. https://towardsdatascience.com/exploratory-data-analysis-8fc1cb20fd15
Portaledomex. (2019). Ocupa México sexto lugar a nivel mundial en consumo de papel. Diario Portal. https://diarioportal.com/2019/11/04/ocupa-mexico-sexto-lugar-a-nivel-mundial-en-consumo-de-papel/
Quintana, F. (2022, 28 octubre). Mercado de cartón y papel muestra creciente dinamismo. Inovacor. https://inovacor.mx/mercado-de-carton-y-papel-muestra-creciente-dinamismo/
Saucedo, D. (2022) FORM - Human Resources Department K-Means Clustering. Tec de Monterrey. https://drive.google.com/file/d/1R2DgQBRco5U2EefILiIZQYm4_CLKnZER/view?usp=drive_link
SE CONSOLIDA APODACA COMO CAPITAL INDUSTRIAL DE NUEVO LEÓN. (2019, October 6). Apodaca. https://apodaca.gob.mx/se-consolida-apodaca-como-capital-industrial-de-nuevo-leon/
Social
Sostenibilidad y conciencia ambiental: Una creciente preocupación por el medio ambiente podría impulsar la demanda de empaques sostenibles.
Preferencias del consumidor: Tendencias hacia productos locales y de menor impacto ambiental pueden afectar las decisiones de compra.