library(prophet)
library(tseries)
library(dplyr)
library(lubridate)
library(zoo)
library(xts)
library(cowplot)
library(ggplot2)
library(readxl)
Data <- read_excel("F:/Master Big Data/TFM/Base de Datos 18-23 (AFP).xlsx")
Data$MES <- as.Date(Data$MES, format = "%Y-%m-%d")
datos_porcentajes <- Data %>%
mutate_at(vars(-MES), function(x) as.numeric(x) * 100)
head(datos_porcentajes)
## # A tibble: 6 × 8
## MES ATLÁNTICO `SCOTIA CRECER` `JMMB-BDI` POPULAR RESERVAS ROMANA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2018-01-01 12.4 10.5 9.15 10.8 11.0 11.3
## 2 2018-02-01 12.5 10.7 8.84 11.1 11.5 11.2
## 3 2018-03-01 11.7 10.3 8.88 10.6 11.0 10.8
## 4 2018-04-01 11.5 10.3 8.97 10.7 11.0 10.7
## 5 2018-05-01 11.3 10.1 9.05 10.4 10.8 10.5
## 6 2018-06-01 10.5 9.81 9.19 10 10.4 9.91
## # ℹ 1 more variable: SIEMBRA <dbl>
AFP_Atlantico <- datos_porcentajes[, c("MES", "ATLÁNTICO")] %>% rename(Rentabilidad = ATLÁNTICO)
print(AFP_Atlantico)
## # A tibble: 72 × 2
## MES Rentabilidad
## <date> <dbl>
## 1 2018-01-01 12.4
## 2 2018-02-01 12.5
## 3 2018-03-01 11.7
## 4 2018-04-01 11.5
## 5 2018-05-01 11.3
## 6 2018-06-01 10.5
## 7 2018-07-01 10.3
## 8 2018-08-01 9.71
## 9 2018-09-01 9.53
## 10 2018-10-01 8.96
## # ℹ 62 more rows
AFP_Atlantico <- AFP_Atlantico %>% rename(y = Rentabilidad, ds = MES)
train_AFP_Atlantico <- subset(AFP_Atlantico, ds < as.Date("2023-01-01"))
test_AFP_Atlantico <- subset(AFP_Atlantico, ds >= as.Date("2023-01-01"))
evaluate_model <- function(train, test, changepoint_prior_scale,seasonality_prior_scale, n_changepoints, changepoint_range) {
m <- prophet(
train,
changepoint.prior.scale = changepoint_prior_scale,
seasonality.prior.scale = seasonality_prior_scale,
n.changepoints = n_changepoints,
changepoint.range = changepoint_range
)
future <- make_future_dataframe(m, periods = nrow(test), freq = 'month')
forecast <- predict(m, future)
y_pred <- forecast$yhat[(nrow(forecast) - nrow(test) + 1):nrow(forecast)]
y_true <- test$y
mape <- mean(abs((y_pred - y_true) / y_true)) * 100
return(mape)
}
changepoint_prior_scales <- c(0.01, 0.1, 0.5)
seasonality_prior_scales <- c(0.01, 0.1, 1, 10)
n.changepoints <- c(5,10,15,20,25)
changepoint.range <- c(0.8, 0.9, 0.95)
results <- expand.grid(
changepoint_prior_scale = changepoint_prior_scales,
seasonality_prior_scale = seasonality_prior_scales,
n.changepoints = n.changepoints,
changepoint.range = changepoint.range
)
results$mape <- NA
for (i in 1:nrow(results)) {
results$mape[i] <- evaluate_model(
train_AFP_Atlantico,
test_AFP_Atlantico,
results$changepoint_prior_scale[i],
results$seasonality_prior_scale[i],
results$n.changepoints[i],
results$changepoint.range[i]
)
}
best_paramsAlt <- results[which.min(results$mape), ]
print(best_paramsAlt)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 162 0.5 0.1 20
## changepoint.range mape
## 162 0.95 4.804778
Resultados_Atlántico <- results
print(Resultados_Atlántico)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 1 0.01 0.01 5
## 2 0.10 0.01 5
## 3 0.50 0.01 5
## 4 0.01 0.10 5
## 5 0.10 0.10 5
## 6 0.50 0.10 5
## 7 0.01 1.00 5
## 8 0.10 1.00 5
## 9 0.50 1.00 5
## 10 0.01 10.00 5
## 11 0.10 10.00 5
## 12 0.50 10.00 5
## 13 0.01 0.01 10
## 14 0.10 0.01 10
## 15 0.50 0.01 10
## 16 0.01 0.10 10
## 17 0.10 0.10 10
## 18 0.50 0.10 10
## 19 0.01 1.00 10
## 20 0.10 1.00 10
## 21 0.50 1.00 10
## 22 0.01 10.00 10
## 23 0.10 10.00 10
## 24 0.50 10.00 10
## 25 0.01 0.01 15
## 26 0.10 0.01 15
## 27 0.50 0.01 15
## 28 0.01 0.10 15
## 29 0.10 0.10 15
## 30 0.50 0.10 15
## 31 0.01 1.00 15
## 32 0.10 1.00 15
## 33 0.50 1.00 15
## 34 0.01 10.00 15
## 35 0.10 10.00 15
## 36 0.50 10.00 15
## 37 0.01 0.01 20
## 38 0.10 0.01 20
## 39 0.50 0.01 20
## 40 0.01 0.10 20
## 41 0.10 0.10 20
## 42 0.50 0.10 20
## 43 0.01 1.00 20
## 44 0.10 1.00 20
## 45 0.50 1.00 20
## 46 0.01 10.00 20
## 47 0.10 10.00 20
## 48 0.50 10.00 20
## 49 0.01 0.01 25
## 50 0.10 0.01 25
## 51 0.50 0.01 25
## 52 0.01 0.10 25
## 53 0.10 0.10 25
## 54 0.50 0.10 25
## 55 0.01 1.00 25
## 56 0.10 1.00 25
## 57 0.50 1.00 25
## 58 0.01 10.00 25
## 59 0.10 10.00 25
## 60 0.50 10.00 25
## 61 0.01 0.01 5
## 62 0.10 0.01 5
## 63 0.50 0.01 5
## 64 0.01 0.10 5
## 65 0.10 0.10 5
## 66 0.50 0.10 5
## 67 0.01 1.00 5
## 68 0.10 1.00 5
## 69 0.50 1.00 5
## 70 0.01 10.00 5
## 71 0.10 10.00 5
## 72 0.50 10.00 5
## 73 0.01 0.01 10
## 74 0.10 0.01 10
## 75 0.50 0.01 10
## 76 0.01 0.10 10
## 77 0.10 0.10 10
## 78 0.50 0.10 10
## 79 0.01 1.00 10
## 80 0.10 1.00 10
## 81 0.50 1.00 10
## 82 0.01 10.00 10
## 83 0.10 10.00 10
## 84 0.50 10.00 10
## 85 0.01 0.01 15
## 86 0.10 0.01 15
## 87 0.50 0.01 15
## 88 0.01 0.10 15
## 89 0.10 0.10 15
## 90 0.50 0.10 15
## 91 0.01 1.00 15
## 92 0.10 1.00 15
## 93 0.50 1.00 15
## 94 0.01 10.00 15
## 95 0.10 10.00 15
## 96 0.50 10.00 15
## 97 0.01 0.01 20
## 98 0.10 0.01 20
## 99 0.50 0.01 20
## 100 0.01 0.10 20
## 101 0.10 0.10 20
## 102 0.50 0.10 20
## 103 0.01 1.00 20
## 104 0.10 1.00 20
## 105 0.50 1.00 20
## 106 0.01 10.00 20
## 107 0.10 10.00 20
## 108 0.50 10.00 20
## 109 0.01 0.01 25
## 110 0.10 0.01 25
## 111 0.50 0.01 25
## 112 0.01 0.10 25
## 113 0.10 0.10 25
## 114 0.50 0.10 25
## 115 0.01 1.00 25
## 116 0.10 1.00 25
## 117 0.50 1.00 25
## 118 0.01 10.00 25
## 119 0.10 10.00 25
## 120 0.50 10.00 25
## 121 0.01 0.01 5
## 122 0.10 0.01 5
## 123 0.50 0.01 5
## 124 0.01 0.10 5
## 125 0.10 0.10 5
## 126 0.50 0.10 5
## 127 0.01 1.00 5
## 128 0.10 1.00 5
## 129 0.50 1.00 5
## 130 0.01 10.00 5
## 131 0.10 10.00 5
## 132 0.50 10.00 5
## 133 0.01 0.01 10
## 134 0.10 0.01 10
## 135 0.50 0.01 10
## 136 0.01 0.10 10
## 137 0.10 0.10 10
## 138 0.50 0.10 10
## 139 0.01 1.00 10
## 140 0.10 1.00 10
## 141 0.50 1.00 10
## 142 0.01 10.00 10
## 143 0.10 10.00 10
## 144 0.50 10.00 10
## 145 0.01 0.01 15
## 146 0.10 0.01 15
## 147 0.50 0.01 15
## 148 0.01 0.10 15
## 149 0.10 0.10 15
## 150 0.50 0.10 15
## 151 0.01 1.00 15
## 152 0.10 1.00 15
## 153 0.50 1.00 15
## 154 0.01 10.00 15
## 155 0.10 10.00 15
## 156 0.50 10.00 15
## 157 0.01 0.01 20
## 158 0.10 0.01 20
## 159 0.50 0.01 20
## 160 0.01 0.10 20
## 161 0.10 0.10 20
## 162 0.50 0.10 20
## 163 0.01 1.00 20
## 164 0.10 1.00 20
## 165 0.50 1.00 20
## 166 0.01 10.00 20
## 167 0.10 10.00 20
## 168 0.50 10.00 20
## 169 0.01 0.01 25
## 170 0.10 0.01 25
## 171 0.50 0.01 25
## 172 0.01 0.10 25
## 173 0.10 0.10 25
## 174 0.50 0.10 25
## 175 0.01 1.00 25
## 176 0.10 1.00 25
## 177 0.50 1.00 25
## 178 0.01 10.00 25
## 179 0.10 10.00 25
## 180 0.50 10.00 25
## changepoint.range mape
## 1 0.80 39.547512
## 2 0.80 30.607835
## 3 0.80 93.239533
## 4 0.80 41.274736
## 5 0.80 41.320224
## 6 0.80 95.138828
## 7 0.80 41.530299
## 8 0.80 41.488460
## 9 0.80 96.018443
## 10 0.80 41.549102
## 11 0.80 41.489384
## 12 0.80 96.061284
## 13 0.80 39.690958
## 14 0.80 30.849746
## 15 0.80 93.962269
## 16 0.80 41.274727
## 17 0.80 41.254777
## 18 0.80 95.366596
## 19 0.80 41.501204
## 20 0.80 41.440308
## 21 0.80 95.720798
## 22 0.80 41.551599
## 23 0.80 41.486739
## 24 0.80 95.748123
## 25 0.80 39.479643
## 26 0.80 25.253352
## 27 0.80 85.888137
## 28 0.80 41.274737
## 29 0.80 41.277767
## 30 0.80 84.499819
## 31 0.80 41.500732
## 32 0.80 41.373969
## 33 0.80 85.033283
## 34 0.80 41.538269
## 35 0.80 27.436544
## 36 0.80 85.067073
## 37 0.80 39.581542
## 38 0.80 22.343915
## 39 0.80 84.716441
## 40 0.80 41.274766
## 41 0.80 41.201633
## 42 0.80 84.751118
## 43 0.80 41.500738
## 44 0.80 41.384657
## 45 0.80 85.067941
## 46 0.80 41.550845
## 47 0.80 24.097820
## 48 0.80 85.066252
## 49 0.80 41.184980
## 50 0.80 30.125581
## 51 0.80 84.614077
## 52 0.80 41.274751
## 53 0.80 41.151958
## 54 0.80 84.734977
## 55 0.80 41.500940
## 56 0.80 24.423460
## 57 0.80 84.801430
## 58 0.80 41.551028
## 59 0.80 24.048043
## 60 0.80 84.726900
## 61 0.90 39.187116
## 62 0.90 35.581923
## 63 0.90 95.753126
## 64 0.90 41.270207
## 65 0.90 41.251035
## 66 0.90 105.270199
## 67 0.90 41.497950
## 68 0.90 41.474132
## 69 0.90 106.763512
## 70 0.90 41.584451
## 71 0.90 41.524424
## 72 0.90 106.807110
## 73 0.90 39.557079
## 74 0.90 39.393151
## 75 0.90 98.858312
## 76 0.90 41.274760
## 77 0.90 41.240104
## 78 0.90 102.297744
## 79 0.90 41.514161
## 80 0.90 41.462693
## 81 0.90 103.013343
## 82 0.90 41.565096
## 83 0.90 41.512718
## 84 0.90 103.044049
## 85 0.90 39.477159
## 86 0.90 22.889313
## 87 0.90 86.811781
## 88 0.90 41.274724
## 89 0.90 41.198393
## 90 0.90 89.494396
## 91 0.90 41.500559
## 92 0.90 41.638229
## 93 0.90 89.190856
## 94 0.90 41.543246
## 95 0.90 41.443644
## 96 0.90 89.215809
## 97 0.90 39.674928
## 98 0.90 22.289378
## 99 0.90 84.968250
## 100 0.90 41.274805
## 101 0.90 41.075652
## 102 0.90 85.134241
## 103 0.90 41.501028
## 104 0.90 24.496552
## 105 0.90 85.171001
## 106 0.90 41.551036
## 107 0.90 24.012994
## 108 0.90 85.173455
## 109 0.90 38.834771
## 110 0.90 22.269849
## 111 0.90 84.882170
## 112 0.90 41.274777
## 113 0.90 41.073836
## 114 0.90 85.117826
## 115 0.90 41.500950
## 116 0.90 41.470606
## 117 0.90 84.529864
## 118 0.90 41.551021
## 119 0.90 24.274114
## 120 0.90 85.072816
## 121 0.95 39.440547
## 122 0.95 22.539287
## 123 0.95 60.710032
## 124 0.95 41.274769
## 125 0.95 41.240071
## 126 0.95 62.818410
## 127 0.95 41.486576
## 128 0.95 41.499005
## 129 0.95 62.450318
## 130 0.95 41.540061
## 131 0.95 41.556285
## 132 0.95 62.476214
## 133 0.95 39.538495
## 134 0.95 22.282317
## 135 0.95 46.462797
## 136 0.95 41.274733
## 137 0.95 41.217254
## 138 0.95 46.213392
## 139 0.95 41.513588
## 140 0.95 24.183749
## 141 0.95 44.378201
## 142 0.95 41.563122
## 143 0.95 24.277059
## 144 0.95 44.368849
## 145 0.95 39.504519
## 146 0.95 39.376798
## 147 0.95 22.375045
## 148 0.95 41.274783
## 149 0.95 41.285993
## 150 0.95 19.390535
## 151 0.95 41.500848
## 152 0.95 41.357564
## 153 0.95 23.687927
## 154 0.95 41.548040
## 155 0.95 41.486004
## 156 0.95 23.916279
## 157 0.95 39.964569
## 158 0.95 22.306414
## 159 0.95 19.348662
## 160 0.95 41.274787
## 161 0.95 41.173585
## 162 0.95 4.804778
## 163 0.95 41.500874
## 164 0.95 41.311226
## 165 0.95 6.225585
## 166 0.95 41.550934
## 167 0.95 24.275606
## 168 0.95 6.316132
## 169 0.95 39.632058
## 170 0.95 30.332027
## 171 0.95 10.430878
## 172 0.95 41.274769
## 173 0.95 41.214937
## 174 0.95 4.997811
## 175 0.95 41.501036
## 176 0.95 41.461882
## 177 0.95 5.191622
## 178 0.95 41.551108
## 179 0.95 41.390018
## 180 0.95 5.196634
results_sorted <- results[order(results$mape), ]
# Extraer los primeros 10 resultados
top_10_results <- head(results_sorted, 10)
# Mostrar los primeros 10 resultados
print(top_10_results)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 162 0.5 0.10 20
## 174 0.5 0.10 25
## 177 0.5 1.00 25
## 180 0.5 10.00 25
## 165 0.5 1.00 20
## 168 0.5 10.00 20
## 171 0.5 0.01 25
## 159 0.5 0.01 20
## 150 0.5 0.10 15
## 110 0.1 0.01 25
## changepoint.range mape
## 162 0.95 4.804778
## 174 0.95 4.997811
## 177 0.95 5.191622
## 180 0.95 5.196634
## 165 0.95 6.225585
## 168 0.95 6.316132
## 171 0.95 10.430878
## 159 0.95 19.348662
## 150 0.95 19.390535
## 110 0.90 22.269849
best_modelAlt <- prophet(
train_AFP_Atlantico,
changepoint.prior.scale = best_paramsAlt$changepoint_prior_scale,
n.changepoints = best_paramsAlt$n.changepoints,
seasonality.prior.scale = best_paramsAlt$seasonality_prior_scale,
changepoint.range = best_paramsAlt$changepoint.range
)
future <- make_future_dataframe(best_modelAlt, periods = nrow(test_AFP_Atlantico), freq = 'month')
forecast <- predict(best_modelAlt, future)
forecast$ds <- as.POSIXct(forecast$ds)
test_AFP_Atlantico$ds <- as.POSIXct(test_AFP_Atlantico$ds)
p1 <- plot(best_modelAlt, forecast) + ggtitle("Modelo Prophet Atlántico") + xlab("Tiempo") +
ylab("Rentabilidad")
GraficoAtl <- p1 + geom_line(data = test_AFP_Atlantico, aes(x = ds, y = y, color = 'Datos de prueba')) +
geom_line(data = forecast, aes(x = ds, y = yhat, color = 'Predicciones')) +
geom_line(data = best_modelAlt$history, aes(x = ds, y = y), color = 'black') +
scale_color_manual(name = "Series", values = c('Datos de prueba' = 'red', 'Predicciones' = 'blue')) +
guides(color = guide_legend(title = "Leyenda"))
plot(GraficoAtl)
y_predAtl <- forecast$yhat[(nrow(forecast) - nrow(test_AFP_Atlantico) + 1):nrow(forecast)]
y_trueAtl <- test_AFP_Atlantico$y
mapeAtl <- mean(abs((y_predAtl - y_trueAtl) / y_trueAtl)) * 100
rmseAtl <- sqrt(mean((y_predAtl - y_trueAtl)^2))
maeAtl <- mean(abs(y_predAtl - y_trueAtl))
cat("MAPE:", mapeAtl, "%\n")
## MAPE: 4.804778 %
cat("RMSE:", rmseAtl, "\n")
## RMSE: 0.4326925
cat("MAE:", maeAtl, "\n")
## MAE: 0.3506161
AFP_Crecer <- datos_porcentajes[, c("MES", "SCOTIA CRECER")] %>% rename(Rentabilidad = `SCOTIA CRECER`)
print(AFP_Crecer)
## # A tibble: 72 × 2
## MES Rentabilidad
## <date> <dbl>
## 1 2018-01-01 10.5
## 2 2018-02-01 10.7
## 3 2018-03-01 10.3
## 4 2018-04-01 10.3
## 5 2018-05-01 10.1
## 6 2018-06-01 9.81
## 7 2018-07-01 9.78
## 8 2018-08-01 9.44
## 9 2018-09-01 9.29
## 10 2018-10-01 8.84
## # ℹ 62 more rows
AFP_Crecer <- AFP_Crecer %>% rename(y = Rentabilidad, ds = MES)
train_AFP_Crecer <- subset(AFP_Crecer, ds < as.Date("2023-01-01"))
test_AFP_Crecer <- subset(AFP_Crecer, ds >= as.Date("2023-01-01"))
results$mape <- NA
for (i in 1:nrow(results)) {
results$mape[i] <- evaluate_model(
train_AFP_Crecer,
test_AFP_Crecer,
results$changepoint_prior_scale[i],
results$seasonality_prior_scale[i],
results$n.changepoints[i],
results$changepoint.range[i]
)
}
best_paramsCre <- results[which.min(results$mape), ]
print(best_paramsCre)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 62 0.1 0.01 5
## changepoint.range mape
## 62 0.9 20.79303
Resultados_Crecer <- results
print(results)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 1 0.01 0.01 5
## 2 0.10 0.01 5
## 3 0.50 0.01 5
## 4 0.01 0.10 5
## 5 0.10 0.10 5
## 6 0.50 0.10 5
## 7 0.01 1.00 5
## 8 0.10 1.00 5
## 9 0.50 1.00 5
## 10 0.01 10.00 5
## 11 0.10 10.00 5
## 12 0.50 10.00 5
## 13 0.01 0.01 10
## 14 0.10 0.01 10
## 15 0.50 0.01 10
## 16 0.01 0.10 10
## 17 0.10 0.10 10
## 18 0.50 0.10 10
## 19 0.01 1.00 10
## 20 0.10 1.00 10
## 21 0.50 1.00 10
## 22 0.01 10.00 10
## 23 0.10 10.00 10
## 24 0.50 10.00 10
## 25 0.01 0.01 15
## 26 0.10 0.01 15
## 27 0.50 0.01 15
## 28 0.01 0.10 15
## 29 0.10 0.10 15
## 30 0.50 0.10 15
## 31 0.01 1.00 15
## 32 0.10 1.00 15
## 33 0.50 1.00 15
## 34 0.01 10.00 15
## 35 0.10 10.00 15
## 36 0.50 10.00 15
## 37 0.01 0.01 20
## 38 0.10 0.01 20
## 39 0.50 0.01 20
## 40 0.01 0.10 20
## 41 0.10 0.10 20
## 42 0.50 0.10 20
## 43 0.01 1.00 20
## 44 0.10 1.00 20
## 45 0.50 1.00 20
## 46 0.01 10.00 20
## 47 0.10 10.00 20
## 48 0.50 10.00 20
## 49 0.01 0.01 25
## 50 0.10 0.01 25
## 51 0.50 0.01 25
## 52 0.01 0.10 25
## 53 0.10 0.10 25
## 54 0.50 0.10 25
## 55 0.01 1.00 25
## 56 0.10 1.00 25
## 57 0.50 1.00 25
## 58 0.01 10.00 25
## 59 0.10 10.00 25
## 60 0.50 10.00 25
## 61 0.01 0.01 5
## 62 0.10 0.01 5
## 63 0.50 0.01 5
## 64 0.01 0.10 5
## 65 0.10 0.10 5
## 66 0.50 0.10 5
## 67 0.01 1.00 5
## 68 0.10 1.00 5
## 69 0.50 1.00 5
## 70 0.01 10.00 5
## 71 0.10 10.00 5
## 72 0.50 10.00 5
## 73 0.01 0.01 10
## 74 0.10 0.01 10
## 75 0.50 0.01 10
## 76 0.01 0.10 10
## 77 0.10 0.10 10
## 78 0.50 0.10 10
## 79 0.01 1.00 10
## 80 0.10 1.00 10
## 81 0.50 1.00 10
## 82 0.01 10.00 10
## 83 0.10 10.00 10
## 84 0.50 10.00 10
## 85 0.01 0.01 15
## 86 0.10 0.01 15
## 87 0.50 0.01 15
## 88 0.01 0.10 15
## 89 0.10 0.10 15
## 90 0.50 0.10 15
## 91 0.01 1.00 15
## 92 0.10 1.00 15
## 93 0.50 1.00 15
## 94 0.01 10.00 15
## 95 0.10 10.00 15
## 96 0.50 10.00 15
## 97 0.01 0.01 20
## 98 0.10 0.01 20
## 99 0.50 0.01 20
## 100 0.01 0.10 20
## 101 0.10 0.10 20
## 102 0.50 0.10 20
## 103 0.01 1.00 20
## 104 0.10 1.00 20
## 105 0.50 1.00 20
## 106 0.01 10.00 20
## 107 0.10 10.00 20
## 108 0.50 10.00 20
## 109 0.01 0.01 25
## 110 0.10 0.01 25
## 111 0.50 0.01 25
## 112 0.01 0.10 25
## 113 0.10 0.10 25
## 114 0.50 0.10 25
## 115 0.01 1.00 25
## 116 0.10 1.00 25
## 117 0.50 1.00 25
## 118 0.01 10.00 25
## 119 0.10 10.00 25
## 120 0.50 10.00 25
## 121 0.01 0.01 5
## 122 0.10 0.01 5
## 123 0.50 0.01 5
## 124 0.01 0.10 5
## 125 0.10 0.10 5
## 126 0.50 0.10 5
## 127 0.01 1.00 5
## 128 0.10 1.00 5
## 129 0.50 1.00 5
## 130 0.01 10.00 5
## 131 0.10 10.00 5
## 132 0.50 10.00 5
## 133 0.01 0.01 10
## 134 0.10 0.01 10
## 135 0.50 0.01 10
## 136 0.01 0.10 10
## 137 0.10 0.10 10
## 138 0.50 0.10 10
## 139 0.01 1.00 10
## 140 0.10 1.00 10
## 141 0.50 1.00 10
## 142 0.01 10.00 10
## 143 0.10 10.00 10
## 144 0.50 10.00 10
## 145 0.01 0.01 15
## 146 0.10 0.01 15
## 147 0.50 0.01 15
## 148 0.01 0.10 15
## 149 0.10 0.10 15
## 150 0.50 0.10 15
## 151 0.01 1.00 15
## 152 0.10 1.00 15
## 153 0.50 1.00 15
## 154 0.01 10.00 15
## 155 0.10 10.00 15
## 156 0.50 10.00 15
## 157 0.01 0.01 20
## 158 0.10 0.01 20
## 159 0.50 0.01 20
## 160 0.01 0.10 20
## 161 0.10 0.10 20
## 162 0.50 0.10 20
## 163 0.01 1.00 20
## 164 0.10 1.00 20
## 165 0.50 1.00 20
## 166 0.01 10.00 20
## 167 0.10 10.00 20
## 168 0.50 10.00 20
## 169 0.01 0.01 25
## 170 0.10 0.01 25
## 171 0.50 0.01 25
## 172 0.01 0.10 25
## 173 0.10 0.10 25
## 174 0.50 0.10 25
## 175 0.01 1.00 25
## 176 0.10 1.00 25
## 177 0.50 1.00 25
## 178 0.01 10.00 25
## 179 0.10 10.00 25
## 180 0.50 10.00 25
## changepoint.range mape
## 1 0.80 37.75704
## 2 0.80 66.58069
## 3 0.80 106.36155
## 4 0.80 39.45186
## 5 0.80 63.35954
## 6 0.80 107.52584
## 7 0.80 39.50453
## 8 0.80 68.02688
## 9 0.80 107.99671
## 10 0.80 39.35481
## 11 0.80 66.43459
## 12 0.80 108.01092
## 13 0.80 37.63566
## 14 0.80 73.82808
## 15 0.80 106.52332
## 16 0.80 39.27271
## 17 0.80 73.41436
## 18 0.80 107.18173
## 19 0.80 39.22214
## 20 0.80 74.29469
## 21 0.80 107.46745
## 22 0.80 39.22331
## 23 0.80 74.32146
## 24 0.80 107.46161
## 25 0.80 37.93006
## 26 0.80 74.63134
## 27 0.80 105.03833
## 28 0.80 39.55174
## 29 0.80 74.51301
## 30 0.80 104.89508
## 31 0.80 39.58198
## 32 0.80 75.48079
## 33 0.80 105.08671
## 34 0.80 39.36332
## 35 0.80 75.49300
## 36 0.80 105.09550
## 37 0.80 38.21265
## 38 0.80 50.62902
## 39 0.80 102.12470
## 40 0.80 39.51112
## 41 0.80 73.47713
## 42 0.80 101.47493
## 43 0.80 39.59311
## 44 0.80 76.07766
## 45 0.80 103.51248
## 46 0.80 39.39260
## 47 0.80 50.81513
## 48 0.80 103.54478
## 49 0.80 37.91696
## 50 0.80 74.81656
## 51 0.80 101.68033
## 52 0.80 39.49836
## 53 0.80 74.55186
## 54 0.80 101.14424
## 55 0.80 39.74293
## 56 0.80 75.43320
## 57 0.80 101.89748
## 58 0.80 39.12103
## 59 0.80 76.94875
## 60 0.80 101.90462
## 61 0.90 37.85582
## 62 0.90 20.79303
## 63 0.90 128.63125
## 64 0.90 39.52139
## 65 0.90 22.63053
## 66 0.90 139.40071
## 67 0.90 39.35296
## 68 0.90 22.70432
## 69 0.90 140.24537
## 70 0.90 39.32617
## 71 0.90 22.69703
## 72 0.90 140.26122
## 73 0.90 37.77769
## 74 0.90 83.33891
## 75 0.90 116.65403
## 76 0.90 39.12969
## 77 0.90 85.01654
## 78 0.90 119.06984
## 79 0.90 39.31540
## 80 0.90 22.71098
## 81 0.90 119.34465
## 82 0.90 39.35035
## 83 0.90 22.72968
## 84 0.90 119.34358
## 85 0.90 37.43766
## 86 0.90 63.27789
## 87 0.90 101.11632
## 88 0.90 39.46736
## 89 0.90 62.39665
## 90 0.90 101.22955
## 91 0.90 39.26916
## 92 0.90 62.90018
## 93 0.90 101.50663
## 94 0.90 39.31503
## 95 0.90 62.96154
## 96 0.90 101.51707
## 97 0.90 38.01322
## 98 0.90 75.30040
## 99 0.90 102.99756
## 100 0.90 39.49296
## 101 0.90 83.93505
## 102 0.90 102.54117
## 103 0.90 39.67573
## 104 0.90 78.96710
## 105 0.90 103.97580
## 106 0.90 39.50046
## 107 0.90 77.96125
## 108 0.90 104.02832
## 109 0.90 37.82497
## 110 0.90 74.69064
## 111 0.90 101.86089
## 112 0.90 39.56858
## 113 0.90 40.82800
## 114 0.90 101.23243
## 115 0.90 38.65865
## 116 0.90 51.16349
## 117 0.90 102.35763
## 118 0.90 39.50149
## 119 0.90 75.54309
## 120 0.90 102.38797
## 121 0.95 37.82240
## 122 0.95 49.00537
## 123 0.95 88.59494
## 124 0.95 39.39620
## 125 0.95 47.95783
## 126 0.95 89.08960
## 127 0.95 39.53042
## 128 0.95 48.70878
## 129 0.95 89.26372
## 130 0.95 39.37311
## 131 0.95 48.68058
## 132 0.95 89.26511
## 133 0.95 37.71709
## 134 0.95 48.90920
## 135 0.95 107.01681
## 136 0.95 39.36161
## 137 0.95 47.93557
## 138 0.95 109.61376
## 139 0.95 39.29267
## 140 0.95 40.89776
## 141 0.95 111.04285
## 142 0.95 39.31372
## 143 0.95 48.75560
## 144 0.95 111.10978
## 145 0.95 37.59269
## 146 0.95 60.01728
## 147 0.95 84.69789
## 148 0.95 39.21580
## 149 0.95 48.94460
## 150 0.95 92.18954
## 151 0.95 39.56998
## 152 0.95 48.72772
## 153 0.95 90.83416
## 154 0.95 39.32064
## 155 0.95 49.33255
## 156 0.95 90.86239
## 157 0.95 37.92503
## 158 0.95 73.47964
## 159 0.95 82.75081
## 160 0.95 39.28897
## 161 0.95 72.51499
## 162 0.95 76.61890
## 163 0.95 39.45613
## 164 0.95 48.71336
## 165 0.95 78.27221
## 166 0.95 39.32036
## 167 0.95 50.56758
## 168 0.95 78.39896
## 169 0.95 37.85831
## 170 0.95 74.04511
## 171 0.95 86.30754
## 172 0.95 39.68460
## 173 0.95 74.46441
## 174 0.95 88.25664
## 175 0.95 39.72187
## 176 0.95 75.48724
## 177 0.95 82.60915
## 178 0.95 39.15496
## 179 0.95 51.11519
## 180 0.95 85.36819
best_modelCre <- prophet(
train_AFP_Crecer,
changepoint.prior.scale = best_paramsCre$changepoint_prior_scale,
n.changepoints = best_paramsCre$n.changepoints,
seasonality.prior.scale = best_paramsCre$seasonality_prior_scale,
changepoint.range = best_paramsCre$changepoint.range
)
future2 <- make_future_dataframe(best_modelCre, periods = nrow(test_AFP_Crecer), freq = 'month')
forecast2 <- predict(best_modelCre, future2)
forecast2$ds <- as.POSIXct(forecast2$ds)
test_AFP_Crecer$ds <- as.POSIXct(test_AFP_Crecer$ds)
p2 <- plot(best_modelCre, forecast2) + ggtitle("Modelo Prophet Crecer") + xlab("Tiempo") +
ylab("Rentabilidad")
GraficoCre <- p2 + geom_line(data = test_AFP_Crecer, aes(x = ds, y = y, color = 'Datos de prueba')) +
geom_line(data = forecast2, aes(x = ds, y = yhat, color = 'Predicciones')) +
geom_line(data = best_modelCre$history, aes(x = ds, y = y), color = 'black') +
scale_color_manual(name = "Series", values = c('Datos de prueba' = 'red', 'Predicciones' = 'blue')) +
guides(color = guide_legend(title = "Leyenda"))
plot(GraficoCre)
y_predCre <- forecast2$yhat[(nrow(forecast2) - nrow(test_AFP_Crecer) + 1):nrow(forecast2)]
y_trueCre <- test_AFP_Crecer$y
mapeCre <- mean(abs((y_predCre - y_trueCre) / y_trueCre)) * 100
rmseCre <- sqrt(mean((y_predCre - y_trueCre)^2))
maeCre <- mean(abs(y_predCre - y_trueCre))
cat("MAPE:", mapeCre, "%\n")
## MAPE: 20.79303 %
cat("RMSE:", rmseCre, "\n")
## RMSE: 2.033818
cat("MAE:", maeCre, "\n")
## MAE: 1.623921
AFP_Reservas <- datos_porcentajes[, c("MES", "RESERVAS")] %>% rename(Rentabilidad = RESERVAS)
AFP_Reservas <- AFP_Reservas %>% rename(y = Rentabilidad, ds = MES)
train_AFP_Reservas <- subset(AFP_Reservas, ds < as.Date("2023-01-01"))
test_AFP_Reservas <- subset(AFP_Reservas, ds >= as.Date("2023-01-01"))
results$mape <- NA
for (i in 1:nrow(results)) {
results$mape[i] <- evaluate_model(
train_AFP_Reservas,
test_AFP_Reservas,
results$changepoint_prior_scale[i],
results$seasonality_prior_scale[i],
results$n.changepoints[i],
results$changepoint.range[i]
)
}
best_paramsRev <- results[which.min(results$mape), ]
print(best_paramsRev)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 1 0.01 0.01 5
## changepoint.range mape
## 1 0.8 16.43311
best_modelRev <- prophet(
train_AFP_Reservas,
changepoint.prior.scale = best_paramsRev$changepoint_prior_scale,
n.changepoints = best_paramsRev$n.changepoints,
seasonality.prior.scale = best_paramsRev$seasonality_prior_scale,
changepoint.range = best_paramsRev$changepoint.range
)
future3 <- make_future_dataframe(best_modelRev, periods = nrow(test_AFP_Reservas), freq = 'month')
forecast3 <- predict(best_modelRev, future3)
forecast3$ds <- as.POSIXct(forecast3$ds)
test_AFP_Reservas$ds <- as.POSIXct(test_AFP_Reservas$ds)
p3 <- plot(best_modelRev, forecast3) + ggtitle("Modelo Prophet Reservas") + xlab("Tiempo") +
ylab("Rentabilidad")
GraficoRev <- p3 + geom_line(data = test_AFP_Reservas, aes(x = ds, y = y, color = 'Datos de prueba')) +
geom_line(data = forecast3, aes(x = ds, y = yhat, color = 'Predicciones')) +
geom_line(data = best_modelRev$history, aes(x = ds, y = y), color = 'black') +
scale_color_manual(name = "Series", values = c('Datos de prueba' = 'red', 'Predicciones' = 'blue')) +
guides(color = guide_legend(title = "Leyenda"))
plot(GraficoRev)
y_predRev <- forecast3$yhat[(nrow(forecast3) - nrow(test_AFP_Reservas) + 1):nrow(forecast3)]
y_trueRev <- test_AFP_Reservas$y
mapeRev <- mean(abs((y_predRev - y_trueRev) / y_trueRev)) * 100
rmseRev <- sqrt(mean((y_predRev - y_trueRev)^2))
maeRev <- mean(abs(y_predRev - y_trueRev))
cat("MAPE:", mapeRev, "%\n")
## MAPE: 16.43311 %
cat("RMSE:", rmseRev, "\n")
## RMSE: 1.436526
cat("MAE:", maeRev, "\n")
## MAE: 1.197009
AFP_Popular <- datos_porcentajes[, c("MES", "POPULAR")] %>% rename(Rentabilidad = POPULAR)
AFP_Popular <- AFP_Popular %>% rename(y = Rentabilidad, ds = MES)
train_AFP_Popular <- subset(AFP_Popular, ds < as.Date("2023-01-01"))
test_AFP_Popular <- subset(AFP_Popular, ds >= as.Date("2023-01-01"))
results$mape <- NA
for (i in 1:nrow(results)) {
results$mape[i] <- evaluate_model(
train_AFP_Popular,
test_AFP_Popular,
results$changepoint_prior_scale[i],
results$seasonality_prior_scale[i],
results$n.changepoints[i],
results$changepoint.range[i]
)
}
best_paramsPop <- results[which.min(results$mape), ]
print(best_paramsPop)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 145 0.01 0.01 15
## changepoint.range mape
## 145 0.95 24.18126
best_modelPop <- prophet(
train_AFP_Popular,
changepoint.prior.scale = best_paramsPop$changepoint_prior_scale,
n.changepoints = best_paramsPop$n.changepoints,
seasonality.prior.scale = best_paramsPop$seasonality_prior_scale,
changepoint.range = best_paramsPop$changepoint.range
)
future4 <- make_future_dataframe(best_modelPop, periods = nrow(test_AFP_Popular), freq = 'month')
forecast4 <- predict(best_modelPop, future4)
forecast4$ds <- as.POSIXct(forecast4$ds)
test_AFP_Popular$ds <- as.POSIXct(test_AFP_Popular$ds)
p4 <- plot(best_modelPop, forecast4) + ggtitle("Modelo Prophet Popular") + xlab("Tiempo") +
ylab("Rentabilidad")
GraficoPop <- p4 + geom_line(data = test_AFP_Reservas, aes(x = ds, y = y, color = 'Datos de prueba')) +
geom_line(data = forecast4, aes(x = ds, y = yhat, color = 'Predicciones')) +
geom_line(data = best_modelPop$history, aes(x = ds, y = y), color = 'black') +
scale_color_manual(name = "Series", values = c('Datos de prueba' = 'red', 'Predicciones' = 'blue')) +
guides(color = guide_legend(title = "Leyenda"))
plot(GraficoPop)
y_predPop <- forecast4$yhat[(nrow(forecast4) - nrow(test_AFP_Popular) + 1):nrow(forecast4)]
y_truePop <- test_AFP_Popular$y
mapePop <- mean(abs((y_predPop - y_truePop) / y_truePop)) * 100
rmsePop <- sqrt(mean((y_predPop - y_truePop)^2))
maePop <- mean(abs(y_predPop - y_truePop))
cat("MAPE:", mapePop, "%\n")
## MAPE: 24.18126 %
cat("RMSE:", rmsePop, "\n")
## RMSE: 1.795221
cat("MAE:", maePop, "\n")
## MAE: 1.609913
AFP_Romana <- datos_porcentajes[, c("MES", "ROMANA")] %>% rename(Rentabilidad = ROMANA)
AFP_Romana <- AFP_Romana %>% rename(y = Rentabilidad, ds = MES)
train_AFP_Romana <- subset(AFP_Romana, ds < as.Date("2023-01-01"))
test_AFP_Romana <- subset(AFP_Romana, ds >= as.Date("2023-01-01"))
results$mape <- NA
for (i in 1:nrow(results)) {
results$mape[i] <- evaluate_model(
train_AFP_Romana,
test_AFP_Romana,
results$changepoint_prior_scale[i],
results$seasonality_prior_scale[i],
results$n.changepoints[i],
results$changepoint.range[i]
)
}
best_paramsRom <- results[which.min(results$mape), ]
print(best_paramsRom)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 180 0.5 10 25
## changepoint.range mape
## 180 0.95 6.059101
best_modelRom <- prophet(
train_AFP_Romana,
changepoint.prior.scale = best_paramsRom$changepoint_prior_scale,
n.changepoints = best_paramsRom$n.changepoints,
seasonality.prior.scale = best_paramsRom$seasonality_prior_scale,
changepoint.range = best_paramsRom$changepoint.range
)
future5 <- make_future_dataframe(best_modelRom, periods = nrow(test_AFP_Romana), freq = 'month')
forecast5 <- predict(best_modelRom, future5)
forecast5$ds <- as.POSIXct(forecast5$ds)
test_AFP_Romana$ds <- as.POSIXct(test_AFP_Romana$ds)
p5 <- plot(best_modelRom, forecast5) + ggtitle("Modelo Prophet Romana") + xlab("Tiempo") +
ylab("Rentabilidad")
GraficoRom <- p5 + geom_line(data = test_AFP_Romana, aes(x = ds, y = y, color = 'Datos de prueba')) +
geom_line(data = forecast5, aes(x = ds, y = yhat, color = 'Predicciones')) +
geom_line(data = best_modelRom$history, aes(x = ds, y = y), color = 'black') +
scale_color_manual(name = "Series", values = c('Datos de prueba' = 'red', 'Predicciones' = 'blue')) +
guides(color = guide_legend(title = "Leyenda"))
plot(GraficoRom)
y_predRom <- forecast5$yhat[(nrow(forecast5) - nrow(test_AFP_Romana) + 1):nrow(forecast5)]
y_trueRom <- test_AFP_Romana$y
mapeRom <- mean(abs((y_predRom - y_trueRom) / y_trueRom)) * 100
rmseRom <- sqrt(mean((y_predRom - y_trueRom)^2))
maeRom <- mean(abs(y_predRom - y_trueRom))
cat("MAPE:", mapeRom, "%\n")
## MAPE: 6.059101 %
cat("RMSE:", rmseRom, "\n")
## RMSE: 0.4584734
cat("MAE:", maeRom, "\n")
## MAE: 0.409542
AFP_Siembra <- datos_porcentajes[, c("MES", "SIEMBRA")] %>% rename(Rentabilidad = SIEMBRA)
AFP_Siembra <- AFP_Siembra %>% rename(y = Rentabilidad, ds = MES)
train_AFP_Siembra <- subset(AFP_Siembra, ds < as.Date("2023-01-01"))
test_AFP_Siembra <- subset(AFP_Siembra, ds >= as.Date("2023-01-01"))
results$mape <- NA
for (i in 1:nrow(results)) {
results$mape[i] <- evaluate_model(
train_AFP_Siembra,
test_AFP_Siembra,
results$changepoint_prior_scale[i],
results$seasonality_prior_scale[i],
results$n.changepoints[i],
results$changepoint.range[i]
)
}
best_paramsSiem <- results[which.min(results$mape), ]
print(best_paramsSiem)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 61 0.01 0.01 5
## changepoint.range mape
## 61 0.9 15.38312
best_modelSiem <- prophet(
train_AFP_Siembra,
changepoint.prior.scale = best_paramsSiem$changepoint_prior_scale,
n.changepoints = best_paramsSiem$n.changepoints,
seasonality.prior.scale = best_paramsSiem$seasonality_prior_scale,
changepoint.range = best_paramsSiem$changepoint.range
)
future6 <- make_future_dataframe(best_modelSiem, periods = nrow(test_AFP_Siembra), freq = 'month')
forecast6 <- predict(best_modelSiem, future6)
forecast6$ds <- as.POSIXct(forecast6$ds)
test_AFP_Siembra$ds <- as.POSIXct(test_AFP_Siembra$ds)
p6 <- plot(best_modelSiem, forecast6) + ggtitle("Modelo Prophet Siembra") + xlab("Tiempo") +
ylab("Rentabilidad")
GraficoSiem <- p6 + geom_line(data = test_AFP_Siembra, aes(x = ds, y = y, color = 'Datos de prueba')) +
geom_line(data = forecast6, aes(x = ds, y = yhat, color = 'Predicciones')) +
geom_line(data = best_modelSiem$history, aes(x = ds, y = y), color = 'black') +
scale_color_manual(name = "Series", values = c('Datos de prueba' = 'red', 'Predicciones' = 'blue')) +
guides(color = guide_legend(title = "Leyenda"))
plot(GraficoSiem)
y_predSiem <- forecast6$yhat[(nrow(forecast6) - nrow(test_AFP_Siembra) + 1):nrow(forecast6)]
y_trueSiem <- test_AFP_Siembra$y
mapeSiem <- mean(abs((y_predSiem - y_trueSiem) / y_trueSiem)) * 100
rmseSiem <- sqrt(mean((y_predSiem - y_trueSiem)^2))
maeSiem <- mean(abs(y_predSiem - y_trueSiem))
cat("MAPE:", mapeSiem, "%\n")
## MAPE: 15.38312 %
cat("RMSE:", rmseSiem, "\n")
## RMSE: 1.311838
cat("MAE:", maeSiem, "\n")
## MAE: 1.17412
AFP_Jmmb <- datos_porcentajes[, c("MES", "JMMB-BDI")] %>% rename(Rentabilidad = `JMMB-BDI`)
AFP_Jmmb <- AFP_Jmmb %>% rename(y = Rentabilidad, ds = MES)
train_AFP_Jmmb <- subset(AFP_Jmmb, ds < as.Date("2023-01-01"))
test_AFP_Jmmb <- subset(AFP_Jmmb, ds >= as.Date("2023-01-01"))
results$mape <- NA
for (i in 1:nrow(results)) {
results$mape[i] <- evaluate_model(
train_AFP_Jmmb,
test_AFP_Jmmb,
results$changepoint_prior_scale[i],
results$seasonality_prior_scale[i],
results$n.changepoints[i],
results$changepoint.range[i]
)
}
best_paramsJmmb <- results[which.min(results$mape), ]
print(best_paramsJmmb)
## changepoint_prior_scale seasonality_prior_scale n.changepoints
## 168 0.5 10 20
## changepoint.range mape
## 168 0.95 4.66692
best_modelJmmb <- prophet(
train_AFP_Jmmb,
changepoint.prior.scale = best_paramsJmmb$changepoint_prior_scale,
n.changepoints = best_paramsJmmb$n.changepoints,
seasonality.prior.scale = best_paramsJmmb$seasonality_prior_scale,
changepoint.range = best_paramsJmmb$changepoint.range
)
future7 <- make_future_dataframe(best_modelJmmb, periods = nrow(test_AFP_Jmmb), freq = 'month')
forecast7 <- predict(best_modelJmmb, future7)
forecast7$ds <- as.POSIXct(forecast7$ds)
test_AFP_Jmmb$ds <- as.POSIXct(test_AFP_Jmmb$ds)
p7 <- plot(best_modelJmmb, forecast7) + ggtitle("Modelo Prophet Jmmb-BDI") + xlab("Tiempo") +
ylab("Rentabilidad")
GraficoJmmb <- p7 + geom_line(data = test_AFP_Jmmb, aes(x = ds, y = y, color = 'Datos de prueba')) +
geom_line(data = forecast7, aes(x = ds, y = yhat, color = 'Predicciones')) +
geom_line(data = best_modelJmmb$history, aes(x = ds, y = y), color = 'black') +
scale_color_manual(name = "Series", values = c('Datos de prueba' = 'red', 'Predicciones' = 'blue')) +
guides(color = guide_legend(title = "Leyenda"))
plot(GraficoJmmb)
y_predJmmb <- forecast7$yhat[(nrow(forecast7) - nrow(test_AFP_Jmmb) + 1):nrow(forecast7)]
y_trueJmmb <- test_AFP_Jmmb$y
mapeJmmb <- mean(abs((y_predJmmb - y_trueJmmb) / y_trueJmmb)) * 100
rmseJmmb <- sqrt(mean((y_predJmmb - y_trueJmmb)^2))
maeJmmb <- mean(abs(y_predJmmb - y_trueJmmb))
cat("MAPE:", mapeJmmb, "%\n")
## MAPE: 4.66692 %
cat("RMSE:", rmseJmmb, "\n")
## RMSE: 0.5714602
cat("MAE:", maeJmmb, "\n")
## MAE: 0.4232377
GraficoAtl <- GraficoAtl + theme(legend.position = "none")
GraficoCre <- GraficoCre + theme(legend.position = "none")
GraficoJmmb <- GraficoJmmb + theme(legend.position = "none")
GraficoPop <- GraficoPop + theme(legend.position = "none")
GraficoRev <- GraficoRev + theme(legend.position = "none")
GraficoRom <- GraficoRom + theme(legend.position = "none")
GraficoSiem <- GraficoSiem + theme(legend.position = "none")
legend_plot <- ggplot(data.frame(x = 1:2, y = 1:2, col = c("Datos de prueba", "Predicciones")), aes(x, y, color = col)) +
geom_line() +
scale_color_manual(values = c("Datos de prueba" = "red", "Predicciones" = "blue")) +
theme(legend.position = "bottom",
legend.text = element_text(size = 15)) + # Ajusta el tamaño del texto de la leyenda
guides(color = guide_legend(title = NULL))
# Extraer la leyenda
legend <- get_legend(legend_plot)
## `geom_line()`: Each group consists of only one observation.
## ℹ Do you need to adjust the group aesthetic?
# Combinar los gráficos
combined_plot <- plot_grid(
plot_grid(GraficoAtl, GraficoCre, GraficoJmmb, GraficoPop, GraficoRev, GraficoRom, GraficoSiem, nrow = 3),
legend,
ncol = 1,
rel_heights = c(1, 0.05) # Aumentar la proporción de altura de la leyenda
)
# Mostrar el gráfico combinado
print(combined_plot)
