Cargamos la base con los datos
library(readxl)
datos<- read_excel("datos.xlsx")
View(datos)
Serie
y1.ts<-ts(datos$Valor,start=c(1,1), end=c(10,12), frequency=12)
y1.ts
## Jan Feb Mar Apr May Jun Jul
## 1 1097579.7 1139406.3 1031375.0 1084178.6 1097279.9 1033228.6 1096599.6
## 2 1209742.5 1179054.5 1132814.4 1174273.1 1183965.6 1109957.4 1129256.4
## 3 985393.0 978239.0 970398.7 982426.9 1003499.0 965012.0 987466.1
## 4 993973.3 984308.1 981604.5 1014805.6 1098345.4 1036842.6 1044159.9
## 5 1424919.3 1352388.7 1318252.9 1415754.2 1383410.2 1303897.5 1424081.2
## 6 1039517.0 1055425.9 599788.9 607268.5 611225.2 610493.0 552393.6
## 7 1140511.7 1154099.6 1128032.2 1160125.3 1182944.1 1163078.3 1176603.5
## 8 1158428.2 1167534.5 1196343.3 1204178.1 1247906.8 1218612.1 1251034.7
## 9 1289872.7 1327923.0 1326136.8 1349593.6 1326758.2 1363480.4 1377146.6
## 10 1450171.4 1441435.9 1482481.9 1489979.1 1524765.7 1520208.1 1478445.4
## Aug Sep Oct Nov Dec
## 1 1083270.7 1047842.4 1261394.6 1198867.4 1152980.1
## 2 1297804.6 1144340.9 1143649.5 1200119.2 1201489.5
## 3 1014463.7 1016216.8 979280.5 1022969.1 977346.4
## 4 1038050.0 1025060.3 1032874.8 1045309.6 1029554.2
## 5 1370839.0 1350887.7 1410507.7 1313091.8 1320071.7
## 6 1000288.1 999929.9 1000820.9 1023480.3 987087.9
## 7 1134978.4 1136889.5 1132467.7 1143222.5 1116162.2
## 8 1242539.4 1233224.8 1249152.0 1268161.1 1259513.7
## 9 1370571.5 1400932.9 1396536.9 1420145.7 1381082.6
## 10 1507951.8 1521553.6 1518872.0 1539505.7 1533277.1
plot(y1.ts)
summary(y1.ts)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 552394 1033140 1159277 1174321 1326292 1539506
class(y1.ts)
## [1] "ts"
start(y1.ts)
## [1] 1 1
end(y1.ts)
## [1] 10 12
Determinamos si la serie es aditiva o multiplicativa
cv_d1<- abs(sd(datos$Valor[13:120]-datos$Valor[1:108])/
mean(datos$Valor[13:120]-datos$Valor[1:108]))
cv_d1
## [1] 6.272601
cv_c1 <- abs(sd(datos$Valor[13:120] / datos$Valor[1:108]) / mean(datos$Valor[13:120] / datos$Valor[1:108]))
cv_c1
## [1] 0.2603789
cbind(cv_d1,cv_c1)
## cv_d1 cv_c1
## [1,] 6.272601 0.2603789
if(cv_d1<cv_c1) {
"se elige el esquema aditivo"
} else {"se elige el esquema multiplicativo"}
## [1] "se elige el esquema multiplicativo"
Comparando los coeficientes de variación, se encontró que el esquema multiplicativo (cv_c1 = 0.2603789) es más adecuado que el aditivo (cv_d1 = 6.272601), ya que presenta una menor variabilidad relativa. Orientando el análisis hacia un modelo multiplicativo.
Modelo Holt-winters multiplicativo
Asignando valores a alfa, beta y gamma
hw1<-HoltWinters(y1.ts, alpha=0.1, beta=0.2, gamma=0.3,
seasonal = "multiplicative") #si fuera aditiva aquí iría additive
hw1
## Holt-Winters exponential smoothing with trend and multiplicative seasonal component.
##
## Call:
## HoltWinters(x = y1.ts, alpha = 0.1, beta = 0.2, gamma = 0.3, seasonal = "multiplicative")
##
## Smoothing parameters:
## alpha: 0.1
## beta : 0.2
## gamma: 0.3
##
## Coefficients:
## [,1]
## a 1.525831e+06
## b 1.097916e+04
## s1 1.057334e+00
## s2 1.054331e+00
## s3 1.022299e+00
## s4 1.028273e+00
## s5 1.030454e+00
## s6 1.004788e+00
## s7 9.941508e-01
## s8 1.021456e+00
## s9 1.016405e+00
## s10 1.022835e+00
## s11 1.029050e+00
## s12 1.008900e+00
plot(hw1)
Alfa1<-hw1$alpha
Alfa1
## [1] 0.1
Beta1<-hw1$beta
Beta1
## [1] 0.2
Gamma1<-hw1$gamma
Gamma1
## [1] 0.3
hw1$fitted #mirar los pronosticados Ft+m
## xhat level trend season
## Jan 2 1169587.8 1111565.1 6006.1208 1.0465443
## Feb 2 1140560.7 1121408.1 6773.4970 1.0109726
## Mar 2 1094662.2 1131989.2 7535.0178 0.9606310
## Apr 2 1147837.0 1143495.8 8329.3326 0.9965375
## May 2 1173722.1 1154477.9 8859.8928 1.0089263
## Jun 2 1107925.7 1164353.1 9062.9519 0.9441883
## Jul 2 1161183.2 1173631.2 9105.9861 0.9817762
## Aug 2 1145616.9 1179485.3 8455.5973 0.9643720
## Sep 2 1127790.0 1203721.9 11611.8016 0.9279674
## Oct 2 1363345.5 1217117.2 11968.5153 1.1092354
## Nov 2 1275052.4 1209279.7 8007.3000 1.0474543
## Dec 2 1218406.6 1210133.1 6576.5317 1.0013947
## Jan 3 1289908.8 1215020.3 6238.6607 1.0562123
## Feb 3 1216942.4 1192428.1 472.4760 1.0201541
## Mar 3 1129915.4 1169501.8 -4207.2766 0.9696394
## Apr 3 1144450.6 1148843.4 -7497.5044 1.0027202
## May 3 1127053.5 1125187.4 -10729.1871 1.0113016
## Jun 3 1028794.5 1102240.9 -13172.6600 0.9446557
## Jul 3 1040530.0 1082316.3 -14523.0474 0.9744677
## Aug 3 1045174.3 1062347.8 -15612.1331 0.9985083
## Sep 3 957196.4 1043660.0 -16227.2624 0.9316390
## Oct 3 1080122.7 1033767.9 -14960.2396 1.0601832
## Nov 3 1022936.2 1009295.9 -16862.5946 1.0307355
## Dec 3 973267.7 992436.5 -16861.9554 0.9976354
## Jan 4 946984.1 975983.4 -16780.1871 0.9872612
## Feb 4 914992.6 963962.7 -15828.2751 0.9650452
## Mar 4 877083.5 955317.1 -14391.7529 0.9321499
## Apr 4 906000.0 952138.2 -12149.1725 0.9638410
## May 4 923534.2 951277.8 -9891.4220 0.9810363
## Jun 4 884979.7 959205.4 -6327.6152 0.9287442
## Jul 4 928473.1 969229.2 -3057.3313 0.9609813
## Aug 4 968335.7 978210.3 -649.6496 0.9905634
## Sep 4 933185.7 984598.5 757.9192 0.9470539
## Oct 4 1030887.6 995057.5 2698.1382 1.0332065
## Nov 4 1031450.0 997948.0 2736.6042 1.0307444
## Dec 4 1003792.2 1002029.2 3005.5263 0.9987638
## Jan 5 1011562.8 1007614.1 3521.4030 1.0004226
## Feb 5 1047887.5 1052453.7 11785.0417 0.9846358
## Mar 5 1070600.3 1095164.0 17970.0930 0.9617892
## Apr 5 1155871.5 1138883.2 23119.9239 0.9947232
## May 5 1253263.9 1188129.3 28345.1507 1.0302427
## Jun 5 1223501.0 1229107.0 30871.6680 0.9710489
## Jul 5 1291566.3 1268258.0 32527.5377 0.9929125
## Aug 5 1362390.8 1314131.7 35196.7544 1.0096807
## Sep 5 1346711.3 1350165.1 35364.0984 0.9719833
## Oct 5 1469373.2 1385958.9 35450.0351 1.0337442
## Nov 5 1500021.0 1415714.6 34311.1543 1.0344789
## Dec 5 1470941.7 1431955.8 30697.1754 1.0056669
## Jan 6 1632422.8 1447651.0 27696.7780 1.1064665
## Feb 6 1524644.9 1421762.3 16979.6730 1.0597070
## Mar 6 1431342.6 1394463.7 8124.0365 1.0205013
## Apr 6 1383540.7 1321102.9 -8172.9294 1.0537810
## May 6 1287919.6 1239264.6 -22906.0130 1.0588321
## Jun 6 1103543.8 1152449.1 -35687.9146 0.9881646
## Jul 6 1041764.3 1066865.6 -45667.0376 1.0201389
## Aug 6 928403.6 973227.5 -55261.2359 1.0113701
## Sep 6 847533.9 925073.9 -53839.7093 0.9727969
## Oct 6 855022.4 886900.0 -50706.5589 1.0225175
## Nov 6 801981.6 850452.2 -47854.8047 0.9992328
## Dec 6 763784.7 824764.2 -43421.4290 0.9775283
## Jan 7 760642.7 804186.5 -38852.6974 0.9938706
## Feb 7 748292.1 803554.9 -31208.4641 0.9688555
## Mar 7 673127.7 814231.7 -22831.4164 0.8505527
## Apr 7 736694.4 844883.7 -12134.7368 0.8846537
## May 7 790503.8 880613.0 -2561.9329 0.9002937
## Jun 7 801045.8 921641.3 6156.1174 0.8633844
## Jul 7 870464.3 969729.2 14542.4745 0.8843740
## Aug 7 1074010.3 1018888.2 21465.7723 1.0323509
## Sep 7 1089420.0 1046259.7 22646.9227 1.0191910
## Oct 7 1172631.9 1073564.2 23578.4370 1.0688054
## Nov 7 1196293.1 1093384.8 22826.8654 1.0717440
## Dec 7 1192584.8 1111259.8 21836.5044 1.0525008
## Jan 8 1285495.8 1125835.3 20384.2939 1.1215092
## Feb 8 1272253.8 1134889.5 18118.2842 1.1034216
## Mar 8 1155013.8 1143517.4 16220.2014 0.9959268
## Apr 8 1198037.0 1163887.5 17050.1722 1.0144795
## May 8 1217008.1 1181543.0 17171.2394 1.0152613
## Jun 8 1175859.1 1201757.6 17779.9243 0.9641844
## Jul 8 1199766.5 1223971.7 18666.7455 0.9654993
## Aug 8 1328632.7 1247948.4 19728.7487 1.0480845
## Sep 8 1317318.2 1259462.8 18085.8777 1.0311295
## Oct 8 1361568.0 1269393.2 16454.7856 1.0588872
## Nov 8 1365453.3 1275231.6 14331.4994 1.0588496
## Dec 8 1337049.5 1280374.6 12493.8029 1.0341730
## Jan 9 1414695.9 1285371.0 10994.3278 1.0912787
## Feb 9 1395437.6 1284927.1 8706.6777 1.0786960
## Mar 9 1301970.1 1287374.9 7454.8965 1.0055145
## Apr 9 1325898.6 1297233.2 7935.5797 1.0158828
## May 9 1345120.7 1307501.2 8402.0709 1.0222033
## Jun 9 1287265.4 1314106.9 8042.7969 0.9736155
## Jul 9 1308228.4 1329977.8 9608.4053 0.9765914
## Aug 9 1397887.8 1346643.2 11019.8088 1.0296280
## Sep 9 1383582.3 1355010.0 10489.2027 1.0132429
## Oct 9 1426393.0 1367211.6 10831.6800 1.0350858
## Nov 9 1438520.7 1375158.8 10254.7988 1.0383330
## Dec 9 1418469.9 1383644.0 9900.8668 1.0178861
## Jan 10 1490045.2 1389871.8 9166.2598 1.0650498
## Feb 10 1494301.9 1395294.2 8417.4912 1.0645362
## Mar 10 1420997.2 1398745.6 7424.2693 1.0105445
## Apr 10 1450415.7 1412254.2 8641.1324 1.0207759
## May 10 1460620.2 1424771.1 9416.2972 1.0184305
## Jun 10 1435326.7 1440485.9 10675.9893 0.9890879
## Jul 10 1458017.4 1459743.7 12392.3452 0.9904094
## Aug 10 1522966.5 1474198.6 12804.8623 1.0241849
## Sep 10 1523020.5 1485537.4 12511.6585 1.0166693
## Oct 10 1554526.9 1497904.8 12482.8004 1.0292238
## Nov 10 1571484.6 1506923.3 11789.9489 1.0347474
## Dec 10 1543014.0 1515622.8 11171.8484 1.0106231
hw1$seasonal #validar
## [1] "multiplicative"
Buscando el optimo para el alfa, beta y gamma como en el solver
hw2<-HoltWinters(y1.ts, seasonal="multiplicative")
plot(hw2)
Alfa2<-hw2$alpha
Alfa2
## alpha
## 0.7605079
Beta2<-hw2$beta
Beta2
## beta
## 0
Gamma2<-hw2$gamma
Gamma2
## gamma
## 0.444251
hw2$fitted #mirar los pronosticados Ft+m
## xhat level trend season
## Jan 2 1169587.8 1111565.1 6006.121 1.0465443
## Feb 2 1165405.9 1146751.0 6006.121 1.0109726
## Mar 2 1123006.9 1163024.3 6006.121 0.9606310
## Apr 2 1178705.6 1176794.8 6006.121 0.9965375
## May 2 1196005.9 1179418.3 6006.121 1.0089263
## Jun 2 1116365.7 1176348.8 6006.121 0.9441883
## Jul 2 1161636.9 1177193.2 6006.121 0.9817762
## Aug 2 1122647.3 1158116.6 6006.121 0.9643720
## Sep 2 1214021.3 1302252.5 6006.121 0.9279674
## Oct 2 1394485.1 1251152.6 6006.121 1.1092354
## Nov 2 1142969.9 1085182.2 6006.121 1.0474543
## Dec 2 1140276.1 1132681.8 6006.121 1.0013947
## Jan 3 1251063.1 1185176.4 6006.121 1.0502698
## Feb 3 1017095.1 998808.9 6006.121 1.0122212
## Mar 3 943852.2 975621.4 6006.121 0.9615177
## Apr 3 1004734.8 1002624.4 6006.121 0.9961377
## May 3 1005424.0 991599.3 6006.121 1.0078373
## Jun 3 945646.4 996152.9 6006.121 0.9436092
## Jul 3 1002070.4 1017766.8 6006.121 0.9788014
## Aug 3 996721.3 1012425.7 6006.121 0.9786824
## Sep 3 957287.1 1032219.0 6006.121 0.9220419
## Oct 3 1185337.7 1086830.8 6006.121 1.0846428
## Nov 3 1004775.8 948357.9 6006.121 1.0528224
## Dec 3 980219.5 967506.0 6006.121 1.0068899
## Jan 4 998820.8 971342.1 6006.121 1.0219703
## Feb 4 987569.2 973740.9 6006.121 1.0079838
## Mar 4 948223.3 977286.6 6006.121 0.9643347
## Apr 4 1009270.8 1009618.3 6006.121 0.9937441
## May 4 1033695.4 1019860.2 6006.121 1.0076317
## Jun 4 1021914.9 1074660.7 6006.121 0.9456336
## Jul 4 1073701.7 1092672.2 6006.121 0.9772667
## Aug 4 1060614.1 1075689.0 6006.121 0.9805112
## Sep 4 992943.1 1064193.8 6006.121 0.9278108
## Oct 4 1170365.8 1096525.7 6006.121 1.0615256
## Nov 4 1065408.7 1004029.3 6006.121 1.0548231
## Dec 4 1008135.8 995544.3 6006.121 1.0065752
## Jan 5 1045688.6 1017732.9 6006.121 1.0214406
## Feb 5 1322109.0 1306093.1 6006.121 1.0076288
## Mar 5 1297850.4 1334952.8 6006.121 0.9678524
## Apr 5 1355257.0 1356990.6 6006.121 0.9943215
## May 5 1435133.7 1409268.1 6006.121 1.0140322
## Jun 5 1309337.1 1376482.4 6006.121 0.9470871
## Jul 5 1348616.6 1378120.6 6006.121 0.9743447
## Aug 5 1417526.6 1443029.3 6006.121 0.9782553
## Sep 5 1320749.2 1412739.9 6006.121 0.9309271
## Oct 5 1517430.2 1443367.3 6006.121 1.0469560
## Nov 5 1450282.1 1371705.0 6006.121 1.0526751
## Dec 5 1295926.6 1278597.6 6006.121 1.0088143
## Jan 6 1377305.8 1302805.8 6006.121 1.0523328
## Feb 6 1081454.4 1064696.2 6006.121 1.0100421
## Mar 6 1024817.8 1051104.2 6006.121 0.9694521
## Apr 6 728882.4 723687.1 6006.121 0.9988889
## May 6 649561.3 637102.0 6006.121 1.0100343
## Jun 6 587169.3 614242.9 6006.121 0.9466672
## Jul 6 632033.6 638986.1 6006.121 0.9799088
## Aug 6 574306.3 583183.6 6006.121 0.9747392
## Sep 6 865545.8 921547.9 6006.121 0.9331487
## Oct 6 1083410.3 1037075.8 6006.121 1.0386627
## Nov 6 1029405.7 982610.1 6006.121 1.0412592
## Dec 6 1000976.0 984288.5 6006.121 1.0107861
## Jan 7 1004166.3 979845.3 6006.121 1.0185777
## Feb 7 1101759.2 1087651.9 6006.121 1.0074074
## Mar 7 1033193.9 1133170.6 6006.121 0.9069654
## Apr 7 1198472.9 1218700.5 6006.121 0.9785796
## May 7 1204986.5 1194904.5 6006.121 1.0033940
## Jun 7 1131354.9 1184203.9 6006.121 0.9505507
## Jul 7 1179304.7 1215590.9 6006.121 0.9653794
## Aug 7 1254788.3 1219469.2 6006.121 1.0239197
## Sep 7 1081867.5 1136487.5 6006.121 0.9469353
## Oct 7 1228136.1 1186683.2 6006.121 1.0297201
## Nov 7 1173858.2 1122032.7 6006.121 1.0406187
## Dec 7 1121969.6 1105649.4 6006.121 1.0092781
## Jan 8 1148816.3 1107279.5 6006.121 1.0319151
## Feb 8 1140254.5 1120369.5 6006.121 1.0123217
## Mar 8 1055163.8 1146869.7 6006.121 0.9152450
## Apr 8 1244498.7 1270186.7 6006.121 0.9751651
## May 8 1252521.9 1244747.7 6006.121 1.0014136
## Jun 8 1194762.2 1247249.0 6006.121 0.9533273
## Jul 8 1233730.9 1272281.1 6006.121 0.9651438
## Aug 8 1314416.4 1291922.1 6006.121 1.0127034
## Sep 8 1189794.6 1243950.9 6006.121 0.9518684
## Oct 8 1317312.5 1284656.1 6006.121 1.0206485
## Nov 8 1292813.6 1239874.4 6006.121 1.0376707
## Dec 8 1244577.8 1227812.7 6006.121 1.0087201
## Jan 9 1292156.1 1245079.5 6006.121 1.0328279
## Feb 9 1274056.3 1249404.3 6006.121 1.0148525
## Mar 9 1206844.7 1295776.9 6006.121 0.9270706
## Apr 9 1365895.0 1399642.4 6006.121 0.9717187
## May 9 1400323.2 1392890.3 6006.121 1.0010199
## Jun 9 1288741.2 1343006.6 6006.121 0.9553217
## Jul 9 1367227.9 1408510.8 6006.121 0.9665688
## Aug 9 1437691.1 1422321.1 6006.121 1.0065558
## Sep 9 1322001.7 1377614.7 6006.121 0.9554653
## Oct 9 1473948.4 1446446.6 6006.121 1.0147996
## Nov 9 1450209.4 1394439.2 6006.121 1.0355344
## Dec 9 1398211.1 1378366.2 6006.121 1.0099964
## Jan 10 1422433.0 1371474.9 6006.121 1.0326334
## Feb 10 1430976.8 1397909.6 6006.121 1.0192754
## Mar 10 1327187.8 1411719.6 6006.121 0.9361386
## Apr 10 1504128.1 1543884.8 6006.121 0.9704736
## May 10 1537381.8 1538803.1 6006.121 0.9951920
## Jun 10 1481018.1 1535168.2 6006.121 0.9609673
## Jul 10 1526605.3 1572189.2 6006.121 0.9673107
## Aug 10 1548459.5 1540331.6 6006.121 1.0013721
## Sep 10 1462650.6 1515573.5 6006.121 0.9612711
## Oct 10 1588186.2 1568180.6 6006.121 1.0088932
## Nov 10 1578692.4 1521937.3 6006.121 1.0332139
## Dec 10 1518151.5 1499099.7 6006.121 1.0086676
hw2$seasonal #validar
## [1] "multiplicative"
Tabla<-data.frame(cbind(hw2$x[13:120],hw2$fitted))
Tabla
Calculo del error cuadrado medio
ECM<-mean(((Tabla$hw2.x.13.120.-Tabla$hw2.fitted.xhat)^2))
ECM
## [1] 10713439545
Predicción de 12 periodos
forecast2<-predict(hw2,n.ahead=12, prediction.interval = T, level=0.95)
plot(hw2,forecast2)
forecast2
## fit upr lwr
## Jan 11 1575415 1751931 1398900
## Feb 11 1559190 1792559 1325821
## Mar 11 1452954 1721087 1184821
## Apr 11 1493541 1808197 1178885
## May 11 1537753 1895174 1180332
## Jun 11 1496064 1876063 1116066
## Jul 11 1502420 1912886 1091955
## Aug 11 1562257 2014173 1110341
## Sep 11 1516016 1980018 1052013
## Oct 11 1582953 2089249 1076656
## Nov 11 1630740 2172572 1088907
## Dec 11 1604039 2128452 1079625
Se generaron pronósticos para los próximos 12 meses (año 2025) con el modelo optimizado, obteniendo valores que oscilan entre 1.452.954 (marzo) y 1.630.740 (noviembre), acompañados de intervalos de confianza al 95%.