MSF. Ademir Pérez
Estimación Puntual
Una vez estimado el modelo las predicciones para un conjunto de valores de los regresores, \(\color{red}{[X’s]}\), se obtiene a partir de la expresión:
\(\color{green}{\hat{Y}_m} = \color{red}{X'_m}*\color{green}{\hat{\beta}}\)
Donde: \[\color{red}{X'_m=\begin{bmatrix} 1 & x_1 & x_2 & ... & x_k \end{bmatrix}}\]
\(\color{red}{\text{Es el conjunto de valores para los regresores,}}\) \(\color{red}{\text{que serán usados para generar el pronóstico}}\) \(\color{green}{\hat{Y}_m}\).
\(\color{green}{\hat\beta}\) es el estimador MCO, del modelo ajustado.
Intervalo de confianza para pronósticos individuales \(\hat{Y}_m\)
El intervalo de confianza, para una predicción individual se construye de la siguiente manera:
\[\color{purple}{IC_{\hat{Y}_m}^{1-\alpha}:\hat{Y}_m \pm t_{\alpha /2,n-k}*\hat\sigma*\sqrt{1+X'_m[X'X]^{-1}X_m}}\] Donde \(\color{purple}{\hat\sigma}\) es el error estándar de estimación del modelo, el modelo tiene \(\color{purple}{k}\) parámetros.
Intervalo de Confianza para la media \(E[Y_m]\)
El intervalo de confianza, para el valor esperado de Y se construye de la siguiente manera:
\[\color{purple}{IC_{{E[Y}_m]}^{1-\alpha}:\hat{Y}_m \pm t_{\alpha /2,n-k}*\hat\sigma*\sqrt{X'_m[X'X]^{-1}X_m}}\]
Pronostico del precio de casas (medv) en Boston, descripción del dataframe en: descripción de variables
options(scipen = 999999)
library(lmtest)
library(stargazer)
library(equatiomatic) # optativo remotes::install_github("datalorax/equatiomatic")
library(mlbench) #esta librería tiene el data frame BostonHousing
data(BostonHousing)
#Modelo estimado medv~. indica "medv" en función del resto de variables del dataframe
modelo_boston<-lm(formula = medv~.,data=BostonHousing)
extract_eq(modelo_boston,wrap = TRUE) #optativo\[ \begin{aligned} \text{medv} &= \alpha + \beta_{1}(\text{crim}) + \beta_{2}(\text{zn}) + \beta_{3}(\text{indus})\ + \\ &\quad \beta_{4}(\text{chas}_{\text{1}}) + \beta_{5}(\text{nox}) + \beta_{6}(\text{rm}) + \beta_{7}(\text{age})\ + \\ &\quad \beta_{8}(\text{dis}) + \beta_{9}(\text{rad}) + \beta_{10}(\text{tax}) + \beta_{11}(\text{ptratio})\ + \\ &\quad \beta_{12}(\text{b}) + \beta_{13}(\text{lstat}) + \epsilon \end{aligned} \]
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 36.45948839 5.10345881 7.1441 0.0000000000032834 ***
## crim -0.10801136 0.03286499 -3.2865 0.0010868 **
## zn 0.04642046 0.01372746 3.3816 0.0007781 ***
## indus 0.02055863 0.06149569 0.3343 0.7382881
## chas1 2.68673382 0.86157976 3.1184 0.0019250 **
## nox -17.76661123 3.81974371 -4.6513 0.0000042456438076 ***
## rm 3.80986521 0.41792525 9.1161 < 0.00000000000000022 ***
## age 0.00069222 0.01320978 0.0524 0.9582293
## dis -1.47556685 0.19945473 -7.3980 0.0000000000006013 ***
## rad 0.30604948 0.06634644 4.6129 0.0000050705290227 ***
## tax -0.01233459 0.00376054 -3.2800 0.0011116 **
## ptratio -0.95274723 0.13082676 -7.2825 0.0000000000013088 ***
## b 0.00931168 0.00268596 3.4668 0.0005729 ***
## lstat -0.52475838 0.05071528 -10.3471 < 0.00000000000000022 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
library(stargazer)
#Data para la predicción X'm
X_m<-data.frame(crim=0.05,zn=15,indus=2,chas="0",nox=0.004,
rm=5,age=85,dis=5.56,rad=2,tax=300,ptratio=17,b=0.00005,lstat=5)
# Intervalos de Confianza del 95% y del 99%
confidense<-c(0.95,0.99)
#Predicción usando predict
predict(object = modelo_boston,
newdata = X_m,
interval = "prediction",
level = confidense,
se.fit =TRUE)->predicciones
rownames(predicciones$fit)<-as.character(confidense*100)
colnames(predicciones$fit)<-c("Ym","Li","Ls")
stargazer(predicciones$fit,
title = "Pronósticos e intervalos de confianza",
type = "html") #Poner results='asis' en opciones del chunk| Ym | Li | Ls | |
| 95 | 26.116 | 15.558 | 36.673 |
| 99 | 26.116 | 12.221 | 40.010 |
library(forecast)
library(kableExtra)
#Data para la predicción X'm
X_m<-data.frame(crim=0.05,zn=15,indus=2,chas="0",nox=0.004,
rm=5,age=85,dis=5.56,rad=2,tax=300,ptratio=17,b=0.00005,lstat=5)
#Nivel de confianza para el intervalo de confianza
confidense<-c(0.95,0.99)
#Realizando el pronóstico con forecast
pronosticos<-forecast(object = modelo_boston,
level = confidense,
newdata = X_m,ts = FALSE)
kable(pronosticos,
caption = "Pronóstico e intervalos de confianza:",
digits = 2,format = "html") #Poner results='asis' en opciones del chunk| Point Forecast | Lo 95 | Hi 95 | Lo 99 | Hi 99 |
|---|---|---|---|---|
| 26.12 | 15.56 | 36.67 | 12.22 | 40.01 |
Simulación: proceso de aplicación de un modelo estadistico o matemático , con el proposito de generar proyecciones de valores conocidos de la variable endógena, con información de las variables exógenas no utilizadas en la construcción del modelo para constrastar su capacidad predictiva.
figura 1: Elaboración propia
Figura 2: Adaptado de S. Pindyck, Daniel L. Rubinfeld “Econometria: modelos y pronósticos” Mc Graw Hill (2001), capitulo 8
Medidas de Performance [Desempeño] para la predicción:
Para todas las medidas, se tiene que:
\(\color{blue}{\hat{Y}_m}\): son los valores simulados [pronosticados] por el modelo.
\(\color{blue}{Y_a}\): son los valores reales de la variable dependiente no incluidos en la estimación del modelo.
\(\color{blue}{m}\): Es el número de observaciones no incluidas en la estimación del modelo.
\[\color{green}{RMSD=\sqrt\frac{\sum_{j=1}^{m}(\hat{Y}_{j,m}-Y_{j,a})^2}{m}}\]
\[\color{green}{MAE = \frac{\sum_{j=1}^{m}\mid\hat{Y}_{j,m}-Y_{j,a}\mid}{m}}\]
\[\color{green}{MAPE = \frac{\sum_{j=1}^{m}\mid(\hat{Y}_{j,m}-Y_{j,a})/Y_{j,a}\mid}{m}*100}\]
\[\color{green}{U_{Theil}=\frac{\sqrt{\frac{\sum_{j=1}^{m}(\hat{Y}_{j,m}-Y_{j,a})^2}{m}}}{\sqrt{\sum_{j=1}^{m}\hat{Y}_{j,m}^2}+\sqrt{\sum_{j=1}^{m}{Y}_{j,a}^2}}}\]
Descomposición de Theil
\(\color{red}{\text{Proporción de Sesgo}}\) [Bias Proportion]
\[\color{green}{U^M=\frac{(\bar{\hat{Y}}_{j,m}-\bar{Y}_{j,a})^2}{{\sqrt{\sum_{j=1}^{m}(\hat{Y}_{j,m}-Y_{j,a})^2}}/m}}\]
\[\color{green}{U^S=\frac{(\sigma_{\hat{Y}_{m}}-\sigma_{Y_a})^2}{{\sqrt{\sum_{j=1}^{m}(\hat{Y}_{j,m}-Y_{j,a})^2}}/m}}\]
\[\color{green}{U^S=\frac{2*(1-\rho)*\sigma_{{\hat{Y}}_{m}}*\sigma_{{Y}_{a}}}{{\sqrt{\sum_{j=1}^{m}(\hat{Y}_{j,m}-Y_{j,a})^2}}/m}}\]
Definición funciones para el cálculo de Theil y su descomposición, debe estar instalada la librería DescTools:
#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 librería "DescTools")
THEIL_U<-function(pronosticado,observado){
library(DescTools)
RMSE(pronosticado,observado)/(sqrt(mean(pronosticado^2))+sqrt(mean(observado^2)))
}options(scipen = 999999) #No mostrar notación cientifica.
library(dplyr) # Para manejo de datos y activar el operador "pipe" %>%
library(caret) # Permite Realizar muestreo sobre los data frame
library(DescTools) # Contiene las funciones para calcular las medidas de performance
library(stargazer) # Para dar formato, y obtener resumen estadistico de las simulaciones
set.seed(50) # Permite fijar la semilla aleatoria, para reproducir los resultados obtenidos en esta clase
numero_de_muestras<-1000 # Numero de muestras que se optendran del data frame
# Se crea la lista con las 1000 muestras (indica la posición de la fila en cada data frame)
muestras<- BostonHousing$medv %>%
createDataPartition(p = 0.8,
times = numero_de_muestras,
list = TRUE)
# Listas vacias, que contendran los datos de entrenamiento, los pronosticos para los datos de prueba, y para las estadisticas 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<- 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), # También se puede usar la función que creamos: THEIL_U
Um=Um(Pronostico_Prueba[[j]], Datos_Prueba$medv),
Us=Us(Pronostico_Prueba[[j]], Datos_Prueba$medv),
Uc=Uc(Pronostico_Prueba[[j]], Datos_Prueba$medv)
)
} #No olvidar este corchete ;)bind_rows(Resultados_Performance_data_entrenamiento) %>%
stargazer(title = "Medidas de Performance Datos del Modelo",
type = "html",
digits = 3)| 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.074 | 0.004 | 0.058 | 0.072 | 0.077 | 0.085 |
| 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)| 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.011 | 0.016 | 0.000 | 0.001 | 0.015 | 0.205 |
| Us | 1,000 | 0.081 | 0.066 | 0.00000 | 0.027 | 0.122 | 0.333 |
| Uc | 1,000 | 0.918 | 0.066 | 0.667 | 0.875 | 0.971 | 1.010 |
Hlavac, Marek. 2018. Stargazer: Well-Formatted Regression and Summary Statistics Tables. https://CRAN.R-project.org/package=stargazer.
Hyndman, Rob, George Athanasopoulos, Christoph Bergmeir, Gabriel Caceres, Leanne Chhay, Mitchell O’Hara-Wild, Fotios Petropoulos, Slava Razbash, Earo Wang, and Farah Yasmeen. 2020. Forecast: Forecasting Functions for Time Series and Linear Models. https://CRAN.R-project.org/package=forecast.
Hyndman, Rob J, and Yeasmin Khandakar. 2008. “Automatic Time Series Forecasting: The Forecast Package for R.” Journal of Statistical Software 26 (3): 1–22. http://www.jstatsoft.org/article/view/v027i03.
Kuhn, Max. 2020. Caret: Classification and Regression Training. https://CRAN.R-project.org/package=caret.
Leisch, Friedrich, and Evgenia Dimitriadou. 2012. Mlbench: Machine Learning Benchmark Problems. https://CRAN.R-project.org/package=mlbench.
Newman, D. J., S. Hettich, C. L. Blake, and C. J. Merz. 1998. “UCI Repository of Machine Learning Databases.” University of California, Irvine, Dept. of Information; Computer Sciences. http://www.ics.uci.edu/~mlearn/MLRepository.html.
R Core Team. 2020. R: A Language and Environment for Statistical Computing. Vienna, Austria: R Foundation for Statistical Computing. https://www.R-project.org/.
Signorell, Andri. 2020. DescTools: Tools for Descriptive Statistics. https://CRAN.R-project.org/package=DescTools.
Zhu, Hao. 2019. KableExtra: Construct Complex Table with ’Kable’ and Pipe Syntax. https://CRAN.R-project.org/package=kableExtra.