Programación de Funciones
#Bias Proportion
Um<-function(pronosticado,observado){library(DescTools)
((mean(pronosticado)-mean(observado))*2)/MSE(pronosticado,observado)
}
#Variance Proportion
Us<-function(pronosticado,observado){
library(DescTools)
((sd(pronosticado)-sd(observado))*2)/MSE(pronosticado,observado)
}
#Covariance Proportion
Uc<-function(pronosticado,observado){
library(DescTools)
(2*(1-cor(pronosticado,observado))*sd(pronosticado)*sd(observado))/MSE(pronosticado,observado)
}
#Coeficiente U de Theil (también aparece en la Liberria "DescTools")
Theil_U<-function(pronosticado,observado){library(DescTools)
RMSE(pronosticado,observado)/(sqrt(mean(pronosticado^2))*sqrt(mean(observado^2)))}
Script de Simulación
options(scipen = 999999)
library(dplyr)
library(caret)
library(DescTools)
library(stargazer)
library(mlbench)
data(BostonHousing)
set.seed(50)
numero_de_muestras<-1000
muestras<-BostonHousing$medv %>%
createDataPartition(p = 0.8,
times = numero_de_muestras,
list = TRUE)
#Lista vacias que contendran los datos de entrenamiento, los pronosticos para los datos de prueba y para los estadisticos de cada muestra
Modelos_Entrenamiento<-vector(mode = "list",
length = numero_de_muestras)
Pronostico_Prueba<-vector(mode = "list",
length = numero_de_muestras)
Resultados_Performance_data_entrenamiento<-vector(mode = "list",
length = numero_de_muestras)
Resultados_Performance<-vector(mode = "list",
length = numero_de_muestras)
#Estimación de los modelos lineales para cada muestra, los pornósticos y cálculo de los estaditicos de performance.
for(j in 1:numero_de_muestras){
Datos_Entrenamiento<- BostonHousing[muestras[[j]], ]
Datos_Prueba<- BostonHousing[-muestras[[j]], ]
Modelos_Entrenamiento[[j]]<-lm(formula = medv~.,data=Datos_Entrenamiento)
Pronostico_Prueba[[j]]<-Modelos_Entrenamiento[[j]] %>% predict(Datos_Prueba)
Resultados_Performance_data_entrenamiento[[j]]<-data.frame(
R2 = R2(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$medv),
RMSE = RMSE(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$medv),
MAE = MAE(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$medv),
MAPE= MAPE(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$medv)*100,
THEIL=TheilU(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$medv,type = 1),
Um=Um(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$medv),
Us=Us(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$medv),
Uc=Uc(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$medv)
)
Resultados_Performance[[j]]<-data.frame(
R2 = R2(Pronostico_Prueba[[j]], Datos_Prueba$medv),
RMSE = RMSE(Pronostico_Prueba[[j]], Datos_Prueba$medv),
MAE = MAE(Pronostico_Prueba[[j]], Datos_Prueba$medv),
MAPE= MAPE(Pronostico_Prueba[[j]], Datos_Prueba$medv)*100,
THEIL=TheilU(Pronostico_Prueba[[j]], Datos_Prueba$medv,
type = 1),
Um=Um(Pronostico_Prueba[[j]], Datos_Prueba$medv),
Us=Us(Pronostico_Prueba[[j]], Datos_Prueba$medv),
Uc=Uc(Pronostico_Prueba[[j]], Datos_Prueba$medv)
)
}
Resultados de la simulacion
bind_rows(Resultados_Performance_data_entrenamiento) %>%
stargazer(title = "Medidas de Performance Datos del Modelo",
type = "html",
digits = 3)
Medidas de Performance Datos del Modelo
|
|
|
Statistic
|
N
|
Mean
|
St. Dev.
|
Min
|
Pctl(25)
|
Pctl(75)
|
Max
|
|
|
|
R2
|
1,000
|
0.743
|
0.013
|
0.713
|
0.734
|
0.751
|
0.794
|
|
RMSE
|
1,000
|
4.653
|
0.141
|
4.177
|
4.565
|
4.759
|
4.948
|
|
MAE
|
1,000
|
3.265
|
0.095
|
2.905
|
3.204
|
3.332
|
3.512
|
|
MAPE
|
1,000
|
16.387
|
0.464
|
14.813
|
16.085
|
16.718
|
17.691
|
|
THEIL
|
1,000
|
0.096
|
0.003
|
0.087
|
0.095
|
0.099
|
0.102
|
|
Um
|
1,000
|
-0.000
|
0.000
|
-0
|
0
|
0
|
0
|
|
Us
|
1,000
|
-0.117
|
0.002
|
-0.125
|
-0.118
|
-0.116
|
-0.112
|
|
Uc
|
1,000
|
0.928
|
0.004
|
0.918
|
0.925
|
0.931
|
0.945
|
|
|
bind_rows(Resultados_Performance) %>%
stargazer(title = "Medidas de Performance Simulación",
type = "html",
digits = 3)
Medidas de Performance Simulación
|
|
|
Statistic
|
N
|
Mean
|
St. Dev.
|
Min
|
Pctl(25)
|
Pctl(75)
|
Max
|
|
|
|
R2
|
1,000
|
0.723
|
0.056
|
0.452
|
0.690
|
0.764
|
0.840
|
|
RMSE
|
1,000
|
4.862
|
0.575
|
3.465
|
4.450
|
5.226
|
6.961
|
|
MAE
|
1,000
|
3.411
|
0.281
|
2.633
|
3.216
|
3.598
|
4.492
|
|
MAPE
|
1,000
|
17.197
|
1.618
|
12.875
|
16.066
|
18.262
|
23.137
|
|
THEIL
|
1,000
|
0.101
|
0.012
|
0.073
|
0.092
|
0.108
|
0.148
|
|
Um
|
1,000
|
0.003
|
0.045
|
-0.111
|
-0.029
|
0.031
|
0.222
|
|
Us
|
1,000
|
-0.103
|
0.056
|
-0.269
|
-0.142
|
-0.070
|
0.074
|
|
Uc
|
1,000
|
0.918
|
0.066
|
0.667
|
0.875
|
0.971
|
1.010
|
|
|