Remítase de nuevo a los datos de la serie de tiempo de ventas de gasolina en la tabla 6.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.
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.
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)
# 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
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
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
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
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"
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"
Respuesta: teniendo en cuenta el criterio del ECM prefiero una constante de suavización de \(\alpha = 0.2\)
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.
## 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"
## 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.
Respuesta: el pronóstico para el mes siguiente es 83.3 usando promedio móvil de 3 meses.
Suponga que los datos siguientes son por ventas trimestrales para los siete años pasados:
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"))
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")
Respuesta: el mayor efecto estacional se observa en el trimestre 2, teniendo en cuenta que el índice estacional es de 1.36.
Considere el escenario presentado de Costello Music presentado en el problema 20 y los datos de ventas trimestrales siguientes:
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.
Identificar una serie económica (una sola variable) de Colombia con mínimo 10 años y datos mensuales o trimestrales y establecer:
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")
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