Capstone #1
Carlos Chapman, Ana Maria Llinas, Giovanny Zambrano y Gilberto Gomez
2025-02-19
library(pacman)
p_load(dynlm, fpp2, tidyverse, TSstudio, urca, forecast, zoo, tidyverse, fma, cat, expsmooth, dplyr, ggplot2)Problema 1: Análisis de Tendencia
Este análisis se enfoca en la evolución de la cartera comercial en moneda legal mensual, la cual representa los préstamos otorgados por entidades financieras a empresas y negocios. Se escogió esta variable debido a su importancia en la dinámica del crédito y el impacto que tiene en la economía. El objetivo principal es examinar su comportamiento a lo largo del tiempo, identificar tendencias y evaluar la posible presencia de estacionalidad, utilizando herramientas estadísticas y modelos de series de tiempo.
Creacion Data Frame
# Cargar las librerías necesarias
library(readxl)
library(dplyr)
library(ggplot2)
library(gganimate)
library(dplyr)
library(gifski)
library(transformr)
library(tidyr)
library(tidyverse)
library(forecast)
library(TSstudio)
library(zoo)
# Leer los datos desde el archivo Excel
file_path <- "Cartera Comercial 2.0.xlsx" # Asegúrate de que el archivo esté en el mismo directorio de trabajo
data <- read_excel(file_path)
# Mostrar las primeras filas del dataframe para entender su estructura
head(data)## # A tibble: 6 × 2
## Fecha `Cartera comercial en moneda legal, mensual`
## <dttm> <chr>
## 1 2002-05-31 00:00:00 26.672,03
## 2 2002-06-30 00:00:00 26.797,14
## 3 2002-07-31 00:00:00 26.929,27
## 4 2002-08-31 00:00:00 27.129,69
## 5 2002-09-30 00:00:00 27.548,80
## 6 2002-10-31 00:00:00 27.856,071.a Estadisticas basicas
file_path <- "Cartera Comercial 2.0.xlsx"
data <- read_excel(file_path)
data$Fecha <- as.Date(data$Fecha, format = "%d/%m/%Y")
if (sum(is.na(data$Fecha)) > 0) {
data$Fecha <- as.Date(data$Fecha, format = "%d/%m/%y")
}
# Convertir la columna de valores a numérico
data$`Cartera comercial en moneda legal, mensual` <- as.numeric(gsub("[,\\.]", "", data$`Cartera comercial en moneda legal, mensual`))
basic_stats <- data %>%
summarise(
media = mean(`Cartera comercial en moneda legal, mensual`, na.rm = TRUE),
mediana = median(`Cartera comercial en moneda legal, mensual`, na.rm = TRUE),
desviacion_estandar = sd(`Cartera comercial en moneda legal, mensual`, na.rm = TRUE),
minimo = min(`Cartera comercial en moneda legal, mensual`, na.rm = TRUE),
maximo = max(`Cartera comercial en moneda legal, mensual`, na.rm = TRUE)
)
print(basic_stats)## # A tibble: 1 × 5
## media mediana desviacion_estandar minimo maximo
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 3151130. 3119592 315862. 2667203 3681373El análisis de las estadísticas básicas de la serie de cartera comercial en moneda legal mensual proporciona información clave sobre su comportamiento. La media de aproximadamente 3,151,130 millones de pesos indica que, en promedio, la cartera comercial se ha mantenido en un nivel estable a lo largo del período analizado. La mediana de 3,119,592 millones, cercana a la media, sugiere que los valores están distribuidos de manera relativamente simétrica, sin una presencia fuerte de valores extremos que distorsionen la percepción central de la serie. La desviación estándar de 315,862 millones de pesos refleja un nivel moderado de dispersión en torno a la media, indicando que, aunque existen fluctuaciones, estas no han sido excesivamente abruptas. Además, el rango entre el mínimo de 2,667,203 millones y el máximo de 3,681,373 millones confirma que la cartera comercial ha experimentado un crecimiento progresivo, lo que puede estar vinculado a factores económicos como el aumento del crédito y la estabilidad del sector financiero. Estas estadísticas reflejan una tendencia de crecimiento controlado en la cartera comercial, lo que es indicativo de un mercado financiero saludable con variaciones dentro de un margen predecible.
1b. Construya un histograma de frecuencias para la serie. ¿Qué le indica?
# Leer los datos desde el archivo Excel
data <- read_excel("Cartera comercial 2.0.xlsx")
# Limpiar la columna: eliminar posibles caracteres no numéricos
data <- data %>%
mutate(`Cartera comercial en moneda legal, mensual` = str_replace_all(`Cartera comercial en moneda legal, mensual`, "[^0-9.-]", "")) %>%
mutate(`Cartera comercial en moneda legal, mensual` = as.numeric(`Cartera comercial en moneda legal, mensual`))
# Verificar si hay valores NA después de la conversión
sum(is.na(data$`Cartera comercial en moneda legal, mensual`)) # Si da >0, aún hay problemas en los datos## [1] 0# Crear histograma con curva de densidad y rug plot
ggplot(data, aes(x = `Cartera comercial en moneda legal, mensual`)) +
geom_histogram(aes(y = ..density..), bins = 10, fill = "deepskyblue3", color = "black", alpha = 0.7) +
geom_density(color = "red", linewidth = 1.2) +
geom_rug(sides = "b", color = "darkblue") + # Agrega marcas en la base del gráfico
theme_minimal(base_size = 14) +
labs(
title = "Distribución de la Cartera Comercial en Moneda Legal",
subtitle = "Histograma con curva de densidad y rug plot",
x = "Monto de Cartera",
y = "Densidad"
) +
theme(
plot.title = element_text(face = "bold", size = 16, color = "blue4"),
plot.subtitle = element_text(size = 12, color = "darkred"),
axis.text = element_text(size = 12),
axis.title = element_text(size = 14, face = "bold")
)## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
### El histograma de la serie de cartera comercial en moneda legal
permite visualizar la distribución de los valores registrados y analizar
su comportamiento estadístico. Se observa que la distribución presenta
una ligera asimetría positiva, lo que significa que existen períodos en
los que la cartera comercial ha registrado valores superiores a la
media, aunque con menor frecuencia. Esto se evidencia en la presencia de
una cola hacia la derecha en la distribución de los datos. La mayor
concentración de valores se encuentra en el rango de 2,900,000 a
3,400,000 millones de pesos, lo que indica que estos han sido los
valores más frecuentes a lo largo del período de estudio. A medida que
los valores se alejan de este rango, la densidad de la frecuencia
disminuye, lo que implica que los valores extremadamente altos o bajos
han sido menos comunes. La presencia de algunos valores elevados sugiere
la existencia de factores externos que han impulsado un crecimiento
temporal en la cartera comercial, posiblemente debido a expansiones del
crédito o cambios en las políticas financieras. En términos generales,
la distribución de la cartera comercial indica que la mayoría de los
valores han permanecido dentro de un rango estable, con algunas
variaciones influenciadas por el entorno macroeconómico.
1c. Establezca un análisis del componente de la serie (Tendencia). ¿ Cuál es la dinámica de la serie en el periodo de estudio?
# Asegurar que la columna 'Fecha' existe en el dataset
if (!"Fecha" %in% colnames(data)) {
stop("Error: La columna 'Fecha' no existe en el dataset. Verifica el nombre exacto.")
}
# Preparar datos
data_clean <- data %>%
mutate(
Fecha = as.Date(Fecha),
Cartera = as.numeric(`Cartera comercial en moneda legal, mensual`)
) %>%
drop_na() %>%
mutate(Media_Movil = rollmean(Cartera, k = 3, fill = NA, align = "right"))
# Graficar serie con tendencia y media móvil
ggplot(data_clean, aes(x = Fecha, y = Cartera)) +
geom_line(color = "deepskyblue3", linewidth = 1) + # Serie original
geom_smooth(method = "lm", formula = y ~ x, color = "red", linetype = "dashed", se = FALSE) + # Tendencia lineal
geom_line(aes(y = Media_Movil), color = "purple", linewidth = 1, linetype = "dotted", na.rm = TRUE) + # Media móvil
theme_minimal() +
labs(
title = "Tendencia de la Cartera Comercial",
subtitle = "Serie original (azul), tendencia lineal (rojo), media móvil (morado)",
x = "Fecha",
y = "Monto de Cartera"
)
El análisis de la tendencia de la cartera comercial en moneda legal revela un crecimiento progresivo a lo largo del período de estudio. En el gráfico de la serie de tiempo se identifican tres componentes clave: la serie original en azul, que muestra la evolución mes a mes de la cartera comercial; la tendencia lineal en rojo, que refleja el crecimiento sostenido de la serie; y la media móvil en morado, que suaviza las fluctuaciones a corto plazo y permite visualizar patrones más claros. A partir del análisis del gráfico, se puede concluir que la tendencia general de la serie es ascendente, lo que indica que la cartera comercial ha experimentado un crecimiento constante a lo largo del tiempo. Sin embargo, también se identifican fluctuaciones en la serie original, lo que sugiere la presencia de factores estacionales o eventos económicos específicos que han generado variaciones temporales en la cartera. La media móvil confirma esta tendencia creciente sin cambios abruptos, lo que refuerza la idea de que el crecimiento ha sido estable y predecible. Este comportamiento puede estar asociado a diversos factores, como un aumento en la demanda de crédito comercial, políticas monetarias favorables y estabilidad económica en el sector financiero. En conclusión, la cartera comercial ha seguido una trayectoria ascendente con pequeñas fluctuaciones, lo que refleja una evolución positiva dentro del período analizado.
1d. ¿Cuál de los tipos de tendencia básicos se ajusta mejor dentro del análisis de los anteriores componentes? y ¿En que se basa su apreciación?
# Leer los datos
data <- read_excel("Cartera comercial 2.0.xlsx")
# Limpiar la columna de cartera y convertir fechas
data <- data %>%
mutate(`Cartera comercial en moneda legal, mensual` = str_replace_all(`Cartera comercial en moneda legal, mensual`, "[^0-9.-]", "")) %>%
mutate(`Cartera comercial en moneda legal, mensual` = as.numeric(`Cartera comercial en moneda legal, mensual`),
Fecha = as.Date(Fecha)) %>%
arrange(Fecha) # Asegurar que los datos estén ordenados
# Ajustar modelos
modelo_lineal <- lm(`Cartera comercial en moneda legal, mensual` ~ as.numeric(Fecha), data = data)
modelo_cuadratico <- lm(`Cartera comercial en moneda legal, mensual` ~ poly(as.numeric(Fecha), 2), data = data)
modelo_exponencial <- lm(log(`Cartera comercial en moneda legal, mensual`) ~ as.numeric(Fecha), data = data)
# Crear gráfico con las diferentes tendencias
ggplot(data, aes(x = Fecha, y = `Cartera comercial en moneda legal, mensual`)) +
geom_line(color = "blue", linewidth = 1) + # Serie original
geom_smooth(method = "lm", formula = y ~ x, color = "red", linetype = "dashed", se = FALSE) + # Lineal
geom_smooth(method = "lm", formula = y ~ poly(x, 2), color = "green", linetype = "dotted", se = FALSE) + # Cuadrática
geom_smooth(method = "lm", formula = y ~ x, mapping = aes(y = exp(fitted(modelo_exponencial))), color = "purple", linetype = "dotdash", se = FALSE) + # Exponencial
theme_minimal() +
labs(
title = "Comparación de Modelos de Tendencia",
subtitle = "Rojo: Lineal | Verde: Cuadrática | Morado: Exponencial",
x = "Fecha",
y = "Monto de Cartera"
)
### Para identificar qué tipo de tendencia se ajusta mejor a la serie de
cartera comercial, se han probado tres modelos distintos: el modelo
lineal, representado en rojo, que supone un crecimiento constante; el
modelo cuadrático, en verde, que permite capturar posibles aceleraciones
o desaceleraciones en la evolución de la serie; y el modelo exponencial,
en morado, que evalúa si la cartera comercial crece de manera
multiplicativa en lugar de aditiva. Al analizar los resultados, se
observa que el modelo lineal es el que mejor representa la evolución de
la cartera comercial, ya que describe un crecimiento constante sin
grandes variaciones. Aunque el modelo cuadrático captura una leve
curvatura en la serie, no hay evidencia suficiente para concluir que el
crecimiento de la cartera comercial se está acelerando o desacelerando
significativamente. Por otro lado, el modelo exponencial no se ajusta
adecuadamente a los datos, lo que indica que el crecimiento de la
cartera no ha sido explosivo. En base a estos hallazgos, se concluye que
la tendencia lineal es la que mejor describe la evolución de la cartera
comercial, reflejando un comportamiento estable y predecible que
facilita la planificación y la toma de decisiones en el sector
financiero.
1e. Desestacionalice la serie y establezca un comparativo entre la original y la desestacionalizada.
# Verificar nombres de columnas y seleccionar la correcta
nombre_columna <- colnames(data_clean)[2]
# Convertir la serie en objeto de tiempo (ts)
serie_ts <- ts(data_clean[[nombre_columna]], start = c(2002, 1), frequency = 12)
# Descomponer la serie y obtener la versión desestacionalizada
descomposicion <- decompose(serie_ts, type = "multiplicative")
serie_desest <- as.numeric(serie_ts / descomposicion$seasonal) # Convertir a numérico
# Crear un dataframe con ambas series
data_grafico <- data.frame(Fecha = data_clean$Fecha,
Original = as.numeric(serie_ts), # Convertir a numérico
Desestacionalizada = serie_desest)
# Graficar serie original vs. desestacionalizada
ggplot(data_grafico, aes(x = Fecha)) +
geom_line(aes(y = Original, color = "Original"), size = 1) +
geom_line(aes(y = Desestacionalizada, color = "Desestacionalizada"), size = 1, linetype = "dashed") +
scale_color_manual(values = c("Original" = "blue", "Desestacionalizada" = "red")) +
labs(title = "Serie Original vs Desestacionalizada", x = "Fecha", y = "Monto de Cartera") +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
La desestacionalización de la serie de cartera comercial se realizó con el objetivo de eliminar fluctuaciones periódicas y obtener una visión más clara de la tendencia subyacente. Al comparar la serie original con la desestacionalizada, se pueden identificar diferencias significativas. En primer lugar, la serie desestacionalizada se muestra más estable y suave en comparación con la original, lo que indica que los efectos estacionales han sido eliminados de manera efectiva. A pesar de la eliminación de la estacionalidad, la tendencia general sigue siendo creciente, lo que confirma que el crecimiento de la cartera comercial no se debe únicamente a fluctuaciones estacionales, sino a factores estructurales del mercado financiero. La reducción de la variabilidad en la serie desestacionalizada permite observar de manera más precisa el comportamiento de la cartera comercial a largo plazo, facilitando la toma de decisiones estratégicas. En conclusión, la desestacionalización ha permitido obtener una representación más clara y precisa del comportamiento de la cartera comercial, eliminando distorsiones estacionales y resaltando su tendencia de crecimiento sostenido.
Problema 2: Media y Varianza
2a. Establezca el valor esperado o media E(X) E(Y) y , ademas de la varianza var(X) var(Y) y para cada una de las anteriores series.
knitr::include_graphics("Ejercicio 2a.jpeg")
knitr::include_graphics("Ejercicio 2a.2.jpeg")
2b. Para las siguientes ecuaciones encuentre la media y la varianza (hagalo de forma manual) y luego opcional en R:
knitr::include_graphics("Ejercicio 2b.jpeg")
Problema 3: Aprenda de Máxima verosimilitud
3a. Plantee la función de máxima verosimilitud en términos logarítmicos y halle el parámetro (estimador) de (β0) de la función:
knitr::include_graphics("Ejercicio 3a.jpeg")
3b. Cuál viene a ser el resultado del parámetro de β1? (demuestrelo y explique cada paso de la ecuación)
knitr::include_graphics("Ejercicio 3b.jpeg")
knitr::include_graphics("Ejercicio 3b.2.jpeg")
Problema 4: Empalme
4.a Muestre las graficas de ambas series
# Definir la ruta del archivo
ruta_archivo <- "PIB Cad Constantes 2017.xlsx"
# Leer los datos del PIB
datos_2000 <- read_excel(ruta_archivo, range = "C4:N4", col_names = FALSE)## New names:
## • `` -> `...1`
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`datos_2019 <- read_excel(ruta_archivo, range = "C9:N9", col_names = FALSE)## New names:
## • `` -> `...1`
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`# Nombres de los meses en orden correcto
meses <- c("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio",
"Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
# Convertir datos en formato estructurado
df_2000 <- data.frame(Año = 2000, Mes = factor(meses, levels = meses), PIB = as.numeric(gsub(",", "", as.character(datos_2000[1,]))))
df_2019 <- data.frame(Año = 2019, Mes = factor(meses, levels = meses), PIB = as.numeric(gsub(",", "", as.character(datos_2019[1,]))))
# Unir los datos en un solo dataframe
df_pib <- bind_rows(df_2000, df_2019)
# Gráfico de la serie de 2000
ggplot(df_2000, aes(x = Mes, y = PIB, group = 1)) +
geom_line(color = "blue", size = 1) +
geom_point(color = "blue", size = 2) +
theme_minimal() +
labs(title = "PIB 2000 a precios constantes 2017", x = "Mes", y = "PIB") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Gráfico de la serie de 2019
ggplot(df_2019, aes(x = Mes, y = PIB, group = 1)) +
geom_line(color = "red", size = 1) +
geom_point(color = "red", size = 2) +
theme_minimal() +
labs(title = "PIB 2019 a precios constantes 2017", x = "Mes", y = "PIB") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Gráfico combinado de ambas series
ggplot(df_pib, aes(x = Mes, y = PIB, color = as.factor(Año), group = Año)) +
geom_line(size = 1) +
geom_point(size = 2) +
theme_minimal() +
labs(title = "Comparación del PIB 2000 vs 2019", x = "Mes", y = "PIB", color = "Año") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
En la primera gráfica, que compara el PIB de Canadá en 2000 y 2019 utilizando la misma escala, se observa una diferencia significativa en los niveles absolutos, con valores notablemente más altos en 2019. A lo largo del año, el PIB de 2019 presenta una pendiente más pronunciada que la de 2000, lo que sugiere un crecimiento económico más acelerado. A pesar de la diferencia en magnitud, ambas series exhiben un patrón similar en términos de estacionalidad, con una tendencia creciente en los últimos meses del año, lo que indica que los ciclos económicos han mantenido cierta estabilidad estructural a lo largo del tiempo.
###En la segunda gráfica, que muestra exclusivamente el PIB de 2019 a precios constantes de 2017, se evidencia un crecimiento estable a lo largo del año, con una ligera caída en febrero y un incremento sostenido desde marzo hasta diciembre. La aceleración del crecimiento en la segunda mitad del año puede estar asociada a un mayor dinamismo en la actividad económica, posiblemente impulsado por sectores clave como el comercio y la industria. El aumento más notable se registra en diciembre, lo que sugiere un impacto positivo del consumo de fin de año en el desempeño económico del país.
###En la tercera gráfica, que representa el PIB de 2000 a precios constantes de 2017, se observa una tendencia de crecimiento moderada y estable, aunque con algunas variaciones menores en ciertos meses. En particular, abril presenta una leve disminución respecto a marzo, seguida de una recuperación progresiva en los meses siguientes. La pendiente del crecimiento es menos pronunciada que en 2019, lo que indica que la economía canadiense en el año 2000 experimentaba una expansión más pausada en comparación con casi dos décadas después.
4.b Demuestre que logran empalmar en un perido adecuado. Diga en que periodo lo logra o consigue.
# Asegurar que las columnas de ambos dataframes sean iguales
colnames(df_2000) <- c("Año", "Mes", "PIB")
colnames(df_2019) <- c("Año", "Mes", "PIB")
# Fusionar los datos asegurando que "Mes" sea la clave correcta
data_empalme <- merge(df_2000, df_2019, by = "Mes", suffixes = c("_2000", "_2019"))
# Calcular la diferencia relativa
data_empalme$diferencia_relativa <- abs(data_empalme$PIB_2000 - data_empalme$PIB_2019) / data_empalme$PIB_2019 * 100
# Ver los valores de diferencia
print(data_empalme)## Mes Año_2000 PIB_2000 Año_2019 PIB_2019 diferencia_relativa
## 1 Abril 2000 1414301 2019 2082057 32.07194
## 2 Agosto 2000 1443349 2019 2096045 31.13941
## 3 Diciembre 2000 1450462 2019 2104915 31.09166
## 4 Enero 2000 1399166 2019 2066857 32.30465
## 5 Febrero 2000 1401030 2019 2061643 32.04304
## 6 Julio 2000 1435970 2019 2097348 31.53401
## 7 Junio 2000 1430283 2019 2097348 31.80517
## 8 Marzo 2000 1415390 2019 2073524 31.73988
## 9 Mayo 2000 1424798 2019 2090257 31.83623
## 10 Noviembre 2000 1448834 2019 2103255 31.11468
## 11 Octubre 2000 1448141 2019 2102201 31.11310
## 12 Septiembre 2000 1445049 2019 2099629 31.17598# Identificar el mes con la menor diferencia relativa
periodo_empalme <- data_empalme$Mes[which.min(data_empalme$diferencia_relativa)]
cat("El empalme se logra en el mes de:", periodo_empalme,
"con una diferencia relativa de", min(data_empalme$diferencia_relativa), "%")## El empalme se logra en el mes de: 12 con una diferencia relativa de 31.09166 %library(ggplot2)
ggplot(data_empalme, aes(x = Mes, y = 1, fill = diferencia_relativa)) +
geom_tile(color = "white") +
scale_fill_gradient(low = "blue", high = "red") +
theme_minimal() +
labs(title = "Diferencia Relativa entre PIB 2000 y 2019",
x = "Mes", y = "", fill = "Diferencia %") +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
panel.grid = element_blank())
library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutfig <- plot_ly(data_empalme, x = ~Mes, y = ~PIB_2000, z = ~diferencia_relativa, type = "scatter3d", mode = "lines+markers", name = "PIB 2000") %>%
add_trace(y = ~PIB_2019, name = "PIB 2019") %>%
layout(title = "Empalme PIB en 3D",
scene = list(xaxis = list(title = "Mes"),
yaxis = list(title = "PIB"),
zaxis = list(title = "Diferencia Relativa")))
figLa gráfica de diferencias relativas entre el PIB de 2000 y 2019 muestra una variación mensual que oscila entre aproximadamente 31.1% y 32.3%. Aunque las diferencias entre los meses no son extremadamente marcadas, sí evidencian ciertos patrones en la evolución del crecimiento económico a lo largo del año. Este comportamiento sugiere que el PIB no ha crecido de manera completamente uniforme, sino que ha estado sujeto a fluctuaciones que pueden estar relacionadas con factores estacionales o estructurales de la economía.Los meses de enero y abril presentan las diferencias relativas más altas, lo que indica que el crecimiento del PIB en estos meses fue mayor en comparación con el año 2000. Este patrón podría deberse a la reactivación económica que suele ocurrir a comienzos de año o a políticas económicas implementadas en el primer trimestre que incentivaron la actividad productiva. En contraste, los meses de septiembre, octubre y diciembre exhiben las diferencias más bajas, lo que sugiere un crecimiento más moderado en comparación con el resto del año. En el caso de diciembre, a pesar del aumento del consumo propio de la temporada de fiestas, algunos sectores pueden no haber crecido al mismo ritmo que en otros periodos, lo que podría explicar su menor diferencia relativa.El uso de colores en la gráfica, con tonos rojos para representar las diferencias más altas y tonos azules para las más bajas, facilita la interpretación visual de los datos. Esta estrategia permite identificar de manera intuitiva los meses con mayor y menor crecimiento relativo sin necesidad de analizar los valores numéricos en detalle. De este modo, la gráfica se convierte en una herramienta útil para comprender cómo ha evolucionado la actividad económica a lo largo del año y qué meses han sido más dinámicos en términos de crecimiento del PIB.
En términos generales, la gráfica refleja que la evolución del PIB no ha seguido un patrón completamente estable, sino que ha estado influenciada por variaciones mensuales que pueden deberse a factores estacionales, cambios en la demanda agregada o políticas económicas específicas. Estas diferencias, aunque no drásticas, muestran la importancia de analizar la evolución económica desde una perspectiva temporal detallada para comprender mejor los ciclos y tendencias del crecimiento.
Problema 5 Su serie
5.a Establecer una descripción de la serie de tiempo y mencionar la motivación que lo/a llevó a elegir dicha serie.
La serie que hemos seleccionado para este trabajo es “Cartera hipotecaria ajustada en moneda legal, mensual Unidad: Miles de millones COP”. Esta serie de tiempo registra el valor total, en pesos colombianos, de los créditos hipotecarios otorgados por las entidades financieras en Colombia, al cierre de cada mes. Representa el saldo pendiente de pago de los créditos destinados a la adquisición de vivienda. Este es un indicador clave de la actividad del mercado de crédito hipotecario y, por extensión, del sector inmobiliario en Colombia y los datos que utilizaremos provienen del Banco de la República de Colombia. De manera análoga, los datos reflejan la demanda de financiamiento para vivienda y la confianza de los consumidores y las entidades financieras en el mercado inmobiliario. Nuestra motivación para elegir esta serie de tiempo radica en su capacidad para ofrecer una visión detallada de la salud del mercado inmobiliario colombiano, un sector crucial para la economía del país. Asimismo, creemos que nuestro trabajo contribuirá a una perspectiva valiosa sobre las estrategias económicas que podrían ser relevantes para Colombia e identificar patrones que revelen cómo las fluctuaciones en la cartera hipotecaria responden a cambios en las políticas económicas, utilizando todas las herramientas que hemos visto en clase para finalmente hacer un pronostico acertado y eficiente.
5.b Hacer una descomposición de la serie a partir de lo estacional. Muestre los gráficos de eso.
# Definir la ruta del archivo
ruta_archivo <- "Cartera hipotecaria ajustada en moneda legal, mensual(Dato fin de mes).xlsx"
# Leer los datos desde el archivo Excel
datos <- read_excel(ruta_archivo)
# Verificar los nombres de las columnas (opcional)
print(colnames(datos))## [1] "Fecha"
## [2] "Cartera hipotecaria ajustada en moneda legal, mensual(Dato fin de mes)"# Convertir la segunda columna (IPC) a numérico, eliminando comas
datos$Valor <- as.numeric(gsub(",", "", as.character(datos[[2]])))## Warning: NAs introduced by coercion# Convertir la columna 'Fecha' a formato Date, especificando el formato (ajústalo si es necesario)
datos$Fecha <- as.Date(datos$Fecha, format = "%d/%m/%Y")
# Eliminar filas con valores NA
datos <- na.omit(datos)
# Definir el año y mes de inicio a partir de la columna Fecha
start_year <- as.numeric(format(min(datos$Fecha), "%Y"))
start_month <- as.numeric(format(min(datos$Fecha), "%m"))
# Convertir los datos en una serie de tiempo mensual (frequency = 12)
ts_data <- ts(datos$Valor, start = c(start_year, start_month), frequency = 12)
# Aplicar la descomposición STL para extraer tendencia, estacionalidad y residuo
modelo_stl <- stl(ts_data, s.window = "periodic")
# Graficar la descomposición STL usando autoplot del paquete forecast
autoplot(modelo_stl) +
ggtitle("Descomposición STL de la Cartera Hipotecaria") +
xlab("Año") +
ylab("Miles de millones COP")
La gráfica de la descomposición STL muestra que la serie original de la cartera hipotecaria crece de forma continua a lo largo del período, lo que indica una demanda sostenida de créditos para la adquisición de vivienda y un mercado inmobiliario en expansión. La línea de tendencia, extraída a partir de la serie original, confirma este crecimiento de largo plazo, reflejando un impulso constante en el sector hipotecario, posiblemente debido a mayores facilidades de financiamiento y políticas económicas favorables.El componente estacional revela un patrón cíclico que se repite cada año, mostrando subidas y bajadas regulares. Esto sugiere que existen momentos específicos del año en los que la demanda de créditos se intensifica, lo cual podría estar relacionado con promociones bancarias, variaciones en el poder adquisitivo de los hogares o cambios estacionales en la actividad económica. La regularidad de este patrón permite anticipar periodos de mayor actividad en el mercado de crédito hipotecario.Por último, el residuo, que agrupa las variaciones no explicadas por la tendencia ni por la estacionalidad, presenta fluctuaciones moderadas. Esto indica que, pese a la presencia de choques o eventos puntuales, la estructura subyacente de crecimiento se mantiene robusta. En conjunto, la descomposición STL evidencia un crecimiento sostenido de la cartera hipotecaria, complementado por ciclos estacionales predecibles, lo que aporta información valiosa para la toma de decisiones y la planificación de estrategias en el sector inmobiliario.
5.c Si por tendencia se tratara intente de retirarle la tendencia. Qué ocurre con su serie? plantee su gráfico respectivo
# --------------------------------------------------------------------------------
# 1) Supongamos que ya tienes tu serie de tiempo mensual en 'ts_data'.
# Ejemplo de creación de la serie (ajusta según tus datos reales):
# datos <- read_excel("Cartera_hipotecaria_mensual.xlsx")
# datos$Valor <- as.numeric(gsub(",", "", as.character(datos[[2]])))
# datos$Fecha <- as.Date(datos$Fecha, format = "%d/%m/%Y")
# datos <- na.omit(datos)
# start_year <- as.numeric(format(min(datos$Fecha), "%Y"))
# start_month <- as.numeric(format(min(datos$Fecha), "%m"))
# ts_data <- ts(datos$Valor, start = c(start_year, start_month), frequency = 12)
# --------------------------------------------------------------------------------
# 2) Detrending con un modelo lineal
tiempo <- time(ts_data)
modelo_lin <- lm(ts_data ~ tiempo)
tendencia_lineal <- modelo_lin$fitted.values
serie_detrendida_lineal <- ts_data - tendencia_lineal
# --------------------------------------------------------------------------------
# 3) Detrending con la tendencia extraída mediante STL
stl_decomp <- stl(ts_data, s.window = "periodic")
tendencia_stl <- stl_decomp$time.series[, "trend"]
serie_detrendida_stl <- ts_data - tendencia_stl
# --------------------------------------------------------------------------------
# 4) Crear un dataframe para graficar todo junto
df_plot <- data.frame(
Tiempo = as.numeric(tiempo),
Original = as.numeric(ts_data),
Detrendida_Lineal = as.numeric(serie_detrendida_lineal),
Detrendida_STL = as.numeric(serie_detrendida_stl)
)
# --------------------------------------------------------------------------------
# 5) Gráfico de la Serie Original
plot_original <- ggplot(df_plot, aes(x = Tiempo, y = Original)) +
geom_line(color = "#377eb8", linewidth = 1.2) + # Azul
labs(
title = "Serie Original",
x = "Tiempo",
y = "Valor"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", color = "#377eb8", size = 14),
axis.title = element_text(face = "bold", size = 12),
axis.text = element_text(size = 10)
)
# --------------------------------------------------------------------------------
# 6) Gráfico de la Serie Detrendida (Lineal)
plot_lineal <- ggplot(df_plot, aes(x = Tiempo, y = Detrendida_Lineal)) +
geom_line(color = "#e41a1c", linewidth = 1.2) + # Rojo
labs(
title = "Serie Detrendida (Lineal)",
x = "Tiempo",
y = "Valor Detrendido"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", color = "#e41a1c", size = 14),
axis.title = element_text(face = "bold", size = 12),
axis.text = element_text(size = 10)
)
# --------------------------------------------------------------------------------
# 7) Gráfico de la Serie Detrendida (STL)
plot_stl <- ggplot(df_plot, aes(x = Tiempo, y = Detrendida_STL)) +
geom_line(color = "#4daf4a", linewidth = 1.2) + # Verde
labs(
title = "Serie Detrendida (STL)",
x = "Tiempo",
y = "Valor Detrendido"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", color = "#4daf4a", size = 14),
axis.title = element_text(face = "bold", size = 12),
axis.text = element_text(size = 10)
)
# --------------------------------------------------------------------------------
# 8) Mostrar los tres gráficos por separado
print(plot_original)
print(plot_lineal)
print(plot_stl)
La serie original presenta un crecimiento marcado a lo largo del tiempo, con un ritmo que se intensifica de manera notable después de la década de 2010. Este patrón sugiere que la evolución de la cartera hipotecaria no se limita a una simple pendiente, sino que incorpora un componente de crecimiento más complejo. El fuerte aumento hacia los años más recientes puede asociarse a un entorno económico que favorece la demanda de créditos para vivienda, lo cual se refleja en el ascenso sostenido de los valores observados en la gráfica.La serie detrendida por el método lineal, en cambio, exhibe una curva en forma de “U”, lo que revela que la pendiente constante no consigue capturar la verdadera dinámica del crecimiento. En la parte central de la serie, el valor se sitúa por debajo de cero, mientras que en los extremos se ubica por encima de cero. Esto indica que el modelo lineal subestima la serie en los periodos de mayor crecimiento y la sobrestima en los periodos iniciales y finales. Desde una perspectiva práctica, este resultado muestra que un modelo lineal deja un remanente con variaciones de largo plazo, por lo que no es del todo adecuado para aislar las fluctuaciones de corto plazo o los ciclos más sutiles.La serie detrendida con el método de extracción de tendencia mediante STL, por otro lado, genera un residuo que se mantiene en valores cercanos a cero y cuyas oscilaciones, aunque presentes, no exhiben la fuerte curvatura observada en la versión lineal. Al capturar mejor la forma no lineal del crecimiento, este método deja un remanente que refleja más fielmente los movimientos de corto plazo, ciclos estacionales o choques específicos. La comparación entre ambas aproximaciones pone de manifiesto que, cuando la serie presenta un crecimiento intenso y no lineal, la recta ajustada con un modelo lineal deja un residuo amplio, mientras que una técnica más flexible como STL consigue aislar la tendencia de manera más eficaz.
5.d Halle la predicción de los próximos 3 periodos a acontecer. Aplique las técnicas de media móvil, Box-Cox, Holt-winters y finalmente ETS. Cuál predice mejor? (Puede crear una tabla y hacer comparativos).
###############################################################################
# 1) Cargar librerías y preparar la serie de tiempo
###############################################################################
library(forecast)
library(ggplot2)
library(dplyr)
library(gridExtra)##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combinelibrary(knitr)
# Ejemplo de creación de la serie de tiempo 'ts_data' (ajusta según tus datos):
# library(readxl)
# datos <- read_excel("Cartera_hipotecaria_mensual.xlsx")
# datos$Valor <- as.numeric(gsub(",", "", as.character(datos[[2]])))
# datos$Fecha <- as.Date(datos$Fecha, format = "%d/%m/%Y")
# datos <- na.omit(datos)
# start_year <- as.numeric(format(min(datos$Fecha), "%Y"))
# start_month <- as.numeric(format(min(datos$Fecha), "%m"))
# ts_data <- ts(datos$Valor, start = c(start_year, start_month), frequency = 12)
###############################################################################
# Función auxiliar para la siguiente observación (inicio pronóstico)
###############################################################################
next_start <- function(end_val, freq = 12) {
year <- end_val[1]
period <- end_val[2] + 1
if (period > freq) {
period <- 1
year <- year + 1
}
c(year, period)
}
###############################################################################
# 2) Definir límites para el zoom
###############################################################################
zoom_start <- 2023.0
zoom_end <- 2025.2
# También definimos un rango vertical de ejemplo (ajusta según tus datos)
zoom_ylim <- c(90, 120) # Cambia estos valores según tu escala
###############################################################################
# 3) Función para autoplot con estilo y la opción de xlim/ylim
###############################################################################
plot_forecast <- function(fc, titulo, xlim = NULL, ylim = NULL) {
p <- autoplot(fc, PI = TRUE, alpha = 0.2, shadecols = c("grey80","grey60")) +
labs(title = titulo, x = "Año", y = "Valor") +
theme_minimal(base_size = 14) +
theme(
legend.position = "right",
plot.title = element_text(
size = 14,
face = "bold",
margin = margin(b = 10)
),
plot.margin = margin(10, 10, 10, 10)
) +
scale_color_manual(
name = "",
values = c("black", "black", "grey60", "grey80", "grey60", "grey80"),
breaks = c("Data","Point Forecast","Lo 80","Lo 95","Hi 80","Hi 95"),
labels = c("Observed", "Forecasted", "80% confidence", "95% confidence", "80% confidence", "95% confidence")
) +
scale_fill_manual(
name = "",
values = c("grey60","grey80"),
breaks = c("80%","95%"),
labels = c("80% confidence","95% confidence")
)
# Ajustar rangos si se definen xlim/ylim
if(!is.null(xlim) || !is.null(ylim)) {
p <- p + coord_cartesian(xlim = xlim, ylim = ylim)
}
p
}
###############################################################################
# 4) Pronóstico con Media Móvil (3 últimos valores) + intervalos manuales
###############################################################################
ma_value <- mean(tail(ts_data, 3))
fc_points <- rep(ma_value, 3)
stdev_ma <- sd(tail(ts_data, 3))
alpha80 <- qnorm(0.90)
alpha95 <- qnorm(0.975)
lower80 <- fc_points - alpha80 * stdev_ma
upper80 <- fc_points + alpha80 * stdev_ma
lower95 <- fc_points - alpha95 * stdev_ma
upper95 <- fc_points + alpha95 * stdev_ma
end_val <- end(ts_data)
fc_start <- next_start(end_val, frequency(ts_data))
ma_forecast_ts <- ts(fc_points, start = fc_start, frequency = frequency(ts_data))
fc_ma <- structure(
list(
method = "Media Móvil (3 últimos)",
mean = ma_forecast_ts,
level = c(80, 95),
lower = cbind(
`80%` = ts(lower80, start = fc_start, frequency = frequency(ts_data)),
`95%` = ts(lower95, start = fc_start, frequency = frequency(ts_data))
),
upper = cbind(
`80%` = ts(upper80, start = fc_start, frequency = frequency(ts_data)),
`95%` = ts(upper95, start = fc_start, frequency = frequency(ts_data))
),
x = ts_data,
fitted = fitted(ets(ts_data)),
residuals = residuals(ets(ts_data))
),
class = "forecast"
)
plot_ma_all <- plot_forecast(fc_ma, "Pronóstico Media Móvil (Completo)")## Warning: The `schadecols` argument is deprecated for time series forecasts.
## Interval shading is now done automatically based on the level and `fcol`.plot_ma_zoom <- plot_forecast(fc_ma, "Pronóstico Media Móvil (Zoom)", xlim = c(zoom_start, zoom_end), ylim = zoom_ylim)## Warning: The `schadecols` argument is deprecated for time series forecasts.
## Interval shading is now done automatically based on the level and `fcol`.###############################################################################
# 5) ETS con Box‑Cox
###############################################################################
lambda <- BoxCox.lambda(ts_data)
ets_boxcox_model <- ets(ts_data, lambda = lambda)
forecast_boxcox <- forecast(ets_boxcox_model, h = 3)
plot_boxcox_all <- plot_forecast(forecast_boxcox, "Pronóstico ETS (Box‑Cox) Completo")## Warning: The `schadecols` argument is deprecated for time series forecasts.
## Interval shading is now done automatically based on the level and `fcol`.plot_boxcox_zoom <- plot_forecast(forecast_boxcox, "Pronóstico ETS (Box‑Cox) Zoom",
xlim = c(zoom_start, zoom_end), ylim = zoom_ylim)## Warning: The `schadecols` argument is deprecated for time series forecasts.
## Interval shading is now done automatically based on the level and `fcol`.###############################################################################
# 6) Holt‑Winters
###############################################################################
hw_model <- HoltWinters(ts_data)
forecast_hw <- forecast(hw_model, h = 3)
plot_hw_all <- plot_forecast(forecast_hw, "Pronóstico Holt‑Winters Completo")## Warning: The `schadecols` argument is deprecated for time series forecasts.
## Interval shading is now done automatically based on the level and `fcol`.plot_hw_zoom <- plot_forecast(forecast_hw, "Pronóstico Holt‑Winters Zoom",
xlim = c(zoom_start, zoom_end), ylim = zoom_ylim)## Warning: The `schadecols` argument is deprecated for time series forecasts.
## Interval shading is now done automatically based on the level and `fcol`.###############################################################################
# 7) ETS Clásico (sin Box‑Cox)
###############################################################################
ets_model <- ets(ts_data)
forecast_ets <- forecast(ets_model, h = 3)
plot_ets_all <- plot_forecast(forecast_ets, "Pronóstico ETS (Clásico) Completo")## Warning: The `schadecols` argument is deprecated for time series forecasts.
## Interval shading is now done automatically based on the level and `fcol`.plot_ets_zoom <- plot_forecast(forecast_ets, "Pronóstico ETS (Clásico) Zoom",
xlim = c(zoom_start, zoom_end), ylim = zoom_ylim)## Warning: The `schadecols` argument is deprecated for time series forecasts.
## Interval shading is now done automatically based on the level and `fcol`.###############################################################################
# 8) Tabla comparativa de predicciones puntuales
###############################################################################
pred_table <- data.frame(
Periodo = 1:3,
MediaMovil = round(fc_points, 2),
BoxCox_ETS = round(as.numeric(forecast_boxcox$mean), 2),
HoltWinters = round(as.numeric(forecast_hw$mean), 2),
ETS = round(as.numeric(forecast_ets$mean), 2)
)
kable(pred_table, caption = "Comparación de Predicciones Puntuales para los Próximos 3 Períodos")| Periodo | MediaMovil | BoxCox_ETS | HoltWinters | ETS |
|---|---|---|---|---|
| 1 | 112.68 | 114.62 | 114.72 | 114.61 |
| 2 | 112.68 | 115.59 | 115.77 | 115.57 |
| 3 | 112.68 | 116.58 | 116.87 | 116.54 |
###############################################################################
# 9) Mostrar gráficos (Completo y Zoom) para cada método
###############################################################################
grid.arrange(plot_ma_all, plot_ma_zoom, ncol = 2)
grid.arrange(plot_boxcox_all, plot_boxcox_zoom, ncol = 2)
grid.arrange(plot_hw_all, plot_hw_zoom, ncol = 2)
grid.arrange(plot_ets_all, plot_ets_zoom, ncol = 2)