1. pronostico (Arturo- Shirly)
2024-08-12
library(readxl)
indice_de_precios_de_vivienda_nueva_colombia <- read_excel("indice_de_precios_de_vivienda_nueva_colombia.xlsx")
bsd2 <- read_excel("indice_de_precios_de_vivienda_nueva_colombia.xlsx")
head(bsd2)## # A tibble: 6 × 6
## fecha bogota bogota_alred medellin cali agregado
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2004-01-01 00:00:00 80.8 88.4 93.9 89.7 86.8
## 2 2004-02-01 00:00:00 80.7 87.5 91.5 90.4 86
## 3 2004-03-01 00:00:00 80.2 87.1 90.9 91.4 85.6
## 4 2004-04-01 00:00:00 80.4 86.4 91.9 91.5 86.2
## 5 2004-05-01 00:00:00 80 86 91.1 92.3 85.7
## 6 2004-06-01 00:00:00 79.4 85 90.6 92.7 85.2install.packages("pacman")## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)library(pacman)
p_load(fpp2, dynlm, huxtable)install.packages("tidyverse")## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)library(readxl)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::add_rownames() masks huxtable::add_rownames()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ huxtable::theme_grey() masks ggplot2::theme_grey()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(fpp2)datose <- read_excel("indice_de_precios_de_vivienda_nueva_colombia.xlsx")
datos <- datose$bogota
bsd2 <- ts(datos, start = c(2004, 1), frequency = 12)
bsd2## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2004 80.8 80.7 80.2 80.4 80.0 79.4 80.9 81.1 81.8 82.7 83.0 83.2
## 2005 84.0 83.7 83.8 83.8 83.6 83.9 84.2 85.7 86.2 86.9 87.9 87.4
## 2006 88.1 88.6 89.4 89.4 91.0 92.7 93.6 94.7 94.9 96.9 99.4 100.0
## 2007 101.0 101.5 101.6 102.4 104.1 106.1 105.9 106.2 107.1 109.3 110.6 111.5
## 2008 110.9 110.4 110.4 110.3 110.5 110.3 109.6 110.1 111.7 112.2 113.5 113.4
## 2009 113.4 113.2 113.3 113.1 114.0 114.5 115.0 116.8 117.9 119.1 119.7 120.4
## 2010 120.9 121.5 122.4 123.2 123.7 125.2 126.0 126.0 128.5 129.6 131.1 131.3
## 2011 133.4 133.8 134.8 136.7 137.9 138.9 139.3 140.1 142.2 143.5 144.4 145.0
## 2012 144.3 145.8 149.1 150.6 152.9 153.7 155.7 158.0 159.6 161.7 163.1 165.3
## 2013 166.3 166.8 168.4 167.9 169.3 170.3 172.0 173.5 172.8 175.6 178.8 179.3
## 2014 179.6 179.9 181.0 181.2 180.8 182.0 183.0 183.1 184.0 184.3 185.2 185.3
## 2015 185.9 184.8 185.4 184.6 184.6 185.0 185.8 186.5 186.0 186.5 186.5 187.0
## 2016 184.7 182.3 180.9 181.8 181.1 181.9 182.7 185.2 186.7 187.5 189.3 189.9
## 2017 189.1 186.8 187.8 187.4 188.8 189.0 190.6 191.6 192.6 194.3 195.9 196.0
## 2018 195.5 195.9 196.5 196.0 197.3 197.0 199.0 200.3 200.7 201.7 202.2 201.4
## 2019 200.6 199.2 199.4 198.8 199.2 199.5 201.9 201.8 201.4 201.4 203.4 205.2
## 2020 204.6 203.7 204.1 204.9 205.5 207.3 207.6 208.1 206.8 210.2 212.8 214.2
## 2021 214.7 215.7 215.4 215.4 214.8 215.5 217.3 218.0 217.4 220.6 223.3 223.0
## 2022 221.4 219.2 217.0 215.4 215.7 216.4 216.1 214.0 215.1 216.3 216.2 214.1
## 2023 210.0 206.7 205.1 203.6 204.1 205.2 205.7 204.9 204.5 204.2 205.3 205.2
## 2024 203.9 202.8 202.2 202.3 201.7 200.11.Grafico de estacionalidad
ggseasonplot(bsd2, year.labels=TRUE, year.labels.left=TRUE) +
ylab("$ Millones de pesos") +
ggtitle("Gráfico Estacional: Indice de precios de vivienda nueva en Colombia")
Los precios de la vivienda nueva muestran un aumento constante a lo
largo de los años. Hay fluctuaciones estacionales que se repiten cada
año. Generalmente, los precios tienden a ser más altos a mediados de
año. Los precios oscilan entre 80 y 220 millones.
2.Grafico de tendencial
autoplot(bsd2) + ylab("$ Millones de pesos base 2006") + xlab("Años") +
ggtitle("Indice de precios de vivienda nueva de Bogota (IPVNBR) 2004-2024")
Los precios de la vivienda nueva en Bogotá han mostrado un aumento
constante a lo largo de los años, con algunas fluctuaciones. Paso de
estar en 80 millones a 200 millones. El pico mas alto fue en 2021. En
2021, podría haber habido una mayor demanda de viviendas debido a
factores como tasas de interés bajas, programas gubernamentales de
subsidios o cambios en las preferencias de vivienda. O por COVID-19 que
afectó los patrones de comportamiento en la economia. Es posible que
algunos compradores buscaran invertir en vivienda como refugio seguro
durante tiempos inciertos.
3.Ajuste estacional
sea <- stl(bsd2, s.window="per")
autoplot(bsd2, series="Data") +
autolayer(seasadj(sea), series="Ajuste Estacional")
Azul: Representa los precios de vivienda sin ningún ajuste y muestra
fluctuaciones estacionales a lo largo del tiempo. Rojo: Esta línea
suaviza las fluctuaciones estacionales, proporcionando una visión más
clara de la tendencia a largo plazo. Apesar que ambas líneas muestran un
aumento en los precios de vivienda nueva a lo largo del tiempo,la línea
ajustada es más suave y menos volátil.
4. Ciclo y tendencia
autoplot(bsd2, series="Data") +
autolayer(trendcycle(sea), series="Tendencia") +
autolayer(seasadj(sea), series="Ajuste Estacional") +
xlab("Fecha") + ylab("$Millones de pesos") +
ggtitle("Indice de precios de viviendas nuevas en Bogotá") +
scale_colour_manual(values=c("gray","blue","red"),
breaks=c("Data","Ajuste Estacional","Tendencia"))
install.packages("flextable")## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)modelo de regresión lineal solo con tendencia
library(dynlm)
library(huxtable)
datos <- read_excel("indice_de_precios_de_vivienda_nueva_colombia.xlsx")
bsd2 <- ts(datos, start = c(2004, 1), frequency = 12)
m1 <- dynlm(bogota ~ trend(bsd2), data = bsd2)
m2 <- dynlm(bogota ~ trend(bsd2)+I(trend(bsd2)^2), data = bsd2)
m3 <- dynlm(bogota ~ trend(bsd2)+I(trend(bsd2)^2)+I(trend(bsd2)^3), data = bsd2)
m4 <- dynlm(bogota ~ log(trend(bsd2)), data = bsd2)
m5 <- dynlm(bogota ~ I(1/trend(bsd2)), data = bsd2)
huxreg(m1,m2,m3,m4,m5, statistics=c("Observaciones" = "nobs", "R2 Ajustado" = "adj.r.squared"))## Warning: The `tidy()` method for objects of class `dynlm` is not maintained by the broom team, and is only supported through the `lm` tidier method. Please be cautious in interpreting and reporting broom output.
##
## This warning is displayed once per session.| (1) | (2) | (3) | (4) | (5) | |
|---|---|---|---|---|---|
| (Intercept) | 82.613 *** | 62.131 *** | 76.121 *** | 72.068 *** | 165.339 *** |
| (1.499) | (1.431) | (1.375) | (3.000) | (2.845) | |
| trend(bsd2) | 7.495 *** | 13.441 *** | 5.367 *** | ||
| (0.126) | (0.321) | (0.577) | |||
| I(trend(bsd2)^2) | -0.289 *** | 0.690 *** | |||
| (0.015) | (0.065) | ||||
| I(trend(bsd2)^3) | -0.032 *** | ||||
| (0.002) | |||||
| log(trend(bsd2)) | 43.078 *** | ||||
| (1.333) | |||||
| I(1/trend(bsd2)) | -18.841 *** | ||||
| (2.903) | |||||
| Observaciones | 246 | 246 | 246 | 246 | 246 |
| R2 Ajustado | 0.935 | 0.974 | 0.987 | 0.810 | 0.144 |
| *** p < 0.001; ** p < 0.01; * p < 0.05. | |||||
Pronostico con tendecia (modelo)
datos <- read_excel("indice_de_precios_de_vivienda_nueva_colombia.xlsx")
datos <- datos$bogota
bsd2 <- ts(datos, start = c(2004, 1), frequency = 12)
# Tendencia lineal
m.lin <- tslm(bsd2 ~ trend)
p.lin <- forecast(m.lin, h=10)
# Tendencia Exponencial
m.exp <- tslm(bsd2 ~ trend, lambda = 0)
p.exp <- forecast(m.exp, h=10)
# Tendencia Cúbica
m.cub <- tslm(bsd2 ~ trend+trend^2+trend^3)
p.cub <- forecast(m.cub, h=10)Grafico
autoplot(bsd2) +
autolayer(fitted(m.lin), series = "Lineal") +
autolayer(fitted(m.exp), series="Exponencial") +
autolayer(fitted(m.cub), series = "Cúbico") +
autolayer(p.lin$mean, series = "Lineal") +
autolayer(p.exp$mean, series="Exponencial") +
autolayer(p.cub$mean, series="Cúbico") +
xlab("Año") + ylab("$ Millones de pesos") +
ggtitle("Predicción simple") +
guides(colour=guide_legend(title=" "))
Este modelo asume un crecimiento exponencial, lo que significa que los
precios aumentan a una tasa creciente.
Grafico de pronosticos
# Grafico de pronósticos
autoplot(bsd2) +
autolayer(meanf(bsd2, h=11), PI=FALSE, series="Promedio") +
autolayer(naive(bsd2, h=11), PI=FALSE, series="Naïve") +
autolayer(snaive(bsd2, h=11), PI=FALSE, series="Naïve Estacional") +
ggtitle("Pronosticos de precios de vivienda nueva en Bogota ") +
xlab("Fecha") + ylab("$ de millones de pesos") +
guides(colour=guide_legend(title="Pronostico por"))
Naive: Este modelo asume que los precios futuros serán iguales a los
precios actuales, sin cambios. Naive estacional: considera las
fluctuaciones estacionales, pero no muestra una tendencia a largo plazo.
Promedio: Este modelo sigue de cerca los datos históricos y proyecta una
ligera disminución en los precios futuros.
Modelo Box-Cox
l <- (BoxCox.lambda(bsd2))
l## [1] 0.8253378Lambda optimo
autoplot(BoxCox(bsd2,lambda= l))
niv2 <- snaive(bsd2, lambda=0.8225)
autoplot(niv2)
El pronostico sugiere que la tendencia podria mantenerse estable o
disminuir ligeramente pero con una considerable incertidumbre como no
indican las areas sobreadas. El eje Y indica la serie de tiempo
tranformada con box-cox para estabilizar la varianza. Linea negra: datos
historicos Azul son intervalos de confianza del pronostico, la mas clara
muestra mayor incertidumbre.
data30 <- datose[1:30, 2]
data30| bogota |
|---|
| 80.8 |
| 80.7 |
| 80.2 |
| 80.4 |
| 80 |
| 79.4 |
| 80.9 |
| 81.1 |
| 81.8 |
| 82.7 |
| 83 |
| 83.2 |
| 84 |
| 83.7 |
| 83.8 |
| 83.8 |
| 83.6 |
| 83.9 |
| 84.2 |
| 85.7 |
| 86.2 |
| 86.9 |
| 87.9 |
| 87.4 |
| 88.1 |
| 88.6 |
| 89.4 |
| 89.4 |
| 91 |
| 92.7 |
MEDIA MOVIL
# Media móvil simple
n <- 2
stats::filter(data30, rep(1 / n, n), sides = 1)## Time Series:
## Start = 1
## End = 30
## Frequency = 1
## [,1]
## [1,] NA
## [2,] 80.75
## [3,] 80.45
## [4,] 80.30
## [5,] 80.20
## [6,] 79.70
## [7,] 80.15
## [8,] 81.00
## [9,] 81.45
## [10,] 82.25
## [11,] 82.85
## [12,] 83.10
## [13,] 83.60
## [14,] 83.85
## [15,] 83.75
## [16,] 83.80
## [17,] 83.70
## [18,] 83.75
## [19,] 84.05
## [20,] 84.95
## [21,] 85.95
## [22,] 86.55
## [23,] 87.40
## [24,] 87.65
## [25,] 87.75
## [26,] 88.35
## [27,] 89.00
## [28,] 89.40
## [29,] 90.20
## [30,] 91.85Basicamente, aquì esta la media movil de un conjunto de datos. Nos ofrece una visiòn suavizada de las fluctuaciones y cambios en el comportamiento del mercado.
ROLL(ZOO)
library(pacman)
p_load(fpp2, tidyverse, zoo)
prueba<-data30
mutate(prueba, pr_ma01 = rollmean(prueba$bogota, k = 1, fill = NA),
pr_ma02 = rollmean(prueba$bogota, k = 2, fill = NA),
pr_ma03 = rollmean(prueba$bogota, k = 3, fill = NA),
pr_ma04 = rollmean(prueba$bogota, k = 4, fill = NA)) | bogota | pr_ma01 | pr_ma02 | pr_ma03 | pr_ma04 |
|---|---|---|---|---|
| 80.8 | 80.8 | 80.8 | ||
| 80.7 | 80.7 | 80.5 | 80.6 | 80.5 |
| 80.2 | 80.2 | 80.3 | 80.4 | 80.3 |
| 80.4 | 80.4 | 80.2 | 80.2 | 80 |
| 80 | 80 | 79.7 | 79.9 | 80.2 |
| 79.4 | 79.4 | 80.2 | 80.1 | 80.3 |
| 80.9 | 80.9 | 81 | 80.5 | 80.8 |
| 81.1 | 81.1 | 81.5 | 81.3 | 81.6 |
| 81.8 | 81.8 | 82.2 | 81.9 | 82.2 |
| 82.7 | 82.7 | 82.8 | 82.5 | 82.7 |
| 83 | 83 | 83.1 | 83 | 83.2 |
| 83.2 | 83.2 | 83.6 | 83.4 | 83.5 |
| 84 | 84 | 83.8 | 83.6 | 83.7 |
| 83.7 | 83.7 | 83.8 | 83.8 | 83.8 |
| 83.8 | 83.8 | 83.8 | 83.8 | 83.7 |
| 83.8 | 83.8 | 83.7 | 83.7 | 83.8 |
| 83.6 | 83.6 | 83.8 | 83.8 | 83.9 |
| 83.9 | 83.9 | 84 | 83.9 | 84.3 |
| 84.2 | 84.2 | 85 | 84.6 | 85 |
| 85.7 | 85.7 | 86 | 85.4 | 85.8 |
| 86.2 | 86.2 | 86.5 | 86.3 | 86.7 |
| 86.9 | 86.9 | 87.4 | 87 | 87.1 |
| 87.9 | 87.9 | 87.7 | 87.4 | 87.6 |
| 87.4 | 87.4 | 87.8 | 87.8 | 88 |
| 88.1 | 88.1 | 88.3 | 88 | 88.4 |
| 88.6 | 88.6 | 89 | 88.7 | 88.9 |
| 89.4 | 89.4 | 89.4 | 89.1 | 89.6 |
| 89.4 | 89.4 | 90.2 | 89.9 | 90.6 |
| 91 | 91 | 91.8 | 91 | |
| 92.7 | 92.7 |
head(prueba)| bogota |
|---|
| 80.8 |
| 80.7 |
| 80.2 |
| 80.4 |
| 80 |
| 79.4 |
Observando los valores de la media móvil, parece que hay una ligera tendencia a la baja en el índice de precios de viviendas nuevas en Bogotá. Comienza en 80.8 y termina en 79.4.
ORDER
library(pacman)
p_load(fpp2, tidyverse, zoo)
prueba<-data30
prueba|>
mutate(prma01 = ma(prueba$bogota, order=1, centre=FALSE),
prma02 = ma(prueba$bogota, order=2, centre=FALSE),
prma03 = ma(prueba$bogota, order=3, centre=FALSE),
prma04 = ma(prueba$bogota, order=4, centre=FALSE))|>
head()| bogota | prma01 | prma02 | prma03 | prma04 |
|---|---|---|---|---|
| 80.8 | 80.8 | 80.8 | ||
| 80.7 | 80.7 | 80.5 | 80.6 | 80.5 |
| 80.2 | 80.2 | 80.3 | 80.4 | 80.3 |
| 80.4 | 80.4 | 80.2 | 80.2 | 80 |
| 80 | 80 | 79.7 | 79.9 | 80.2 |
| 79.4 | 79.4 | 80.2 | 80.1 | 80.3 |
prma01:Representa una media móvil simple, calculada usando solo el valor actual. prma02:Representa una media móvil de orden 2 (promedio de dos puntos consecutivos). Suaviza ligeramente la serie temporal, eliminando pequeñas fluctuaciones. prma03: Muestra una tendencia más suavizada, con un punto notablemente bajo (79.93333) pero en general sigue la tendencia a la baja. prma04: Suaviza aún más la serie, mostrando fluctuaciones menores y destacando una ligera tendencia al alza hacia el final, con un valor de 80.35.
Media Movil Doble implicita
prueba|>
mutate(pr2ma01 = ma(prueba$bogota, order=1, centre=TRUE),
pr2ma02 = ma(prueba$bogota, order=2, centre=TRUE),
pr2ma03 = ma(prueba$bogota, order=3, centre=TRUE),
pr2ma04 = ma(prueba$bogota, order=4, centre=TRUE))|>
head()| bogota | pr2ma01 | pr2ma02 | pr2ma03 | pr2ma04 |
|---|---|---|---|---|
| 80.8 | 80.8 | |||
| 80.7 | 80.7 | 80.6 | 80.6 | |
| 80.2 | 80.2 | 80.4 | 80.4 | 80.4 |
| 80.4 | 80.4 | 80.2 | 80.2 | 80.2 |
| 80 | 80 | 80 | 79.9 | 80.1 |
| 79.4 | 79.4 | 79.9 | 80.1 | 80.3 |
Aqui se logra ver que los datos estas mas suavizados.
Media movil ponderada
prueba<-c(150,230,345,421,434)
stats::filter(data30$bogota, c(0.25, 0.5, 0.25), sides = 1)## Time Series:
## Start = 1
## End = 30
## Frequency = 1
## [1] NA NA 80.600 80.375 80.250 79.950 79.925 80.575 81.225 81.850
## [11] 82.550 82.975 83.350 83.725 83.800 83.775 83.750 83.725 83.900 84.500
## [21] 85.450 86.250 86.975 87.525 87.700 88.050 88.675 89.200 89.800 91.025Al principio el NA es porque no hay suficientes datos para calcular la media movil ponderada, luego va ascendiendo, hay como unas fluctuaciones pero sigue ascendiendo.
library(pacman)
p_load(readxl, TSstudio, tidyverse, stats, urca, forecast, ggfortify, ggplot2)Ts Studio Grafica
# Para gráficar
ts_plot(bsd2,
title = "Indice de precios de vivienda nueva en Bogotá",
Ytitle = "Millones de Pesos")la gráfica nos dice que el precio de la vivienda nueva en Bogotá experimentó un aumento constante durante varios años, pero hubo una desaceleración o reducción después del 2020.
Descomposicion Ts studio
ts_decompose(bsd2)En la gráfica se observa que los precios promedios mensuales de viviendas nuevas en Bogotá han mostrado una tendencia al alza desde 2005, con un aumento notable hasta aproximadamente 2020, seguido de una ligera disminución. Hay un patrón estacional claro que se repite anualmente, con picos y valles regulares. La componente aleatoria muestra variabilidad en los precios, con fluctuaciones que parecen ser más pronunciadas en ciertos periodos, especialmente después de 2015.
Ts estacional
ts_seasonal(bsd2, type = "normal")En el gráfico de descomposición estacional se observa que los precios promedios mensuales de viviendas nuevas en Bogotá han aumentado de manera sostenida cada año. Cada línea representa un año diferente, mostrando que, aunque hay fluctuaciones estacionales dentro de cada año, la tendencia general ha sido un incremento continuo en los precios. Los valores más bajos se registran en los primeros años (2004-2011), mientras que los valores más altos se observan en los años más recientes (2019-2024). Además, se percibe que la diferencia entre los meses tiende a ser menor en los últimos años, lo que podría indicar una menor variabilidad estacional con el tiempo
3D
ts_surface(bsd2)En la gráfica tridimensional se observa que han habido periodos de 2 a 3 años, donde los precios de la vivenda se estabilizaron, siguiendo con periodos de 2 a 3 años de crecimiento continuo. Se observa un crecimiento continuo desde el año 2008 hasta el año 2015.
Mapa de calor estacional
ts_heatmap(bsd2, color = "Reds")En la gráfica se observa que la región más oscura se ubica entre 2020 y 2022, donde los precios de la viviendo fueron los más altos. Esto puede deberse a la presión que generó la pandemia sobre el mercado imobiliario.
Compración
# Básico
b1<-ts_ma(bsd2, n_left = 6, n = NULL) # ma 7
b1_ma2<-ts_ma(bsd2, n_left = 3, n_right = 3, n=NULL) # ma 7
# Listas
b1_ma7 <- b1$unbalanced_ma_7
b1_ma72 <- b1_ma2$unbalanced_ma_7
# Objeto base
ma <- cbind(bsd2, b1_ma7, b1_ma72)
p <- ts_plot(ma,
Xgrid = TRUE,
Ygrid = TRUE,
type = "single",
title = "MA 7 (un lado) vs. MA 7 (dos lados)")
# Grafico
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':
##
## layout p <- p |> layout(legend = list(x = 0.05, y = 0.95),
yaxis = list(title = "Millones de pesos"),
xaxis = list(title = "Años"))
pEn la gráfica se observa que la serie de tiempo suavizada de dos lados es más cercana a los datos que la de un lado. La de un lado generlmente estima valores menores que los reales.
ProMA7
library(forecast)
carma07 = ma(bsd2, order=7, centre=FALSE)
carma12 = ma(bsd2, order=12, centre=FALSE) # adicional
carma06 = ma(bsd2, order=6, centre=FALSE)
carmad12 = ma(bsd2, order=12, centre=TRUE)
# Generar pronostico de 12 periodos
MA07 <- forecast(carma07, h = 12)## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series# Gráfico
plot_forecast(MA07)En la gráfica se puede observar el pronostico generado por la media movil con 7 periodos de un solo lado. El pronostico muestra claramente con un 80% de confianza que los precios mantendran el decrecimiento que inicio en el 2021.
##ProMA12
# Generar pronostico de 12 periodos centrado
MAd212 <- forecast(carmad12, h = 12)## Warning in ets(object, lambda = lambda, biasadj = biasadj,
## allow.multiplicative.trend = allow.multiplicative.trend, : Missing values
## encountered. Using longest contiguous portion of time series# Gráfico
plot_forecast(MAd212)Modelo doble12
MAd212## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2024 203.4667 203.3393 203.5941 203.2718 203.6616
## Feb 2024 203.1542 202.8694 203.4390 202.7186 203.5898
## Mar 2024 202.8417 202.3653 203.3182 202.1131 203.5704
## Apr 2024 202.5293 201.8321 203.2264 201.4630 203.5955
## May 2024 202.2168 201.2732 203.1604 200.7736 203.6599
## Jun 2024 201.9043 200.6910 203.1176 200.0487 203.7599
## Jul 2024 201.5918 200.0874 203.0962 199.2911 203.8925
## Aug 2024 201.2793 199.4641 203.0946 198.5031 204.0555
## Sep 2024 200.9668 198.8221 203.1116 197.6867 204.2470
## Oct 2024 200.6544 198.1625 203.1462 196.8434 204.4653
## Nov 2024 200.3419 197.4862 203.1975 195.9746 204.7092
## Dec 2024 200.0294 196.7941 203.2647 195.0814 204.9774Nos muestra un pronostico de 12 peridos futuros. Lo 80 y Hi 80: Intervalo de confianza al 80%. Lo 95 y Hi 95: Intervalo de confianza al 95%. El pronóstico puntual muestra una tendencia ligeramente descendente desde enero (203.4667) hasta octubre (200.6544) de 2024. Los intervalos de confianza (especialmente al 95%) son bastante amplios, lo que indica una alta incertidumbre en las predicciones. La anchura de los intervalos de confianza sugiere que, aunque el modelo proporciona una estimación de la tendencia futura, hay una considerable variabilidad e incertidumbre en los datos.
Modelo simple
MA07## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Apr 2024 201.8572 201.5089 202.2055 201.3245 202.3899
## May 2024 201.1144 200.3362 201.8926 199.9243 202.3045
## Jun 2024 200.3716 199.0705 201.6726 198.3818 202.3613
## Jul 2024 199.6287 197.7259 201.5316 196.7186 202.5389
## Aug 2024 198.8859 196.3118 201.4601 194.9491 202.8228
## Sep 2024 198.1431 194.8349 201.4513 193.0837 203.2025
## Oct 2024 197.4003 193.3007 201.4998 191.1306 203.6700
## Nov 2024 196.6575 191.7133 201.6016 189.0960 204.2189
## Dec 2024 195.9146 190.0760 201.7532 186.9853 204.8440
## Jan 2025 195.1718 188.3919 201.9517 184.8029 205.5407
## Feb 2025 194.4290 186.6635 202.1945 182.5526 206.3053
## Mar 2025 193.6862 184.8927 202.4796 180.2378 207.1346Exponencial simple
expcar <- ses(bsd2, h=12)
# Plot
plot_forecast(expcar)Modelo de exponencial simple
expcar$model## Simple exponential smoothing
##
## Call:
## ses(y = bsd2, h = 12)
##
## Smoothing parameters:
## alpha = 0.9999
##
## Initial states:
## l = 80.792
##
## sigma: 1.2429
##
## AIC AICc BIC
## 1465.299 1465.398 1475.815α=0.9999: los valores más recientes tienen una gran influencia en la predicción, mientras que los valores más antiguos tienen muy poca. l=80.792: Este es el valor inicial del nivel de la serie temporal σ=1.2429: Este valor representa la desviación estándar de los errores de predicción. Es una medida de la precisión del modelo; valores más bajos indican un mejor ajuste del modelo a los datos históricos.
expcar## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jul 2024 200.1002 198.5073 201.6930 197.6641 202.5363
## Aug 2024 200.1002 197.8476 202.3527 196.6552 203.5452
## Sep 2024 200.1002 197.3414 202.8589 195.8810 204.3193
## Oct 2024 200.1002 196.9146 203.2857 195.2283 204.9720
## Nov 2024 200.1002 196.5387 203.6617 194.6533 205.5470
## Dec 2024 200.1002 196.1987 204.0016 194.1335 206.0669
## Jan 2025 200.1002 195.8862 204.3142 193.6554 206.5449
## Feb 2025 200.1002 195.5952 204.6051 193.2104 206.9899
## Mar 2025 200.1002 195.3219 204.8784 192.7925 207.4078
## Apr 2025 200.1002 195.0635 205.1368 192.3972 207.8031
## May 2025 200.1002 194.8177 205.3827 192.0213 208.1790
## Jun 2025 200.1002 194.5828 205.6175 191.6620 208.5383La predicción central para cada período es constante en 200.1002, lo que sugiere que el modelo predice que el valor de la serie temporal se mantendrá relativamente estable durante el período proyectado.
Holt Winters
HWa <- hw(bsd2,seasonal="additive", h=12)
HWm <- hw(bsd2,seasonal="multiplicative", h=12)
HWd <- holt(bsd2, damped=TRUE, phi = 0.9, h=12)
HWa$model## Holt-Winters' additive method
##
## Call:
## hw(y = bsd2, h = 12, seasonal = "additive")
##
## Smoothing parameters:
## alpha = 0.9999
## beta = 0.1298
## gamma = 1e-04
##
## Initial states:
## l = 78.3504
## b = 1.0227
## s = 1.8273 2.0093 0.9935 -0.1206 -0.3781 -0.6159
## -1.0592 -1.2123 -1.261 -0.6503 -0.327 0.7943
##
## sigma: 0.9542
##
## AIC AICc BIC
## 1348.701 1351.385 1408.292Alpha es casi 1, lo que indica que el modelo se ajusta muy rápidamente a los cambios en el nivel de la serie. Beta es relativamente pequeño, lo que indica que la tendencia se ajusta lentamente a las nuevas observaciones. Gamma es muy pequeño, sugiriendo que el componente estacional se ajusta de manera muy lenta.
Estacional aditivo
plot_forecast(HWa) igual que las demas graficas, después de un pico, va con tendencia hacia la baja.
Estacional multiplicativo
plot_forecast(HWm) # Estacional MultiplicativoNos muestra que hay un componente estacional que afecta los precios de la vivienda por los ciclos repetitivos que hay. Igual que las otras graficas indica que los precios, después de un pico, muestra tendencia hacia la baja
DAMPED
plot_forecast(HWd) # Con tendencia amortiguada(Damped trend) es utilizado cuando se espera que la tendencia observada en el pasado se mantenga, pero a un ritmo decreciente. Esto significa que la tendencia, ya sea alcista o bajista, se suavizará con el tiempo. En resumen, la gráfica sugiere que aunque los precios de la vivienda en Bogotá han estado en declive reciente, el modelo pronostica que esta caída se estabilizará en el futuro, con una menor variabilidad esperada, como se indica por los intervalos de confianza.
Status
# Modelo Multiplicativo
print(round(accuracy(HWm),2))## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -0.02 1.12 0.9 0.02 0.61 0.11 0.39# Modelo Aditivo
print(round(accuracy(HWa),2))## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -0.05 0.92 0.73 -0.03 0.49 0.09 0.17ME: -0.05 el error medio de las predicciones es muy cercano a 0, indicando que en promedio, el modelo no tiende a sobrestimar ni subestimar significativamente los valores. Esto nos muestra que el modelo aditivo tiene un error promedio bajo, con una precisión aceptable en general.
# Modelo damped
print(round(accuracy(HWd),2))## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 0.12 1.05 0.8 0.1 0.51 0.1 0.12ME: 0.12 es el error promedio en las predicciones. Un valor cercano a 0 indica que, en promedio, las predicciones están bastante cerca de los valores reales.