Parte I

Ejercicio 3 (Cap. 6)

Remítase de nuevo a los datos de la serie de tiempo de ventas de gasolina en la tabla 6.1.

  1. Utilice un peso de 1/2 para la observación más reciente, 1/3 para la segunda observación más reciente y 1/6 para la tercera más reciente, con el propósito de calcular un promedio móvil ponderado de tres semanas para la serie de tiempo.

  2. Calcule el EMC para el promedio móvil ponderado del inciso a. ¿Prefiere este promedio móvil ponderado al promedio móvil sin ponderar? Recuerde que el EMC para el promedio móvil sin ponderar es 10.22.

  3. Suponga que se le permite elegir cualesquiera pesos siempre y cuando sumen 1. ¿Podría encontrar siempre un conjunto de pesos que hiciera que el EMC sea menor para un promedio móvil ponderado que para un promedio móvil sin ponderar? ¿Por qué?

# Technical Trading Rules
# install.packages("TTR")
library(TTR)
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.4.1
library(forecast)
library(fpp2)
## Warning: package 'fpp2' was built under R version 4.4.1
## Warning: package 'fma' was built under R version 4.4.1
## Warning: package 'expsmooth' was built under R version 4.4.1
library(ggplot2)
library(gt)
library(gtExtras)
# ventas para 12 periodos
ventas <- c(17,21,19,23,18,16,20,18,22,20,15,22)

tabla <- data.frame(ventas)
tabla
##    ventas
## 1      17
## 2      21
## 3      19
## 4      23
## 5      18
## 6      16
## 7      20
## 8      18
## 9      22
## 10     20
## 11     15
## 12     22
plot(ventas, 
     main = "Serie de tiempo",
     xlab = "Periodo",
     ylab = "Ventas (miles de galones)",
     type = "l",
     xlim = c(1,12),
     col="blue")
points(ventas, col=("blue"))
axis(1, at = 1:12, labels = 1:12)

a. Calcular promedio móvil ponderado de tres semanas para la serie de tiempo.

# WMA: Moving Averages
# wts: Vector of weights.

timelapse <- 3
w1 <- 1/6
w2 <- 1/3
w3 <- 1/2

PMP <- WMA(ventas, timelapse, wts= c(w1, w2, w3))
tabla <- cbind(tabla, PMP)
##    ventas  PMP
## 1      17   NA
## 2      21   NA
## 3      19 19.3
## 4      23 21.3
## 5      18 19.8
## 6      16 17.8
## 7      20 18.3
## 8      18 18.3
## 9      22 20.3
## 10     20 20.3
## 11     15 17.8
## 12     22 19.3

b. Calcule el EMC para el promedio móvil ponderado

prediccion <- rep(NA, length(ventas))
vector_datos <- PMP[timelapse:length(PMP) - 1]
prediccion[timelapse:length(prediccion)] <- vector_datos
error <- tabla$ventas - prediccion
error_2 <- error^2

tabla <- round(cbind(tabla, prediccion, error, error_2), 1)
##    ventas  PMP prediccion error error_2
## 1      17   NA         NA    NA      NA
## 2      21   NA         NA    NA      NA
## 3      19 19.3         NA    NA      NA
## 4      23 21.3       19.3   3.7    13.4
## 5      18 19.8       21.3  -3.3    11.1
## 6      16 17.8       19.8  -3.8    14.7
## 7      20 18.3       17.8   2.2     4.7
## 8      18 18.3       18.3  -0.3     0.1
## 9      22 20.3       18.3   3.7    13.4
## 10     20 20.3       20.3  -0.3     0.1
## 11     15 17.8       20.3  -5.3    28.4
## 12     22 19.3       17.8   4.2    17.4
ecm <- round(mean(error_2[(timelapse+1):length(error_2)]), 1)
print(paste("ECM: ", ecm))
## [1] "ECM:  11.5"

Respuesta: se selecciona el modelo con el promedio movil sin ponderar, teniendo encuenta que el EMC es menor

c. ¿Podría encontrar siempre un conjunto de pesos que hiciera que el EMC sea menor para un promedio móvil ponderado que para un promedio móvil sin ponderar?

timelapse <- 3
w1 <- 1/2
w2 <- 1/3
w3 <- 1/6

PMP <- WMA(ventas, timelapse, wts= c(w1, w2, w3))

prediccion <- rep(NA, length(ventas))
vector_datos <- PMP[timelapse:length(PMP) - 1]
prediccion[timelapse:length(prediccion)] <- vector_datos
error <- tabla$ventas - prediccion
error_2 <- error^2

tabla <- data.frame(ventas, PMP, prediccion, error, error_2)

ecm <- round(mean(error_2[(timelapse+1):length(error_2)]), 1)
print(paste("ECM: ", ecm))
## [1] "ECM:  9.7"

Respuesta: al invertir los pesos asigandos se obtiene un menor EMC que para el promedio movil sin ponderar, es decir, a la observación más reciente se asignó 1/6, a la segunda observación más reciente 1/3 y a la tercera observación 1/2

Ejercicio 4 (Cap. 6)

Utilice los datos de la serie de tiempo de ventas de gasolina de la tabla 6.1 para mostrar los pronósticos de suavización exponencial con \(\alpha = 0.1\) Con el criterio del error cuadrado medio, ¿preferiría usted una constante de suavización de \(\alpha = 0.1\) o \(\alpha = 0.2\)?

##  [1] 17 21 19 23 18 16 20 18 22 20 15 22

Pronósticos de suavización exponencial con \(\alpha = 0.1\)

ses <- ses(ventas, h=1, initial="simple", alpha = 0.1)

forecast01 <- ses$fitted
error01 <- ses$residuals
error01_2 <- error01^2
tabla4 <- data.frame(ventas, forecast01, error01, error01_2)
##    ventas forecast01 error01 error01_2
## 1      17       17.0     0.0       0.0
## 2      21       17.0     4.0      16.0
## 3      19       17.4     1.6       2.6
## 4      23       17.6     5.4      29.6
## 5      18       18.1    -0.1       0.0
## 6      16       18.1    -2.1       4.4
## 7      20       17.9     2.1       4.5
## 8      18       18.1    -0.1       0.0
## 9      22       18.1     3.9      15.3
## 10     20       18.5     1.5       2.3
## 11     15       18.6    -3.6      13.2
## 12     22       18.3     3.7      13.9
ecm <- round(mean(error01_2[(timelapse+1):length(error01_2)]), 1)
print(paste("ECM: ", ecm))
## [1] "ECM:  9.2"

Pronósticos de suavización exponencial con \(\alpha = 0.2\)

ses <- ses(ventas, h=1, initial="simple", alpha = 0.2)

forecast02 <- ses$fitted
error02 <- ses$residuals
error02_2 <- error02^2
tabla4 <- data.frame(ventas, forecast02, error02, error02_2)
##    ventas forecast02 error02 error02_2
## 1      17       17.0     0.0       0.0
## 2      21       17.0     4.0      16.0
## 3      19       17.8     1.2       1.4
## 4      23       18.0     5.0      24.6
## 5      18       19.0    -1.0       1.1
## 6      16       18.8    -2.8       8.0
## 7      20       18.3     1.7       3.0
## 8      18       18.6    -0.6       0.4
## 9      22       18.5     3.5      12.3
## 10     20       19.2     0.8       0.7
## 11     15       19.4    -4.4      18.9
## 12     22       18.5     3.5      12.4
ecm <- round(mean(error02_2[(timelapse+1):length(error02_2)]), 1)
print(paste("ECM: ", ecm))
## [1] "ECM:  9"

Con el criterio del error cuadrado medio, ¿preferiría usted una constante de suavización de \(\alpha = 0.1\) o \(\alpha = 0.2\)?

Respuesta: teniendo en cuenta el criterio del ECM prefiero una constante de suavización de \(\alpha = 0.2\)

Ejercicio 5 (Cap. 6)

Para la empresa Hawkins, los porcentajes mensuales de todos los embarques que se recibieron a tiempo durante los 12 meses pasados son 80, 82, 84, 83, 83, 84, 85, 84, 82, 83, 84 y 83.

a. Compare un pronóstico del promedio móvil de tres meses con un pronóstico de suavización exponencial para \(\alpha = 0.2\) ¿Cuál proporciona los mejores pronósticos?

Promedio móvil de tres meses

##    embarques  pm3 prediccion error error_2
## 1         80   NA         NA    NA      NA
## 2         82   NA         NA    NA      NA
## 3         84 82.0         NA    NA      NA
## 4         83 83.0       82.0   1.0     1.0
## 5         83 83.3       83.0   0.0     0.0
## 6         84 83.3       83.3   0.7     0.4
## 7         85 84.0       83.3   1.7     2.8
## 8         84 84.3       84.0   0.0     0.0
## 9         82 83.7       84.3  -2.3     5.4
## 10        83 83.0       83.7  -0.7     0.4
## 11        84 83.0       83.0   1.0     1.0
## 12        83 83.3       83.0   0.0     0.0
## [1] "Promedio móvil - ECM:  1.2"

Suavización exponencial con \(\alpha = 0.2\)

##    ventas forecast error error_2
## 1      17     80.0   0.0     0.0
## 2      21     80.0   2.0     4.0
## 3      19     80.4   3.6    13.0
## 4      23     81.1   1.9     3.5
## 5      18     81.5   1.5     2.3
## 6      16     81.8   2.2     4.9
## 7      20     82.2   2.8     7.6
## 8      18     82.8   1.2     1.5
## 9      22     83.0  -1.0     1.1
## 10     20     82.8   0.2     0.0
## 11     15     82.9   1.1     1.3
## 12     22     83.1  -0.1     0.0
ecm_alpha <- mean(error_2[2:length(error_2)])
print(paste("Suavización exponencial - ECM: ", round(ecm_alpha, 1)))
## [1] "Suavización exponencial - ECM:  3.6"
N <- c("3", "alpha = 0.2")
suavizacion <- c("Simple", "Exponencial")
ECM <- round(c(ecm, ecm_alpha),1)
Pronostico <- round(c(pm3[12], forecast[12]),1)
tabla_resultados <- cbind(N, suavizacion, ECM, Pronostico)
resultados <- as.data.frame(tabla_resultados, row.names = FALSE)
gt_tbl <- gt(resultados)
gt_tbl
N suavizacion ECM Pronostico
3 Simple 1.2 83.3
alpha = 0.2 Exponencial 3.6 83.1

Respuesta: Teniendo en cuenta el ECM el mejor pronóstico es el del promedio móvil de 3 meses.

b. ¿Cuál es el pronóstico para el mes siguiente?

Respuesta: el pronóstico para el mes siguiente es 83.3 usando promedio móvil de 3 meses.

Ejercicio 28 (Cap. 6)

Suponga que los datos siguientes son por ventas trimestrales para los siete años pasados:

a. Muestre los valores del promedio móvil de cuatro trimestres para esta serie de tiempo. Trace tanto la serie de tiempo original como los promedios móviles en una misma gráfica.

ventas <- c(6,15,10,4,10,18,15,7,14,26,23,12,19,28,25,18,22,34,28,21,24,36,30,20,28,40,35,27)

pm4 <- SMA(ventas, 4)

plot(ventas, 
     main = "Serie de tiempo",
     xlab = "Trimestres",
     ylab = "Ventas",
     type = "l",
     col="blue")
lines(ventas, col=("blue"))
points(ventas, col=("blue"))
lines(pm4, col=("red"))
points(pm4, col=("red"))

b. Calcule los índices estacionales para los cuatro trimestres.

x<-c(6,15,10,4,10,18,15,7,14,26,23,12,19,28,25,18,22,34,28,21,24,36,30,20,28,40,35,27)

class(x)
## [1] "numeric"
x<-ts(x, start = c(1,1), end = c(7,4), frequency=4) #a??o 1 periodo 1, 3 a??os, 12 meses, corte cada 12
x
##   Qtr1 Qtr2 Qtr3 Qtr4
## 1    6   15   10    4
## 2   10   18   15    7
## 3   14   26   23   12
## 4   19   28   25   18
## 5   22   34   28   21
## 6   24   36   30   20
## 7   28   40   35   27
class(x)#verificar si corresponde a una serie de timepo (ts)
## [1] "ts"
d<-decompose(x=x,type = "multiplicative")
d$x
##   Qtr1 Qtr2 Qtr3 Qtr4
## 1    6   15   10    4
## 2   10   18   15    7
## 3   14   26   23   12
## 4   19   28   25   18
## 5   22   34   28   21
## 6   24   36   30   20
## 7   28   40   35   27
ie<-d$figure #indice de estacionalidad
ie
## [1] 0.8991300 1.3616788 1.1183419 0.6208493
sum(ie) # la suma debe dar 12
## [1] 4
quarters <- c("Trimestre 1", "Trimestre 2", "Trimestre 3", "Trimestre 4")
df.ie <- data.frame(quarters, ie)
df.ie
##      quarters        ie
## 1 Trimestre 1 0.8991300
## 2 Trimestre 2 1.3616788
## 3 Trimestre 3 1.1183419
## 4 Trimestre 4 0.6208493
plot(df.ie$ie, type="b", col="red")

c. ¿Cuándo experimenta Hudson Marine el mayor efecto estacional? ¿Este resultado parece razonable? Explique por qué.

Respuesta: el mayor efecto estacional se observa en el trimestre 2, teniendo en cuenta que el índice estacional es de 1.36.

Ejercicio 29 (Cap. 6)

Considere el escenario presentado de Costello Music presentado en el problema 20 y los datos de ventas trimestrales siguientes:

a. Calcule los índices estacionales para los cuatro trimestres.

x <- c(4,2,1,5,6,4,4,14,10,3,5,16,12,9,7,22,18,10,13,35)
class(x)
## [1] "numeric"
x <- ts(x, start = c(1,1), end = c(5,4), frequency=4)
x
##   Qtr1 Qtr2 Qtr3 Qtr4
## 1    4    2    1    5
## 2    6    4    4   14
## 3   10    3    5   16
## 4   12    9    7   22
## 5   18   10   13   35
class(x)
## [1] "ts"
d<-decompose(x=x,type = "multiplicative")
d$x
##   Qtr1 Qtr2 Qtr3 Qtr4
## 1    4    2    1    5
## 2    6    4    4   14
## 3   10    3    5   16
## 4   12    9    7   22
## 5   18   10   13   35
ie<-d$figure #indice de estacionalidad
ie
## [1] 1.2716597 0.6120283 0.4978229 1.6184891
sum(ie) # la suma debe dar 12
## [1] 4
quarters <- c("Trimestre 1", "Trimestre 2", "Trimestre 3", "Trimestre 4")
df.ie <- data.frame(quarters, ie)
df.ie
##      quarters        ie
## 1 Trimestre 1 1.2716597
## 2 Trimestre 2 0.6120283
## 3 Trimestre 3 0.4978229
## 4 Trimestre 4 1.6184891
plot(df.ie$ie, type="b", col="darkgreen")

### c. ¿Cuándo experimenta Costello Music el efecto estacional más grande? ¿Este resultado parece razonable? Explique por qué.

Respuesta: el mayor efecto estacional se observa en el trimestre 4, teniendo en cuenta que el índice estacional es de 1.61.

Parte II

Identificar una serie económica (una sola variable) de Colombia con mínimo 10 años y datos mensuales o trimestrales y establecer:

  • Serie de tiempo seleccionada: IPC. Índice y variación mensual, año corrido y anual del IPC sin alimentos (Enero de 2009 a Diciembre de 2023) Fuente: DANE

El índice estacional correspondiente

library(readxl)

datos <- read_excel("Taller1_Yesenia_Castro_Cely.xlsx", sheet = "Hoja1")
ipc <- datos

x<-ipc


class(x)
## [1] "tbl_df"     "tbl"        "data.frame"
x<-ts(x, start = c(1,1), end = c(15,12), frequency=12)
x
##          Jan       Feb       Mar       Apr       May       Jun       Jul
## 1   70.72999  71.38529  71.85034  72.03354  72.05468  72.16742  72.28016
## 2   72.94955  73.48506  73.59780  73.75986  73.85851  73.99239  74.05581
## 3   75.03523  75.47210  75.72576  75.86669  75.93715  76.14149  76.19786
## 4   77.29002  77.81144  77.95941  77.99464  78.17080  78.27649  78.28354
## 5   78.92475  79.43207  79.60823  79.71392  79.95349  80.22125  80.20011
## 6   80.89064  81.44025  81.69391  81.98985  82.16601  82.34921  82.40558
## 7   83.47661  84.22351  84.51945  84.80834  85.21702  85.41432  85.68912
## 8   88.10598  89.17700  89.76184  89.90981  90.38895  90.81172  91.05130
## 9   92.73534  93.78523  94.36302  94.94786  95.22266  95.46223  95.41291
## 10  97.01240  97.91432  98.18912  98.56257  98.88670  99.09808  99.14741
## 11 100.46000 101.10000 101.44000 101.84000 102.10000 102.27000 102.41000
## 12 103.82000 104.47000 104.75000 104.55000 104.14000 103.70000 103.86000
## 13 104.74000 105.45000 105.86000 106.18000 106.34000 106.50000 106.83000
## 14 109.43000 110.83000 111.47000 112.48000 113.25000 113.78000 114.61000
## 15 120.84000 122.86000 124.20000 125.43000 126.37000 127.00000 127.73000
##          Aug       Sep       Oct       Nov       Dec
## 1   72.36471  72.38585  72.37176  72.43517  72.51268
## 2   74.17559  74.20378  74.23196  74.36584  74.56313
## 3   76.22604  76.40924  76.47971  76.61359  76.89543
## 4   78.31877  78.60062  78.67108  78.67108  78.74154
## 5   80.24944  80.46082  80.48196  80.41150  80.60175
## 6   82.53241  82.63106  82.82835  82.96223  83.22999
## 7   85.99915  86.41488  86.76015  87.15474  87.52818
## 8   91.24154  91.53044  91.65727  91.78410  92.02368
## 9   95.63134  95.84977  95.96956  96.18799  96.63191
## 10  99.29538  99.40812  99.59837  99.74634 100.00000
## 11 102.54000 102.73000 102.87000 103.09000 103.45000
## 12 103.94000 104.34000 104.33000 104.13000 104.52000
## 13 107.17000 107.50000 107.32000 107.64000 108.12000
## 14 115.56000 116.45000 117.14000 117.84000 118.92000
## 15 128.49000 129.12000 129.45000 130.35000 131.21000
class(x) 
## [1] "ts"
plot(x, 
     main = "Serie de tiempo",
     xlab = "Años",
     ylab = "IPC sin alimentos",
     type = "l",
     col="blue")
points(x, col=("blue"))

d<-decompose(x=x,type = "multiplicative")
d$x
##          Jan       Feb       Mar       Apr       May       Jun       Jul
## 1   70.72999  71.38529  71.85034  72.03354  72.05468  72.16742  72.28016
## 2   72.94955  73.48506  73.59780  73.75986  73.85851  73.99239  74.05581
## 3   75.03523  75.47210  75.72576  75.86669  75.93715  76.14149  76.19786
## 4   77.29002  77.81144  77.95941  77.99464  78.17080  78.27649  78.28354
## 5   78.92475  79.43207  79.60823  79.71392  79.95349  80.22125  80.20011
## 6   80.89064  81.44025  81.69391  81.98985  82.16601  82.34921  82.40558
## 7   83.47661  84.22351  84.51945  84.80834  85.21702  85.41432  85.68912
## 8   88.10598  89.17700  89.76184  89.90981  90.38895  90.81172  91.05130
## 9   92.73534  93.78523  94.36302  94.94786  95.22266  95.46223  95.41291
## 10  97.01240  97.91432  98.18912  98.56257  98.88670  99.09808  99.14741
## 11 100.46000 101.10000 101.44000 101.84000 102.10000 102.27000 102.41000
## 12 103.82000 104.47000 104.75000 104.55000 104.14000 103.70000 103.86000
## 13 104.74000 105.45000 105.86000 106.18000 106.34000 106.50000 106.83000
## 14 109.43000 110.83000 111.47000 112.48000 113.25000 113.78000 114.61000
## 15 120.84000 122.86000 124.20000 125.43000 126.37000 127.00000 127.73000
##          Aug       Sep       Oct       Nov       Dec
## 1   72.36471  72.38585  72.37176  72.43517  72.51268
## 2   74.17559  74.20378  74.23196  74.36584  74.56313
## 3   76.22604  76.40924  76.47971  76.61359  76.89543
## 4   78.31877  78.60062  78.67108  78.67108  78.74154
## 5   80.24944  80.46082  80.48196  80.41150  80.60175
## 6   82.53241  82.63106  82.82835  82.96223  83.22999
## 7   85.99915  86.41488  86.76015  87.15474  87.52818
## 8   91.24154  91.53044  91.65727  91.78410  92.02368
## 9   95.63134  95.84977  95.96956  96.18799  96.63191
## 10  99.29538  99.40812  99.59837  99.74634 100.00000
## 11 102.54000 102.73000 102.87000 103.09000 103.45000
## 12 103.94000 104.34000 104.33000 104.13000 104.52000
## 13 107.17000 107.50000 107.32000 107.64000 108.12000
## 14 115.56000 116.45000 117.14000 117.84000 118.92000
## 15 128.49000 129.12000 129.45000 130.35000 131.21000
ie<-d$figure
ie
##  [1] 0.9978153 1.0032105 1.0039008 1.0039129 1.0033303 1.0020913 1.0004405
##  [8] 0.9992753 0.9987533 0.9967971 0.9951800 0.9952927
sum(ie)
## [1] 12
meses<-c("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre")
df.ie<-data.frame(meses,ie)
df.ie
##         meses        ie
## 1       enero 0.9978153
## 2     febrero 1.0032105
## 3       marzo 1.0039008
## 4       abril 1.0039129
## 5        mayo 1.0033303
## 6       junio 1.0020913
## 7       julio 1.0004405
## 8      agosto 0.9992753
## 9  septiembre 0.9987533
## 10    octubre 0.9967971
## 11  noviembre 0.9951800
## 12  diciembre 0.9952927
plot(df.ie$ie, type="b", col="red")

El pronóstico para el año siguiente

mes<-seq(1,180)
ie2<-rep(ie, times=15)
IPCDE<-x/ie2
Tabla<-data.frame((cbind(mes,x, ie2, IPCDE)))
Tabla
##     mes         x       ie2     IPCDE
## 1     1  70.72999 0.9978153  70.88485
## 2     2  71.38529 1.0032105  71.15684
## 3     3  71.85034 1.0039008  71.57115
## 4     4  72.03354 1.0039129  71.75278
## 5     5  72.05468 1.0033303  71.81551
## 6     6  72.16742 1.0020913  72.01681
## 7     7  72.28016 1.0004405  72.24833
## 8     8  72.36471 0.9992753  72.41719
## 9     9  72.38585 0.9987533  72.47621
## 10   10  72.37176 0.9967971  72.60431
## 11   11  72.43517 0.9951800  72.78601
## 12   12  72.51268 0.9952927  72.85563
## 13   13  72.94955 0.9978153  73.10927
## 14   14  73.48506 1.0032105  73.24989
## 15   15  73.59780 1.0039008  73.31183
## 16   16  73.75986 1.0039129  73.47238
## 17   17  73.85851 1.0033303  73.61336
## 18   18  73.99239 1.0020913  73.83797
## 19   19  74.05581 1.0004405  74.02320
## 20   20  74.17559 0.9992753  74.22938
## 21   21  74.20378 0.9987533  74.29641
## 22   22  74.23196 0.9967971  74.47049
## 23   23  74.36584 0.9951800  74.72602
## 24   24  74.56313 0.9952927  74.91578
## 25   25  75.03523 0.9978153  75.19952
## 26   26  75.47210 1.0032105  75.23057
## 27   27  75.72576 1.0039008  75.43152
## 28   28  75.86669 1.0039129  75.57099
## 29   29  75.93715 1.0033303  75.68509
## 30   30  76.14149 1.0020913  75.98258
## 31   31  76.19786 1.0004405  76.16431
## 32   32  76.22604 0.9992753  76.28132
## 33   33  76.40924 0.9987533  76.50463
## 34   34  76.47971 0.9967971  76.72545
## 35   35  76.61359 0.9951800  76.98465
## 36   36  76.89543 0.9952927  77.25911
## 37   37  77.29002 0.9978153  77.45924
## 38   38  77.81144 1.0032105  77.56243
## 39   39  77.95941 1.0039008  77.65649
## 40   40  77.99464 1.0039129  77.69065
## 41   41  78.17080 1.0033303  77.91133
## 42   42  78.27649 1.0020913  78.11313
## 43   43  78.28354 1.0004405  78.24907
## 44   44  78.31877 0.9992753  78.37557
## 45   45  78.60062 0.9987533  78.69874
## 46   46  78.67108 0.9967971  78.92387
## 47   47  78.67108 0.9951800  79.05212
## 48   48  78.74154 0.9952927  79.11395
## 49   49  78.92475 0.9978153  79.09755
## 50   50  79.43207 1.0032105  79.17787
## 51   51  79.60823 1.0039008  79.29890
## 52   52  79.71392 1.0039129  79.40323
## 53   53  79.95349 1.0033303  79.68811
## 54   54  80.22125 1.0020913  80.05383
## 55   55  80.20011 1.0004405  80.16480
## 56   56  80.24944 0.9992753  80.30763
## 57   57  80.46082 0.9987533  80.56126
## 58   58  80.48196 0.9967971  80.74057
## 59   59  80.41150 0.9951800  80.80096
## 60   60  80.60175 0.9952927  80.98296
## 61   61  80.89064 0.9978153  81.06775
## 62   62  81.44025 1.0032105  81.17962
## 63   63  81.69391 1.0039008  81.37648
## 64   64  81.98985 1.0039129  81.67029
## 65   65  82.16601 1.0033303  81.89328
## 66   66  82.34921 1.0020913  82.17735
## 67   67  82.40558 1.0004405  82.36930
## 68   68  82.53241 0.9992753  82.59226
## 69   69  82.63106 0.9987533  82.73421
## 70   70  82.82835 0.9967971  83.09450
## 71   71  82.96223 0.9951800  83.36405
## 72   72  83.22999 0.9952927  83.62363
## 73   73  83.47661 0.9978153  83.65937
## 74   74  84.22351 1.0032105  83.95397
## 75   75  84.51945 1.0039008  84.19104
## 76   76  84.80834 1.0039129  84.47779
## 77   77  85.21702 1.0033303  84.93417
## 78   78  85.41432 1.0020913  85.23606
## 79   79  85.68912 1.0004405  85.65139
## 80   80  85.99915 0.9992753  86.06152
## 81   81  86.41488 0.9987533  86.52275
## 82   82  86.76015 0.9967971  87.03893
## 83   83  87.15474 0.9951800  87.57686
## 84   84  87.52818 0.9952927  87.94215
## 85   85  88.10598 0.9978153  88.29888
## 86   86  89.17700 1.0032105  88.89161
## 87   87  89.76184 1.0039008  89.41306
## 88   88  89.90981 1.0039129  89.55937
## 89   89  90.38895 1.0033303  90.08893
## 90   90  90.81172 1.0020913  90.62220
## 91   91  91.05130 1.0004405  91.01121
## 92   92  91.24154 0.9992753  91.30771
## 93   93  91.53044 0.9987533  91.64470
## 94   94  91.65727 0.9967971  91.95179
## 95   95  91.78410 0.9951800  92.22865
## 96   96  92.02368 0.9952927  92.45890
## 97   97  92.73534 0.9978153  92.93838
## 98   98  93.78523 1.0032105  93.48509
## 99   99  94.36302 1.0039008  93.99636
## 100 100  94.94786 1.0039129  94.57779
## 101 101  95.22266 1.0033303  94.90659
## 102 102  95.46223 1.0020913  95.26301
## 103 103  95.41291 1.0004405  95.37090
## 104 104  95.63134 0.9992753  95.70069
## 105 105  95.84977 0.9987533  95.96942
## 106 106  95.96956 0.9967971  96.27793
## 107 107  96.18799 0.9951800  96.65387
## 108 108  96.63191 0.9952927  97.08893
## 109 109  97.01240 0.9978153  97.22480
## 110 110  97.91432 1.0032105  97.60097
## 111 111  98.18912 1.0039008  97.80759
## 112 112  98.56257 1.0039129  98.17841
## 113 113  98.88670 1.0033303  98.55847
## 114 114  99.09808 1.0020913  98.89127
## 115 115  99.14741 1.0004405  99.10375
## 116 116  99.29538 0.9992753  99.36739
## 117 117  99.40812 0.9987533  99.53221
## 118 118  99.59837 0.9967971  99.91840
## 119 119  99.74634 0.9951800 100.22945
## 120 120 100.00000 0.9952927 100.47295
## 121 121 100.46000 0.9978153 100.67995
## 122 122 101.10000 1.0032105 100.77645
## 123 123 101.44000 1.0039008 101.04584
## 124 124 101.84000 1.0039129 101.44307
## 125 125 102.10000 1.0033303 101.76111
## 126 126 102.27000 1.0020913 102.05657
## 127 127 102.41000 1.0004405 102.36491
## 128 128 102.54000 0.9992753 102.61436
## 129 129 102.73000 0.9987533 102.85824
## 130 130 102.87000 0.9967971 103.20054
## 131 131 103.09000 0.9951800 103.58930
## 132 132 103.45000 0.9952927 103.93927
## 133 133 103.82000 0.9978153 104.04731
## 134 134 104.47000 1.0032105 104.13567
## 135 135 104.75000 1.0039008 104.34298
## 136 136 104.55000 1.0039129 104.14250
## 137 137 104.14000 1.0033303 103.79433
## 138 138 103.70000 1.0020913 103.48358
## 139 139 103.86000 1.0004405 103.81427
## 140 140 103.94000 0.9992753 104.01538
## 141 141 104.34000 0.9987533 104.47025
## 142 142 104.33000 0.9967971 104.66524
## 143 143 104.13000 0.9951800 104.63434
## 144 144 104.52000 0.9952927 105.01433
## 145 145 104.74000 0.9978153 104.96932
## 146 146 105.45000 1.0032105 105.11253
## 147 147 105.86000 1.0039008 105.44867
## 148 148 106.18000 1.0039129 105.76615
## 149 149 106.34000 1.0033303 105.98703
## 150 150 106.50000 1.0020913 106.27774
## 151 151 106.83000 1.0004405 106.78296
## 152 152 107.17000 0.9992753 107.24772
## 153 153 107.50000 0.9987533 107.63419
## 154 154 107.32000 0.9967971 107.66484
## 155 155 107.64000 0.9951800 108.16134
## 156 156 108.12000 0.9952927 108.63136
## 157 157 109.43000 0.9978153 109.66959
## 158 158 110.83000 1.0032105 110.47531
## 159 159 111.47000 1.0039008 111.03687
## 160 160 112.48000 1.0039129 112.04160
## 161 161 113.25000 1.0033303 112.87410
## 162 162 113.78000 1.0020913 113.54255
## 163 163 114.61000 1.0004405 114.55954
## 164 164 115.56000 0.9992753 115.64380
## 165 165 116.45000 0.9987533 116.59537
## 166 166 117.14000 0.9967971 117.51640
## 167 167 117.84000 0.9951800 118.41074
## 168 168 118.92000 0.9952927 119.48243
## 169 169 120.84000 0.9978153 121.10457
## 170 170 122.86000 1.0032105 122.46681
## 171 171 124.20000 1.0039008 123.71740
## 172 172 125.43000 1.0039129 124.94112
## 173 173 126.37000 1.0033303 125.95055
## 174 174 127.00000 1.0020913 126.73496
## 175 175 127.73000 1.0004405 127.67376
## 176 176 128.49000 0.9992753 128.58318
## 177 177 129.12000 0.9987533 129.28118
## 178 178 129.45000 0.9967971 129.86595
## 179 179 130.35000 0.9951800 130.98134
## 180 180 131.21000 0.9952927 131.83056
#Calcular pendiente e intercepto
modeloRL1<-lm(Tabla$IPCDE~Tabla$mes)
modeloRL1
## 
## Call:
## lm(formula = Tabla$IPCDE ~ Tabla$mes)
## 
## Coefficients:
## (Intercept)    Tabla$mes  
##     65.7300       0.2956
coef1 <- modeloRL1$coefficients[1]
coef2 <- modeloRL1$coefficients

ProDE<- 0.2956 *Tabla$mes+65.7300 #pronostico desestacionalizado
Tabla<-data.frame(Tabla,ProDE)
ProE<-ProDE*Tabla$ie2 #pronostico estacionalizado
Tabla<-data.frame(Tabla, ProE)
Tabla
##     mes         x       ie2     IPCDE    ProDE      ProE
## 1     1  70.72999 0.9978153  70.88485  66.0256  65.88136
## 2     2  71.38529 1.0032105  71.15684  66.3212  66.53413
## 3     3  71.85034 1.0039008  71.57115  66.6168  66.87666
## 4     4  72.03354 1.0039129  71.75278  66.9124  67.17422
## 5     5  72.05468 1.0033303  71.81551  67.2080  67.43182
## 6     6  72.16742 1.0020913  72.01681  67.5036  67.64477
## 7     7  72.28016 1.0004405  72.24833  67.7992  67.82906
## 8     8  72.36471 0.9992753  72.41719  68.0948  68.04545
## 9     9  72.38585 0.9987533  72.47621  68.3904  68.30513
## 10   10  72.37176 0.9967971  72.60431  68.6860  68.46600
## 11   11  72.43517 0.9951800  72.78601  68.9816  68.64911
## 12   12  72.51268 0.9952927  72.85563  69.2772  68.95109
## 13   13  72.94955 0.9978153  73.10927  69.5728  69.42081
## 14   14  73.48506 1.0032105  73.24989  69.8684  70.09272
## 15   15  73.59780 1.0039008  73.31183  70.1640  70.43770
## 16   16  73.75986 1.0039129  73.47238  70.4596  70.73530
## 17   17  73.85851 1.0033303  73.61336  70.7552  70.99084
## 18   18  73.99239 1.0020913  73.83797  71.0508  71.19939
## 19   19  74.05581 1.0004405  74.02320  71.3464  71.37783
## 20   20  74.17559 0.9992753  74.22938  71.6420  71.59008
## 21   21  74.20378 0.9987533  74.29641  71.9376  71.84791
## 22   22  74.23196 0.9967971  74.47049  72.2332  72.00184
## 23   23  74.36584 0.9951800  74.72602  72.5288  72.17921
## 24   24  74.56313 0.9952927  74.91578  72.8244  72.48160
## 25   25  75.03523 0.9978153  75.19952  73.1200  72.96026
## 26   26  75.47210 1.0032105  75.23057  73.4156  73.65130
## 27   27  75.72576 1.0039008  75.43152  73.7112  73.99873
## 28   28  75.86669 1.0039129  75.57099  74.0068  74.29638
## 29   29  75.93715 1.0033303  75.68509  74.3024  74.54985
## 30   30  76.14149 1.0020913  75.98258  74.5980  74.75401
## 31   31  76.19786 1.0004405  76.16431  74.8936  74.92659
## 32   32  76.22604 0.9992753  76.28132  75.1892  75.13471
## 33   33  76.40924 0.9987533  76.50463  75.4848  75.39069
## 34   34  76.47971 0.9967971  76.72545  75.7804  75.53768
## 35   35  76.61359 0.9951800  76.98465  76.0760  75.70931
## 36   36  76.89543 0.9952927  77.25911  76.3716  76.01210
## 37   37  77.29002 0.9978153  77.45924  76.6672  76.49971
## 38   38  77.81144 1.0032105  77.56243  76.9628  77.20989
## 39   39  77.95941 1.0039008  77.65649  77.2584  77.55977
## 40   40  77.99464 1.0039129  77.69065  77.5540  77.85746
## 41   41  78.17080 1.0033303  77.91133  77.8496  78.10886
## 42   42  78.27649 1.0020913  78.11313  78.1452  78.30863
## 43   43  78.28354 1.0004405  78.24907  78.4408  78.47535
## 44   44  78.31877 0.9992753  78.37557  78.7364  78.67934
## 45   45  78.60062 0.9987533  78.69874  79.0320  78.93347
## 46   46  78.67108 0.9967971  78.92387  79.3276  79.07352
## 47   47  78.67108 0.9951800  79.05212  79.6232  79.23941
## 48   48  78.74154 0.9952927  79.11395  79.9188  79.54260
## 49   49  78.92475 0.9978153  79.09755  80.2144  80.03916
## 50   50  79.43207 1.0032105  79.17787  80.5100  80.76848
## 51   51  79.60823 1.0039008  79.29890  80.8056  81.12081
## 52   52  79.71392 1.0039129  79.40323  81.1012  81.41854
## 53   53  79.95349 1.0033303  79.68811  81.3968  81.66788
## 54   54  80.22125 1.0020913  80.05383  81.6924  81.86325
## 55   55  80.20011 1.0004405  80.16480  81.9880  82.02411
## 56   56  80.24944 0.9992753  80.30763  82.2836  82.22397
## 57   57  80.46082 0.9987533  80.56126  82.5792  82.47624
## 58   58  80.48196 0.9967971  80.74057  82.8748  82.60936
## 59   59  80.41150 0.9951800  80.80096  83.1704  82.76952
## 60   60  80.60175 0.9952927  80.98296  83.4660  83.07310
## 61   61  80.89064 0.9978153  81.06775  83.7616  83.57861
## 62   62  81.44025 1.0032105  81.17962  84.0572  84.32707
## 63   63  81.69391 1.0039008  81.37648  84.3528  84.68184
## 64   64  81.98985 1.0039129  81.67029  84.6484  84.97962
## 65   65  82.16601 1.0033303  81.89328  84.9440  85.22689
## 66   66  82.34921 1.0020913  82.17735  85.2396  85.41786
## 67   67  82.40558 1.0004405  82.36930  85.5352  85.57288
## 68   68  82.53241 0.9992753  82.59226  85.8308  85.76860
## 69   69  82.63106 0.9987533  82.73421  86.1264  86.01902
## 70   70  82.82835 0.9967971  83.09450  86.4220  86.14520
## 71   71  82.96223 0.9951800  83.36405  86.7176  86.29962
## 72   72  83.22999 0.9952927  83.62363  87.0132  86.60361
## 73   73  83.47661 0.9978153  83.65937  87.3088  87.11806
## 74   74  84.22351 1.0032105  83.95397  87.6044  87.88566
## 75   75  84.51945 1.0039008  84.19104  87.9000  88.24288
## 76   76  84.80834 1.0039129  84.47779  88.1956  88.54070
## 77   77  85.21702 1.0033303  84.93417  88.4912  88.78590
## 78   78  85.41432 1.0020913  85.23606  88.7868  88.97248
## 79   79  85.68912 1.0004405  85.65139  89.0824  89.12164
## 80   80  85.99915 0.9992753  86.06152  89.3780  89.31323
## 81   81  86.41488 0.9987533  86.52275  89.6736  89.56180
## 82   82  86.76015 0.9967971  87.03893  89.9692  89.68103
## 83   83  87.15474 0.9951800  87.57686  90.2648  89.82972
## 84   84  87.52818 0.9952927  87.94215  90.5604  90.13411
## 85   85  88.10598 0.9978153  88.29888  90.8560  90.65751
## 86   86  89.17700 1.0032105  88.89161  91.1516  91.44425
## 87   87  89.76184 1.0039008  89.41306  91.4472  91.80392
## 88   88  89.90981 1.0039129  89.55937  91.7428  92.10178
## 89   89  90.38895 1.0033303  90.08893  92.0384  92.34492
## 90   90  90.81172 1.0020913  90.62220  92.3340  92.52710
## 91   91  91.05130 1.0004405  91.01121  92.6296  92.67040
## 92   92  91.24154 0.9992753  91.30771  92.9252  92.85786
## 93   93  91.53044 0.9987533  91.64470  93.2208  93.10458
## 94   94  91.65727 0.9967971  91.95179  93.5164  93.21687
## 95   95  91.78410 0.9951800  92.22865  93.8120  93.35982
## 96   96  92.02368 0.9952927  92.45890  94.1076  93.66461
## 97   97  92.73534 0.9978153  92.93838  94.4032  94.19696
## 98   98  93.78523 1.0032105  93.48509  94.6988  95.00284
## 99   99  94.36302 1.0039008  93.99636  94.9944  95.36495
## 100 100  94.94786 1.0039129  94.57779  95.2900  95.66286
## 101 101  95.22266 1.0033303  94.90659  95.5856  95.90393
## 102 102  95.46223 1.0020913  95.26301  95.8812  96.08172
## 103 103  95.41291 1.0004405  95.37090  96.1768  96.21916
## 104 104  95.63134 0.9992753  95.70069  96.4724  96.40249
## 105 105  95.84977 0.9987533  95.96942  96.7680  96.64735
## 106 106  95.96956 0.9967971  96.27793  97.0636  96.75271
## 107 107  96.18799 0.9951800  96.65387  97.3592  96.88992
## 108 108  96.63191 0.9952927  97.08893  97.6548  97.19511
## 109 109  97.01240 0.9978153  97.22480  97.9504  97.73641
## 110 110  97.91432 1.0032105  97.60097  98.2460  98.56142
## 111 111  98.18912 1.0039008  97.80759  98.5416  98.92599
## 112 112  98.56257 1.0039129  98.17841  98.8372  99.22394
## 113 113  98.88670 1.0033303  98.55847  99.1328  99.46294
## 114 114  99.09808 1.0020913  98.89127  99.4284  99.63634
## 115 115  99.14741 1.0004405  99.10375  99.7240  99.76793
## 116 116  99.29538 0.9992753  99.36739 100.0196  99.94712
## 117 117  99.40812 0.9987533  99.53221 100.3152 100.19013
## 118 118  99.59837 0.9967971  99.91840 100.6108 100.28855
## 119 119  99.74634 0.9951800 100.22945 100.9064 100.42003
## 120 120 100.00000 0.9952927 100.47295 101.2020 100.72562
## 121 121 100.46000 0.9978153 100.67995 101.4976 101.27586
## 122 122 101.10000 1.0032105 100.77645 101.7932 102.12001
## 123 123 101.44000 1.0039008 101.04584 102.0888 102.48703
## 124 124 101.84000 1.0039129 101.44307 102.3844 102.78502
## 125 125 102.10000 1.0033303 101.76111 102.6800 103.02195
## 126 126 102.27000 1.0020913 102.05657 102.9756 103.19096
## 127 127 102.41000 1.0004405 102.36491 103.2712 103.31669
## 128 128 102.54000 0.9992753 102.61436 103.5668 103.49175
## 129 129 102.73000 0.9987533 102.85824 103.8624 103.73291
## 130 130 102.87000 0.9967971 103.20054 104.1580 103.82439
## 131 131 103.09000 0.9951800 103.58930 104.4536 103.95013
## 132 132 103.45000 0.9952927 103.93927 104.7492 104.25612
## 133 133 103.82000 0.9978153 104.04731 105.0448 104.81531
## 134 134 104.47000 1.0032105 104.13567 105.3404 105.67860
## 135 135 104.75000 1.0039008 104.34298 105.6360 106.04806
## 136 136 104.55000 1.0039129 104.14250 105.9316 106.34610
## 137 137 104.14000 1.0033303 103.79433 106.2272 106.58097
## 138 138 103.70000 1.0020913 103.48358 106.5228 106.74557
## 139 139 103.86000 1.0004405 103.81427 106.8184 106.86545
## 140 140 103.94000 0.9992753 104.01538 107.1140 107.03638
## 141 141 104.34000 0.9987533 104.47025 107.4096 107.27569
## 142 142 104.33000 0.9967971 104.66524 107.7052 107.36023
## 143 143 104.13000 0.9951800 104.63434 108.0008 107.48023
## 144 144 104.52000 0.9952927 105.01433 108.2964 107.78662
## 145 145 104.74000 0.9978153 104.96932 108.5920 108.35476
## 146 146 105.45000 1.0032105 105.11253 108.8876 109.23719
## 147 147 105.86000 1.0039008 105.44867 109.1832 109.60910
## 148 148 106.18000 1.0039129 105.76615 109.4788 109.90718
## 149 149 106.34000 1.0033303 105.98703 109.7744 110.13998
## 150 150 106.50000 1.0020913 106.27774 110.0700 110.30019
## 151 151 106.83000 1.0004405 106.78296 110.3656 110.41421
## 152 152 107.17000 0.9992753 107.24772 110.6612 110.58101
## 153 153 107.50000 0.9987533 107.63419 110.9568 110.81846
## 154 154 107.32000 0.9967971 107.66484 111.2524 110.89607
## 155 155 107.64000 0.9951800 108.16134 111.5480 111.01033
## 156 156 108.12000 0.9952927 108.63136 111.8436 111.31712
## 157 157 109.43000 0.9978153 109.66959 112.1392 111.89421
## 158 158 110.83000 1.0032105 110.47531 112.4348 112.79578
## 159 159 111.47000 1.0039008 111.03687 112.7304 113.17014
## 160 160 112.48000 1.0039129 112.04160 113.0260 113.46826
## 161 161 113.25000 1.0033303 112.87410 113.3216 113.69899
## 162 162 113.78000 1.0020913 113.54255 113.6172 113.85481
## 163 163 114.61000 1.0004405 114.55954 113.9128 113.96298
## 164 164 115.56000 0.9992753 115.64380 114.2084 114.12564
## 165 165 116.45000 0.9987533 116.59537 114.5040 114.36124
## 166 166 117.14000 0.9967971 117.51640 114.7996 114.43190
## 167 167 117.84000 0.9951800 118.41074 115.0952 114.54044
## 168 168 118.92000 0.9952927 119.48243 115.3908 114.84763
## 169 169 120.84000 0.9978153 121.10457 115.6864 115.43366
## 170 170 122.86000 1.0032105 122.46681 115.9820 116.35437
## 171 171 124.20000 1.0039008 123.71740 116.2776 116.73117
## 172 172 125.43000 1.0039129 124.94112 116.5732 117.02933
## 173 173 126.37000 1.0033303 125.95055 116.8688 117.25801
## 174 174 127.00000 1.0020913 126.73496 117.1644 117.40943
## 175 175 127.73000 1.0004405 127.67376 117.4600 117.51174
## 176 176 128.49000 0.9992753 128.58318 117.7556 117.67027
## 177 177 129.12000 0.9987533 129.28118 118.0512 117.90402
## 178 178 129.45000 0.9967971 129.86595 118.3468 117.96774
## 179 179 130.35000 0.9951800 130.98134 118.6424 118.07054
## 180 180 131.21000 0.9952927 131.83056 118.9380 118.37813
ECM<- mean((Tabla$x-Tabla$ProE)^2)#Calcular el Error Cuadrado medio
ECM
## [1] 12.07281
# pronóstico año siguiente
Ano16<-data.frame(mes = seq(181,192))
Ano16
##    mes
## 1  181
## 2  182
## 3  183
## 4  184
## 5  185
## 6  186
## 7  187
## 8  188
## 9  189
## 10 190
## 11 191
## 12 192
PronosticoDE<-0.2956*Ano16+65.7300 
PronosticoDE
##         mes
## 1  119.2336
## 2  119.5292
## 3  119.8248
## 4  120.1204
## 5  120.4160
## 6  120.7116
## 7  121.0072
## 8  121.3028
## 9  121.5984
## 10 121.8940
## 11 122.1896
## 12 122.4852
PronosticoE<-PronosticoDE*ie
PronosticoE
##         mes
## 1  118.9731
## 2  119.9130
## 3  120.2922
## 4  120.5904
## 5  120.8170
## 6  120.9640
## 7  121.0605
## 8  121.2149
## 9  121.4468
## 10 121.5036
## 11 121.6006
## 12 121.9086

Establecer cinco (5) conclusiones

  1. La serie de tiempo es multiplicativa
  2. El mayor efecto estacional se observa en el mes 4 (abril), teniendo en cuenta que el índice estacional es de 1.0039 y es el máximo.
  3. El menor efecto estacional se observa en el mes 11 (noviembre), teniendo en cuenta que el índice estacional es de 0.9951 y es el mínimo.
  4. El error cuadrado medio ECM es 12.07
  5. El pronóstico del IPC sin alimentos para el mes de diciembre de 2024 es 121.9086