#Modelo estimado
options(scipen = 999999)
library(wooldridge)
library(dplyr)
data("lawsch85")
lawsch85<-na.omit(lawsch85)
modelo_salario<-lm(formula = LSAT~.,data=lawsch85)
print(modelo_salario)##
## Call:
## lm(formula = LSAT ~ ., data = lawsch85)
##
## Coefficients:
## (Intercept) rank salary cost GPA
## -120.8652828 0.0116539 -0.0002964 -0.0004443 12.0511900
## libvol faculty age clsize north
## -0.0011864 0.0020694 -0.0034282 -0.0019704 0.4876153
## south east west lsalary studfac
## 0.0992231 0.5030798 NA 16.8226080 -0.0674646
## top10 r11_25 r26_40 r41_60 llibvol
## 2.0738327 0.4101576 -0.8489122 0.3279864 1.9452214
## lcost
## 7.2618874library(lmtest)
library(stargazer)
coeftest(modelo_salario)##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -120.86528281 144.74092245 -0.8350 0.40653
## rank 0.01165387 0.01828140 0.6375 0.52590
## salary -0.00029645 0.00034444 -0.8607 0.39236
## cost -0.00044435 0.00032362 -1.3731 0.17412
## GPA 12.05118997 2.28561215 5.2726 0.000001424 ***
## libvol -0.00118644 0.00354831 -0.3344 0.73910
## faculty 0.00206944 0.02005336 0.1032 0.91810
## age -0.00342825 0.00795298 -0.4311 0.66775
## clsize -0.00197041 0.00675967 -0.2915 0.77154
## north 0.48761526 0.84076996 0.5800 0.56380
## south 0.09922311 0.72891364 0.1361 0.89211
## east 0.50307977 0.76299234 0.6594 0.51183
## west NA NA NA NA
## lsalary 16.82260804 15.23670979 1.1041 0.27334
## studfac -0.06746458 0.46566347 -0.1449 0.88522
## top10 2.07383273 2.70728257 0.7660 0.44624
## r11_25 0.41015758 1.86772141 0.2196 0.82682
## r26_40 -0.84891225 1.30204096 -0.6520 0.51655
## r41_60 0.32798636 1.04156861 0.3149 0.75378
## llibvol 1.94522145 1.79189086 1.0856 0.28139
## lcost 7.26188744 3.13664027 2.3152 0.02354 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#Proporción de sesgo
Um<-function(pronosticado,observado){
library(DescTools)
((mean(pronosticado)-mean(observado))^2)/MSE(pronosticado,observado)
}
#Proporción de varianza
Us<-function(pronosticado,observado){
library(DescTools)
((sd(pronosticado)-sd(observado))^2)/MSE(pronosticado,observado)
}
#Proporción de Covarianza
Uc<-function(pronosticado,observado){
library(DescTools)
(2*(1-cor(pronosticado,observado))*sd(pronosticado)*sd(observado))/MSE(pronosticado,observado)
}
#Coeficiente U de Theil
library(DescTools)
THEIL_U <-function(pronosticado,observado) {
RMSE(pronosticado,observado)/(sqrt(mean(pronosticado^2))+sqrt(mean(observado^2)))
}options(scipen = 999999)
library(dplyr)
library(caret)
library(DescTools)
library(stargazer)
set.seed(100)
numero_de_muestras<-175
muestras<- lawsch85$lsalary %>%
createDataPartition(p = 0.75,
times = numero_de_muestras,
list = TRUE)
# Listas vacias, que contendrán los datos de entrenamiento, los pronósticos para los datos de prueba, y para las estadísticas 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 pronósticos y cálculo de las estadisticas de performance.
for(j in 1:numero_de_muestras){
Datos_Entrenamiento<- lawsch85[muestras[[j]], ]
Datos_Prueba<- lawsch85[-muestras[[j]], ]
Modelos_Entrenamiento[[j]]<-lm(formula = lsalary~LSAT+GPA+llibvol+lcost+rank,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$lsalary),
RMSE = RMSE(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$lsalary),
MAE = MAE(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$lsalary),
MAPE= MAPE(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$lsalary)*100,
THEIL=TheilU(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$lsalary,type = 1),
Um=Um(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$lsalary),
Us=Us(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$lsalary),
Uc=Uc(Modelos_Entrenamiento[[j]]$fitted.values,
Datos_Entrenamiento$lsalary)
)
Resultados_Performance[[j]]<-data.frame(
R2 = R2(Pronostico_Prueba[[j]], Datos_Prueba$lsalary),
RMSE = RMSE(Pronostico_Prueba[[j]], Datos_Prueba$lsalary),
MAE = MAE(Pronostico_Prueba[[j]], Datos_Prueba$lsalary),
MAPE= MAPE(Pronostico_Prueba[[j]], Datos_Prueba$lsalary)*100,
THEIL=TheilU(Pronostico_Prueba[[j]], Datos_Prueba$lsalary,
type = 1), # También se puede usar la función que creamos: THEIL_U
Um=Um(Pronostico_Prueba[[j]], Datos_Prueba$lsalary),
Us=Us(Pronostico_Prueba[[j]], Datos_Prueba$lsalary),
Uc=Uc(Pronostico_Prueba[[j]], Datos_Prueba$lsalary))
}bind_rows(Resultados_Performance_data_entrenamiento) %>% #Convierte la lista en df y se pegan las filas.
stargazer(title = "Medidas de Performance Datos del Modelo",
type = "text",
digits = 3) ##
## Medidas de Performance Datos del Modelo
## ========================================
## Statistic N Mean St. Dev. Min Max
## ----------------------------------------
## R2 175 0.835 0.014 0.808 0.877
## RMSE 175 0.108 0.005 0.091 0.117
## MAE 175 0.086 0.004 0.074 0.094
## MAPE 175 0.815 0.036 0.701 0.890
## THEIL 175 0.005 0.0002 0.004 0.006
## Um 175 0.000 0.000 0 0
## Us 175 0.046 0.004 0.033 0.054
## Uc 175 0.969 0.004 0.960 0.981
## ----------------------------------------bind_rows(Resultados_Performance) %>%
stargazer(title = "Medidas de Performance Simulación",
type = "text",
digits = 3)##
## Medidas de Performance Simulación
## ==========================================
## Statistic N Mean St. Dev. Min Max
## ------------------------------------------
## R2 175 0.824 0.053 0.633 0.946
## RMSE 175 0.113 0.016 0.072 0.160
## MAE 175 0.091 0.014 0.062 0.138
## MAPE 175 0.865 0.130 0.591 1.294
## THEIL 175 0.005 0.001 0.003 0.008
## Um 175 0.054 0.068 0.00000 0.418
## Us 175 0.082 0.089 0.00000 0.528
## Uc 175 0.914 0.113 0.468 1.052
## ------------------------------------------