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 retola predicción de la oferta y la demanda, 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")
df_ventas <- df[, !names(df) %in% c("Folio_Factura", "No_Cliente", "Ref_cliente", "Estado")]
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)
df_ventas$Fecha <- as.Date(df_ventas$Fecha)
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
df_ventas$Fecha <- as.Date(df_ventas$Fecha)
# Extraer el mes y el año de la columna Fecha
df_ventas <- df_ventas %>%
mutate(Año = lubridate::year(Fecha),
Mes = lubridate::month(Fecha))
ventas_por_mes <- df_ventas %>%
group_by(Año, Mes) %>%
summarise(Cantidad = sum(Cantidad))
# Fusionar los datos de ventas_por_mes con df_ventas
df_ventas <- df_ventas %>%
left_join(ventas_por_mes, by = c("Año", "Mes"))
df_ventas <- df_ventas %>%
rename(Ventas_Mensuales = Cantidad.y)
# Mostrar las primeras filas de df_ventas para verificar
head(df_ventas)
## # A tibble: 6 × 8
## Fecha Cliente Producto Cantidad.x Categoria_Producto Año Mes
## <date> <fct> <fct> <dbl> <fct> <dbl> <dbl>
## 1 2021-01-04 GRUPO ANTOLIN S… [CAJA R… 100 Cartón / Producto… 2021 1
## 2 2021-01-04 GRUPO ANTOLIN S… [CELDA … 80 Cartón / Producto… 2021 1
## 3 2021-01-04 GRUPO ANTOLIN S… [180022… 1000 Cartón / Producto… 2021 1
## 4 2021-01-04 GRUPO ANTOLIN S… [180003… 100 Cartón / Producto… 2021 1
## 5 2021-01-04 GRUPO ANTOLIN S… [180203… 50 Cartón / Producto… 2021 1
## 6 2021-01-04 GRUPO ANTOLIN S… [180203… 300 Cartón / Producto… 2021 1
## # ℹ 1 more variable: Ventas_Mensuales <dbl>
# Calcular las ventas totales por producto
ventas_por_producto <- df_ventas %>%
group_by(Producto) %>%
summarise(Ventas = sum(Cantidad.x)) %>%
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.x)) %>%
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$Año_Mes <- as.yearmon(df_ventas$Fecha)
df_ventas$Año_Mes <- as.Date(df_ventas$Año_Mes)
# Crear la serie de tiempo mensual
df_ventas_ts1 <- ts(df_ventas$Cantidad.x, start = c(min(year(df_ventas$Año_Mes))), end = c(max(year(df_ventas$Año_Mes))), frequency = 12)
# Graficar la serie de tiempo
plot(df_ventas_ts1, main = "Serie de tiempo", ylab = "Cantidad", col = "blue")
# Realizar la descomposición de la serie de tiempo
Porcomponente1 <- stats::decompose(df_ventas_ts1)
# Graficar las componentes
plot(Porcomponente1)
Al tener un valor de p mayor a 0.05, no se rechaza la hipotésis nula, por lo que no existe estacionariedad.
##
## Augmented Dickey-Fuller Test
##
## data: df_ventas_ts1
## Dickey-Fuller = -3.2923, Lag order = 2, p-value = 0.09274
## alternative hypothesis: stationary
Al tener un valor de p mayor a 0.05, no se rechaza la hipotésis nula, por lo que no existe autocorrelación serial
# Prueba de Box-Ljung
box_ljung_test1 <- Box.test(df_ventas_ts1, type = "Ljung-Box")
print(box_ljung_test1)
##
## Box-Ljung test
##
## data: df_ventas_ts1
## X-squared = 0.67847, df = 1, p-value = 0.4101
Al utilizar la función auto.arima para la optimización de parámetros, los valores obtenidos son 0 autocorrelaciones, 1 diferencia y 0 promedios móviles, determinando un modelo con un AIC de 392.82 y RMSE de 814.
## Series: df_ventas_ts1
## ARIMA(0,1,0)
##
## sigma^2 = 691165: log likelihood = -195.41
## AIC=392.82 AICc=393 BIC=393.99
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 40.404 814.5662 485.284 -177.1655 237.8889 0.6923499 -0.3809994
Al predecir la producción mensual de Form mediante el modelo obtenido, los resultados no muestran seguir un patrón o tendencia, resultando en un pronóstico 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 = 23) # Predicción de 23 periodos (meses) hacia adelante
print(predicciones1)
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Feb 2023 1110 44.5652 2175.435 -519.4419 2739.442
## Mar 2023 1110 -396.7523 2616.752 -1194.3788 3414.379
## Apr 2023 1110 -735.3872 2955.387 -1712.2762 3932.276
## May 2023 1110 -1020.8696 3240.870 -2148.8838 4368.884
## Jun 2023 1110 -1272.3846 3492.385 -2533.5429 4753.543
## Jul 2023 1110 -1499.7716 3719.772 -2881.3012 5101.301
## Aug 2023 1110 -1708.8755 3928.876 -3201.0981 5421.098
## Sep 2023 1110 -1903.5047 4123.505 -3498.7577 5718.758
## Oct 2023 1110 -2086.3044 4306.304 -3778.3257 5998.326
## Nov 2023 1110 -2259.2007 4479.201 -4042.7477 6262.748
## Dec 2023 1110 -2423.6475 4643.647 -4294.2474 6514.247
## Jan 2024 1110 -2580.7744 4800.774 -4534.5523 6754.552
## Feb 2024 1110 -2731.4798 4951.480 -4765.0363 6985.036
## Mar 2024 1110 -2876.4920 5096.492 -4986.8133 7206.813
## Apr 2024 1110 -3016.4112 5236.411 -5200.8014 7420.801
## May 2024 1110 -3151.7392 5371.739 -5407.7676 7627.768
## Jun 2024 1110 -3282.9002 5502.900 -5608.3611 7828.361
## Jul 2024 1110 -3410.2570 5630.257 -5803.1365 8023.137
## Aug 2024 1110 -3534.1226 5754.123 -5992.5726 8212.573
## Sep 2024 1110 -3654.7693 5874.769 -6177.0857 8397.086
## Oct 2024 1110 -3772.4356 5992.436 -6357.0409 8577.041
## Nov 2024 1110 -3887.3322 6107.332 -6532.7600 8752.760
## Dec 2024 1110 -3999.6458 6219.646 -6704.5289 8924.529
ventas_por_cliente <- df_ventas %>%
group_by(Cliente, Año, Mes) %>%
summarise(VentasCliente = sum(Cantidad.x))
# Fusionar los datos de ventas_por_cliente con df_ventas
df_ventas <- df_ventas %>%
left_join(ventas_por_cliente, by = c("Cliente", "Año", "Mes"))
# Mostrar las primeras filas de df_ventas para verificar
head(df_ventas)
## # A tibble: 6 × 10
## Fecha Cliente Producto Cantidad.x Categoria_Producto Año Mes
## <date> <fct> <fct> <dbl> <fct> <dbl> <dbl>
## 1 2021-01-04 GRUPO ANTOLIN S… [CAJA R… 100 Cartón / Producto… 2021 1
## 2 2021-01-04 GRUPO ANTOLIN S… [CELDA … 80 Cartón / Producto… 2021 1
## 3 2021-01-04 GRUPO ANTOLIN S… [180022… 1000 Cartón / Producto… 2021 1
## 4 2021-01-04 GRUPO ANTOLIN S… [180003… 100 Cartón / Producto… 2021 1
## 5 2021-01-04 GRUPO ANTOLIN S… [180203… 50 Cartón / Producto… 2021 1
## 6 2021-01-04 GRUPO ANTOLIN S… [180203… 300 Cartón / Producto… 2021 1
## # ℹ 3 more variables: Ventas_Mensuales <dbl>, Año_Mes <date>,
## # VentasCliente <dbl>
df_top3 <- df_ventas %>%
group_by(Cliente) %>%
summarise(VentasCliente = sum(Ventas_Mensuales)) %>%
arrange(desc(VentasCliente)) %>%
slice(1:3)
df_ventas_ts <- list()
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
df_ventas_ts[[i]] <- ts(df_ventas[df_ventas$Cliente == cliente, "Cantidad.x"],
start = c(min(year(df_ventas$Año_Mes))),
end = c(max(year(df_ventas$Año_Mes))),
frequency = 12)
}
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
plot(df_ventas_ts[[i]], main = paste("Serie de tiempo -", cliente), ylab = "Cantidad", col = "blue")
}
Porcomponente <- list()
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
Porcomponente[[i]] <- stats::decompose(df_ventas_ts[[i]])
}
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
plot(Porcomponente[[i]])
mtext(paste("Descomposición -", cliente), side = 3, line = 1, cex = 1)
}
En la prueba ADF, todos obtuvieron valores de p mayor a 0.05, por lo cual no es posible rechazar la hipotésis nula, es decir, no existe estacionariedad.
En la prueba Box-Ljung, todos obtuvieron valores de p mayor a 0.05, por lo cual no es posible rechazar la hipotésis nula, es decir, no existe autocorrelación serial.
# Prueba de Dickey-Fuller para cada serie de tiempo
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
cat("Cliente:", cliente, "\n")
adf_result <- adf.test(df_ventas_ts[[i]])
print(adf_result)
cat("\n")
}
## Cliente: 26
##
## Augmented Dickey-Fuller Test
##
## data: df_ventas_ts[[i]]
## Dickey-Fuller = -2.8858, Lag order = 2, p-value = 0.2349
## alternative hypothesis: stationary
##
##
## Cliente: 14
##
## Augmented Dickey-Fuller Test
##
## data: df_ventas_ts[[i]]
## Dickey-Fuller = -2.9828, Lag order = 2, p-value = 0.198
## alternative hypothesis: stationary
##
##
## Cliente: 24
##
## Augmented Dickey-Fuller Test
##
## data: df_ventas_ts[[i]]
## Dickey-Fuller = -1.7095, Lag order = 2, p-value = 0.6831
## alternative hypothesis: stationary
# Prueba de Box-Ljung
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
cat("Cliente:", cliente, "\n")
box_ljung_test <- Box.test(df_ventas_ts[[i]])
print(box_ljung_test)
cat("\n")
}
## Cliente: 26
##
## Box-Pierce test
##
## data: df_ventas_ts[[i]]
## X-squared = 0.83068, df = 1, p-value = 0.3621
##
##
## Cliente: 14
##
## Box-Pierce test
##
## data: df_ventas_ts[[i]]
## X-squared = 0.13377, df = 1, p-value = 0.7146
##
##
## Cliente: 24
##
## Box-Pierce test
##
## data: df_ventas_ts[[i]]
## X-squared = 0.066082, df = 1, p-value = 0.7971
# Prueba de Box-Ljung
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
cat("Cliente:", cliente, "\n")
acf_plot <- acf(df_ventas_ts[[i]], plot = FALSE) # Utiliza plot = FALSE para suprimir la impresión
plot(acf_plot) # Grafica la función de autocorrelación
mtext(paste(cliente), side = 3, line = 1, cex = 1)
cat("\n")
}
## Cliente: 26
##
## Cliente: 14
##
## Cliente: 24
El ajuste de parámetros con auto.arima estimo los parámetros óptimos para la producción solicitada por PO Lightning Mexico como (0,0,0), no capturando adecuadamente ningún patrón adecuado para su comportamiento, por lo cual el pronóstico obtenido será una línea recta.
El ajuste de parámetros con auto.arima estimo los parámetros óptimos para la producción solicitada por Grupo Antolín Saltillo como (0,0,0)(0,1,0), ajustando un modelo SARIMA, es decir, que considera el componente estacional con 1 diferencia en este.
El ajuste de parámetros con auto.arima estimo los parámetros óptimos para la producción solicitada por Stabilus como (0,0,0)(0,1,0), ajustando un modelo SARIMA, es decir, que considera el componente estacional con 1 diferencia en este.
modelos_arima <- list()
# Ajustar modelos ARIMA para cada cliente
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
modelos_arima[[i]] <- auto.arima(df_ventas_ts[[i]])
}
# Imprimir los resultados de los modelos
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
cat("Cliente:", cliente, "\n")
print(summary(modelos_arima[[i]]))
cat("\n")
}
## Cliente: 26
## Series: df_ventas_ts[[i]]
## ARIMA(0,0,0) with non-zero mean
##
## Coefficients:
## mean
## 540.640
## s.e. 136.246
##
## sigma^2 = 483409: log likelihood = -198.57
## AIC=401.14 AICc=401.69 BIC=403.58
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -2.227774e-13 681.2287 511.5392 -3184.261 3214.757 0.527611
## ACF1
## Training set 0.1822836
##
## Cliente: 14
## Series: df_ventas_ts[[i]]
## ARIMA(0,0,0)(0,1,0)[12]
##
## sigma^2 = 84792: log likelihood = -92.21
## AIC=186.42 AICc=186.78 BIC=186.98
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 24.4848 209.9811 64.4848 -122.8187 135.7147 0.5206847 -0.02513542
##
## Cliente: 24
## Series: df_ventas_ts[[i]]
## ARIMA(0,0,0)(0,1,0)[12]
##
## sigma^2 = 3554: log likelihood = -71.59
## AIC=145.18 AICc=145.54 BIC=145.74
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -3.5564 42.98936 22.4436 -44.77018 64.58047 0.5210121 -0.384188
De acuerdo al modelo SARIMA, la producción solicitada por Stabilus tiene un patrón en descenso, lo cual puede ser alarmante para Form al ser su cliente principal. Ante esto, puede suponerse un conflicto en la relación entre Form y Stabilus, existiendo un decrecimiento considerable con respecto a su demanda al inicio de la relación.
De acuerdo al modelo SARIMA, la producción solicituda por Grupo Antolin supondrá un comportamiento similar al visto previamente, con picos de crecimiento al inicio de cada año y niveles normales de producción durante el resto del año.
De acuerdo al modelo ARIMA generado por los parámetros de auto.arima, no fue posible capturar el comportamiento en la producción solicituda por PO Lightning México, por lo que no se pudo determinar la demanda futura, siendo necesaria la exploración de alternativas de pronóstico.
predicciones <- list()
# Realizar predicciones para cada cliente
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
predicciones[[i]] <- forecast(df_ventas_ts[[i]], h = 23)
}
# Imprimir los resultados de las predicciones
for (i in 1:3) {
cliente <- df_top3$Cliente[i]
cat("Cliente:", cliente, "\n")
print(predicciones[[i]])
plot(predicciones[[i]], main = paste("Predicciones de Ventas -", cliente))
cat("\n")
}
## Cliente: 26
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Feb 2023 -46.22999 -99.47435 7.014358 -127.6602 35.20022
## Mar 2023 -95.57895 -208.01187 16.853980 -267.5303 76.37238
## Apr 2023 -144.92790 -320.36482 30.509027 -413.2355 123.37972
## May 2023 -194.27685 -437.14203 48.588328 -565.7071 177.15339
## Jun 2023 -243.62580 -559.00891 71.757305 -725.9626 238.71104
## Jul 2023 -292.97476 -686.68300 100.733494 -895.0996 309.15005
## Aug 2023 -342.32371 -820.93553 136.288118 -1074.2973 389.64991
## Sep 2023 -391.67266 -962.59457 179.249246 -1264.8224 481.47705
## Oct 2023 -441.02161 -1112.54935 230.506129 -1468.0347 585.99144
## Nov 2023 -490.37056 -1271.75582 291.014696 -1685.3962 704.65507
## Dec 2023 -539.71952 -1441.24325 361.804219 -1918.4811 839.04206
## Jan 2024 -589.06847 -1622.12210 443.985164 -2168.9877 990.85072
## Feb 2024 -638.41742 -1815.59309 538.758245 -2438.7522 1161.91740
## Mar 2024 -687.76637 -2022.95746 647.424716 -2729.7649 1354.23218
## Apr 2024 -737.11533 -2245.62856 771.397909 -3044.1872 1569.95658
## May 2024 -786.46428 -2485.14463 912.216078 -3384.3717 1811.44314
## Jun 2024 -835.81323 -2743.18306 1071.556599 -3752.8837 2081.25720
## Jul 2024 -885.16218 -3021.57596 1251.251597 -4152.5251 2382.20074
## Aug 2024 -934.51114 -3322.32737 1453.305097 -4586.3609 2717.33866
## Sep 2024 -983.86009 -3647.63199 1679.911813 -5057.7477 3090.02748
## Oct 2024 -1033.20904 -3999.89579 1933.477711 -5570.3649 3503.94681
## Nov 2024 -1082.55799 -4381.75848 2216.642495 -6128.2497 3963.13374
## Dec 2024 -1131.90694 -4796.11809 2532.304203 -6735.8343 4472.02041
##
## Cliente: 14
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Feb 2023 68.10756 22.36149 113.85364 -1.855019 138.07015
## Mar 2023 1318.91969 433.03573 2204.80365 -35.922908 2673.76229
## Apr 2023 86.58262 28.42733 144.73790 -2.358218 175.52345
## May 2023 45.13725 14.81973 75.45476 -1.229387 91.50388
## Jun 2023 242.35817 79.57250 405.14383 -6.601022 491.31736
## Jul 2023 67.83986 22.27359 113.40612 -1.847730 137.52744
## Aug 2023 56.82030 18.65559 94.98502 -1.547595 115.18820
## Sep 2023 74.51629 24.46564 124.56694 -2.029575 151.06216
## Oct 2023 50.21774 16.48779 83.94769 -1.367764 101.80325
## Nov 2023 144.72537 47.51711 241.93363 -3.941839 293.39258
## Dec 2023 95.31437 31.29419 159.33454 -2.596048 193.22478
## Jan 2024 68.99610 22.65321 115.33898 -1.879226 139.87142
## Feb 2024 68.10757 22.36135 113.85378 -1.855228 138.07036
## Mar 2024 1318.91977 433.03311 2204.80644 -35.926965 2673.76651
## Apr 2024 86.58262 28.42716 144.73808 -2.358484 175.52373
## May 2024 45.13725 14.81964 75.45485 -1.229525 91.50402
## Jun 2024 242.35818 79.57202 405.14434 -6.601768 491.31813
## Jul 2024 67.83986 22.27346 113.40626 -1.847939 137.52766
## Aug 2024 56.82031 18.65547 94.98514 -1.547770 115.18838
## Sep 2024 74.51630 24.46549 124.56710 -2.029805 151.06240
## Oct 2024 50.21775 16.48769 83.94780 -1.367919 101.80341
## Nov 2024 144.72538 47.51682 241.93394 -3.942284 293.39304
## Dec 2024 95.31437 31.29400 159.33475 -2.596341 193.22509
##
## Cliente: 24
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Feb 2023 88.39753 13.61078 163.1843 -25.97893 202.774
## Mar 2023 88.39753 13.61078 163.1843 -25.97893 202.774
## Apr 2023 88.39753 13.61078 163.1843 -25.97893 202.774
## May 2023 88.39753 13.61078 163.1843 -25.97893 202.774
## Jun 2023 88.39753 13.61078 163.1843 -25.97893 202.774
## Jul 2023 88.39753 13.61078 163.1843 -25.97893 202.774
## Aug 2023 88.39753 13.61078 163.1843 -25.97894 202.774
## Sep 2023 88.39753 13.61078 163.1843 -25.97894 202.774
## Oct 2023 88.39753 13.61078 163.1843 -25.97894 202.774
## Nov 2023 88.39753 13.61078 163.1843 -25.97894 202.774
## Dec 2023 88.39753 13.61078 163.1843 -25.97894 202.774
## Jan 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## Feb 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## Mar 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## Apr 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## May 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## Jun 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## Jul 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## Aug 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## Sep 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## Oct 2024 88.39753 13.61078 163.1843 -25.97894 202.774
## Nov 2024 88.39753 13.61077 163.1843 -25.97894 202.774
## Dec 2024 88.39753 13.61077 163.1843 -25.97894 202.774
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 compartamiento 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 habrá cierto aumento aproximado de 100 productos cada mes lo que implica mayor utilidad. No obstante, habrpa una reducción entre alguno de sus clientes principales lo que implica 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 Nearshoring incierto podría tener un impacto negativo en la industria de empaques de cartón para autopartes en México, ya 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 compatidores 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 reducción de sus pedidos lo que se propicia con el nearshoring ya que, al existir incertidumbre hay incertidumbre sobre la evolución del mercado. 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 puesto que, representna aprox 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.