Evidencia Empírica
library(readr)
insurance <- read_csv("C:/Users/MINEDUCYT/Downloads/insurance.csv")
head(insurance, 10)## # A tibble: 10 × 7
## age sex bmi children smoker region charges
## <dbl> <chr> <dbl> <dbl> <chr> <chr> <dbl>
## 1 19 female 27.9 0 yes southwest 16885.
## 2 18 male 33.8 1 no southeast 1726.
## 3 28 male 33 3 no southeast 4449.
## 4 33 male 22.7 0 no northwest 21984.
## 5 32 male 28.9 0 no northwest 3867.
## 6 31 female 25.7 0 no southeast 3757.
## 7 46 female 33.4 1 no southeast 8241.
## 8 37 female 27.7 3 no northwest 7282.
## 9 37 male 29.8 2 no northeast 6406.
## 10 60 female 25.8 0 no northwest 28923.
Modelo Estimado
## Warning: package 'lmtest' was built under R version 4.5.2
## Cargando paquete requerido: zoo
## Warning: package 'zoo' was built under R version 4.5.2
##
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Warning: package 'stargazer' was built under R version 4.5.2
##
## Please cite as:
## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.
## R package version 5.2.3. https://CRAN.R-project.org/package=stargazer
## Warning: package 'equatiomatic' was built under R version 4.5.3
##
## Adjuntando el paquete: 'equatiomatic'
## The following object is masked from 'package:datasets':
##
## penguins
modelo_seguro <- lm(formula = log(charges) ~ age + bmi + children + smoker + region, data = insurance)
extract_eq(modelo_seguro,wrap = TRUE) #optativo\[ \begin{aligned} \operatorname{log(charges)} &= \alpha + \beta_{1}(\operatorname{age}) + \beta_{2}(\operatorname{bmi}) + \beta_{3}(\operatorname{children})\ + \\ &\quad \beta_{4}(\operatorname{smoker}_{\operatorname{yes}}) + \beta_{5}(\operatorname{region}_{\operatorname{northwest}}) + \beta_{6}(\operatorname{region}_{\operatorname{southeast}}) + \beta_{7}(\operatorname{region}_{\operatorname{southwest}})\ + \\ &\quad \epsilon \end{aligned} \]
library(stargazer)
modelo_seguro <- lm(log(charges) ~ age + bmi + children + smoker + region, data = insurance)
stargazer(modelo_seguro, type = "html", title = "Modelo de Regresión Lineal - Seguro de Salud")| Dependent variable: | |
| log(charges) | |
| age | 0.035*** |
| (0.001) | |
| bmi | 0.013*** |
| (0.002) | |
| children | 0.101*** |
| (0.010) | |
| smokeryes | 1.547*** |
| (0.030) | |
| regionnorthwest | -0.063* |
| (0.035) | |
| regionsoutheast | -0.157*** |
| (0.035) | |
| regionsouthwest | -0.129*** |
| (0.035) | |
| Constant | 7.001*** |
| (0.072) | |
| Observations | 1,338 |
| R2 | 0.766 |
| Adjusted R2 | 0.765 |
| Residual Std. Error | 0.446 (df = 1330) |
| F Statistic | 622.938*** (df = 7; 1330) |
| Note: | p<0.1; p<0.05; p<0.01 |
Verificación de los supuestos del Modelo Clásico de Regresión Lineal Múltiple
Verifiación de los ajuste de los residuos
library(fitdistrplus)
fit_normal<-fitdist(data = modelo_seguro$residuals,distr = "norm")
plot(fit_normal)Verificación de la Normalidad
\(H_0 : \varepsilon \sim N(0, \sigma^2)\) “Los Residuos siguen una distribución normal con media cero y varianza constante”
\(H_A : \varepsilon \not\sim N(0, \sigma^2)\) “Los Residuos no siguen una distribución normal con media cero y varianza constante”
Prueba de Shapiro-Wilk
# Extración de Residuos
residuos <- residuals(modelo_seguro)
options(scipen = 99) # Evitar notación científica en los resultados
# A) Prueba de Shapiro-Wilk
# Calculo de W
salida_SW <- shapiro.test(modelo_seguro$residuals)
print(salida_SW)##
## Shapiro-Wilk normality test
##
## data: modelo_seguro$residuals
## W = 0.84227, p-value < 0.00000000000000022
## [1] 12.1894
Prueba de Jaque-Bera
# B) Prueba de Jarque-Bera
library(tseries)
options(scipen = 99) # Evitar notación científica en los resultados
jb_test <- jarque.bera.test(residuos)
print(jb_test)##
## Jarque Bera Test
##
## data: residuos
## X-squared = 1613.4, df = 2, p-value < 0.00000000000000022
Prueba de Kolmogorov-Smirnov con residuos estandarizados
options(scipen = 99) # Evitar notación científica en los resultados
# C) Prueba de Kolmogorov-Smirnov
library(nortest)
prueba_KS<-lillie.test(modelo_seguro$residuals)
prueba_KS##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo_seguro$residuals
## D = 0.214, p-value < 0.00000000000000022
Resultado en Forma Gráfica
library(fastGraph)
# Parámetros del nivel de significancia y estadísticos
alpha_sig <- 0.05
JB_stat <- jb_test$statistic
gl <- jb_test$parameter
# Cálculo del Valor Crítico Teórico
VC_jb <- qchisq(1 - alpha_sig, gl, lower.tail = TRUE)
# Grafico
shadeDist(VC_jb,
ddist = "dchisq",
parm1 = gl,
lower.tail = FALSE,
xmin = 0,
xmax = 10,
sub = paste("VC:", round(VC_jb, 2), " ", "JB:", round(JB_stat, 2)))Conclusion: El comportamiento de los residuos es idéntico: todas las pruebas estadísticas arrojan un p-valor menor al nivel de significancia (0.05), confirmando el rechazo de la hipótesis nula de normalidad. Por lo que se puede decir, “Los Residuos no siguen una distribución normal con media cero y varianza constante”
Verificación de Multicolinealidad
Indice de Condición
\(\kappa(\mathbf{x}) = \sqrt{\frac{\lambda_{max}}{\lambda_{min}}}\)
Interpretación del Índice de Condición:
Si \(\kappa(\mathbf{x}) \leq 20\), la multicolinealidad es leve y no representa un problema significativo.
Cuando \(20 < \kappa(\mathbf{x}) < 30\), se considera que la multicolinealidad es de nivel moderado.
Si \(\kappa(\mathbf{x}) \geq 30\), la multicolinealidad es severa y puede comprometer los resultados del modelo.
# OPCION 1
# Cálculo del Indice de Condición usando librería “mctest”
library(mctest)
X_mat<-model.matrix(modelo_seguro)
mctest(mod = modelo_seguro)##
## Call:
## omcdiag(mod = mod, Inter = TRUE, detr = detr, red = red, conf = conf,
## theil = theil, cn = cn)
##
##
## Overall Multicollinearity Diagnostics
##
## MC Results detection
## Determinant |X'X|: 0.5205 0
## Farrar Chi-Square: 871.0716 1
## Red Indicator: 0.1477 0
## Sum of Lambda Inverse: 8.8309 0
## Theil's Method: -3.3949 0
## Condition Number: 16.0587 0
##
## 1 --> COLLINEARITY is detected by the test
## 0 --> COLLINEARITY is not detected by the test
Factores Inflacionarios de la Varianza (FIV)
VIF Interpretación
Igual a 1 - Sin multicolinealidad
Menor a 5 - Baja o moderada, generalmente aceptable
Menor a 10 - Posible problema de multicolinealidad
Mayor a 10. Problema serio de multicolinealidad
Nota: El criterio puede cambiar dependiendo del investigador.
# CÁLCULO DE LAS VIFs usando performance
library(performance)
VIFs<-multicollinearity(x = modelo_seguro,verbose = FALSE)
VIFs## # Check for Multicollinearity
##
## Low Correlation
##
## Term VIF VIF 95% CI adj. VIF Tolerance Tolerance 95% CI
## age 1.02 [1.00, 1.48] 1.01 0.98 [0.68, 1.00]
## bmi 1.10 [1.06, 1.19] 1.05 0.91 [0.84, 0.95]
## children 1.00 [1.00, 6798.74] 1.00 1.00 [0.00, 1.00]
## smoker 1.01 [1.00, 30.88] 1.00 0.99 [0.03, 1.00]
## region 1.10 [1.05, 1.19] 1.05 0.91 [0.84, 0.95]
Verificación de la Homocedasticidad
\(\hat{\delta}^2_u = \delta_0 + \delta_1 x_1 + \delta_2 x_2 + \ldots + \delta_k x_k + \alpha_2 x_1^2 + \alpha_2 x_2^2 \ldots + \alpha_k x_k^2 + \theta_1 x_1 x_2 + \theta_1 x_1 x_3 + \theta_k C2 \alpha_i x_j\)
Hipótesis
\(H_0\): \(\delta_1 = \delta_2 = \ldots = \delta_k = \alpha_1 = \alpha_2 = \ldots = \alpha_k = \theta_1 = \theta_2 = \ldots = \theta_k C_2 = 0\)
Existe evidencia estadística de que los residuos son homocedásticos (la varianza del error es constante).
\(H_1\): \(\delta_1 = \delta_2 = \ldots = \delta_k = \alpha_1 = \alpha_2 = \ldots = \alpha_k = \theta_1 = \theta_2 = \ldots = \theta_k C_2 \neq 0\)
Existe evidencia estadística de que los residuos son heterocedásticos (la varianza del error no es constante).
Prueba de White
library(lmtest)
options(scipen = 99) # Evitar notación científica en los resultados
# Ejecutar la prueba de White para el nuevo modelo
PWhite <- bptest(
modelo_seguro,
~ I(age^2) + I(bmi^2) + I(children^2) + age * bmi + age * children + age * smoker + age * region + bmi * children + bmi * smoker + bmi * region + children * smoker + children * region + smoker * region, data = insurance)
# Mostrar los resultados
print(PWhite)##
## studentized Breusch-Pagan test
##
## data: modelo_seguro
## BP = 145.44, df = 28, p-value < 0.00000000000000022
## Usando Libreraria Skedastic (Otra alternativa)
library(skedastic)
options(scipen = 99) # Evitar notación científica en los resultados
skedastic::white(modelo_seguro, interactions = FALSE) ## # A tibble: 1 × 5
## statistic p.value parameter method alternative
## <dbl> <dbl> <dbl> <chr> <chr>
## 1 110. 6.83e-17 14 White's Test greater
Conclusión. Como el p-value < nivel de significancia (0.05). Se rechaza la hipótesis nula; por lo tanto, existe evidencia estadística de la presencia de heterocedasticidad en la varianza de los residuos.
Verificación de Autocorrelación
Prueba de Durbin-Watson
Se asume que los residuos presentan la siguiente estructura:
\(u_i = \rho u_{i-1} + v_i\)
\(H_0 : \rho = 0\)
No existe autocorrelación de primer orden en los residuos del modelo estimado
\(H_1 : \rho \neq 0\)
Se detecta presencia de autocorrelación de primer orden en los residuos del modelo estimado
##
## Durbin-Watson test
##
## data: modelo_seguro
## DW = 2.0494, p-value = 0.3658
## alternative hypothesis: true autocorrelation is not 0
## lag Autocorrelation D-W Statistic p-value
## 1 -0.02578916 2.04941 0.36
## Alternative hypothesis: rho != 0
Conclusión: Como el p-value es menor al nivel de significancia (0.05), se rechaza la hipótesis nula, lo que indica que existe evidencia estadística de la presencia de autocorrelación de primer orden en los residuos del modelo estimado.
Multiplicadores de Lagrange (Breusch-Godfrey)
\(u_j = \rho_1 u_{i-1} + \rho_2 u_{i-2} + \ldots + \rho_m u_{i-m} + u_j\)
\(H_0: \rho_1 = \rho_2 = \rho_3 = \ldots = \rho_m = 0\)
Los residuos del modelo no presentan dependencia entre sí y carecen de autocorrelación hasta el orden \(m\).
\(H_1: \rho_1 = \rho_2 = \rho_3 = \ldots = \rho_m \neq 0\)
Los residuos del modelo presentan dependencia entre sí y exhiben autocorrelación hasta el orden \(m\).
Prueba de Breusch-Godfrey de segundo orden
##
## Breusch-Godfrey test for serial correlation of order up to 2
##
## data: modelo_seguro
## LM test = 0.94674, df = 2, p-value = 0.6229
Conclusión. Como p-value > nivel de significancia (0.05), no se rechaza la hipótesis nula; por lo tanto, puede concluirse que los residuos del modelo no siguen autocorrelación de orden “2”.
Prueba de Breusch-Godfrey de primer orden
##
## Breusch-Godfrey test for serial correlation of order up to 1
##
## data: modelo_seguro
## LM test = 0.89603, df = 1, p-value = 0.3438
Conclusión. Como p-value > nivel de significancia (0.05), no se rechaza la hipótesis nula; por lo tanto, puede concluirse que los residuos del modelo no siguen autocorrelación de orden “1”.
Forma Gráfica
# Extraemos los residuos de tu modelo
residuos <- residuals(modelo_seguro)
# Graficamos con ZOOM
acf(residuos,
lag.max = 5, # Zoom en X: Muestra solo hasta el lag 5
ylim = c(-0.2, 0.2), # Zoom en Y: Corta el gráfico entre -0.2 y 0.2
main = "Correlograma de los Residuos",
xlab = "Lag",
ylab = "ACF")Intepretación. Al mirar la gráfica,ninguna de las líneas negras (del 1 al 5) se salga de las líneas punteadas azules. Como todas se quedan guardadas ahí dentro, significa que los errores del modelo son completamente aleatorios y no dependen unos de otros.
Estimadores HAC
## Warning in options(scipen = 99999): invalid 'scipen' 99999, used 9999
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.00084777 0.07198534 97.2538 < 0.00000000000000022 ***
## age 0.03464897 0.00087458 39.6179 < 0.00000000000000022 ***
## bmi 0.01307111 0.00210044 6.2230 0.0000000006521 ***
## children 0.10132039 0.01013041 10.0016 < 0.00000000000000022 ***
## smokeryes 1.54729653 0.03029096 51.0811 < 0.00000000000000022 ***
## regionnorthwest -0.06333857 0.03501741 -1.8088 0.0707119 .
## regionsoutheast -0.15681659 0.03519516 -4.4556 0.0000090671202 ***
## regionsouthwest -0.12856380 0.03513933 -3.6587 0.0002634 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Warning in options(scipen = 99999): invalid 'scipen' 99999, used 9999
## Warning: package 'sandwich' was built under R version 4.5.3
#Corregido
#HC0 Corrige Sólo Heterocedasticidad, use HC1 para corregir también Autocorrelación de Primer Orden
estimacion_omega<-vcovHC(modelo_seguro,type = "HC0")
coeftest(modelo_seguro,vcov. = estimacion_omega)##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.0008478 0.0701558 99.7900 < 0.00000000000000022 ***
## age 0.0346490 0.0010149 34.1419 < 0.00000000000000022 ***
## bmi 0.0130711 0.0021543 6.0676 0.00000000169 ***
## children 0.1013204 0.0091664 11.0534 < 0.00000000000000022 ***
## smokeryes 1.5472965 0.0323059 47.8952 < 0.00000000000000022 ***
## regionnorthwest -0.0633386 0.0348313 -1.8184 0.0692221 .
## regionsoutheast -0.1568166 0.0367183 -4.2708 0.00002086070 ***
## regionsouthwest -0.1285638 0.0339849 -3.7830 0.0001618 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
options(scipen = 99)
library(robustbase)
library(stargazer)
modelo_seguro_robust<-lmrob(log(charges) ~ age + bmi + children + smoker + region, data = insurance)
# print(summary(modelo_seguro_robust))
stargazer(modelo_seguro,modelo_seguro_robust,type = "html",title = "comparativa")| Dependent variable: | ||
| log(charges) | ||
| OLS | MM-type | |
| linear | ||
| (1) | (2) | |
| age | 0.035*** | 0.043 |
| (0.001) | ||
| bmi | 0.013*** | 0.001 |
| (0.002) | ||
| children | 0.101*** | 0.113 |
| (0.010) | ||
| smokeryes | 1.547*** | 1.438 |
| (0.030) | ||
| regionnorthwest | -0.063* | -0.029 |
| (0.035) | ||
| regionsoutheast | -0.157*** | -0.091 |
| (0.035) | ||
| regionsouthwest | -0.129*** | -0.086 |
| (0.035) | ||
| Constant | 7.001*** | 6.930 |
| (0.072) | ||
| Observations | 1,338 | 1,338 |
| R2 | 0.766 | 0.973 |
| Adjusted R2 | 0.765 | 0.973 |
| Residual Std. Error (df = 1330) | 0.446 | 0.119 |
| F Statistic | 622.938*** (df = 7; 1330) | |
| Note: | p<0.1; p<0.05; p<0.01 | |
Pronósticos
## Pronosticos
options(scipen = 99)
library(lmtest)
library(stargazer)
library(equatiomatic) # optativo remotes::install_github("datalorax/equatiomatic")
#Modelo estimado medv~. indica "medv" en función del resto de variables del dataframe
#Adaptado a tu modelo_seguro justificado con tus variables
modelo_seguro <- lm(formula = log(charges) ~ age + bmi + children + smoker + region, data = insurance)
extract_eq(modelo_seguro,wrap = TRUE) #optativo\[ \begin{aligned} \operatorname{log(charges)} &= \alpha + \beta_{1}(\operatorname{age}) + \beta_{2}(\operatorname{bmi}) + \beta_{3}(\operatorname{children})\ + \\ &\quad \beta_{4}(\operatorname{smoker}_{\operatorname{yes}}) + \beta_{5}(\operatorname{region}_{\operatorname{northwest}}) + \beta_{6}(\operatorname{region}_{\operatorname{southeast}}) + \beta_{7}(\operatorname{region}_{\operatorname{southwest}})\ + \\ &\quad \epsilon \end{aligned} \]
Usando Predict
library(stargazer)
options(scipen = 2)
#Data para la predicción X'm basado en un perfil de cliente para insurance
X_m<-data.frame(age=35, bmi=28.5, children=2, smoker="no", region="southwest")
# Intervalos de Confianza del 95% y del 99%
confidense<-c(0.95,0.99)
#Predicción usando predict (calculando ambos niveles para la matriz)
pred_95 <- predict(object = modelo_seguro, newdata = X_m, interval = "prediction", level = 0.95)
pred_99 <- predict(object = modelo_seguro, newdata = X_m, interval = "prediction", level = 0.99)
# Reconvertir de log a dólares aplicando exp()
pred_95_exp <- exp(pred_95)
pred_99_exp <- exp(pred_99)
predicciones <- list()
predicciones$fit <- rbind(pred_95_exp, pred_99_exp)
rownames(predicciones$fit)<-as.character(confidense*100)
colnames(predicciones$fit)<-c("Ym","Li","Ls")
stargazer(predicciones$fit,
title = "Pronósticos e intervalos de confianza (en dólares)",
type = "html") #Poner results='asis' en opciones del chunk| Ym | Li | Ls | |
| 95 | 5,768.488 | 2,402.195 | 13,852.110 |
| 99 | 5,768.488 | 1,823.048 | 18,252.650 |
Predicción usando libreria forescast
library(forecast)
library(kableExtra)
options(scipen = 2)
#Data para la predicción X'm
X_m<-data.frame(age=35, bmi=28.5, children=2, smoker="no", region="southwest")
#Nivel de confianza para el intervalo de confianza
confidense<-c(0.95,0.99)
#Realizando el pronóstico con forecast
pronosticos<-forecast(object = modelo_seguro,
level = confidense,
newdata = X_m, ts = FALSE)
# Reconvertir de log a dólares aplicando exp()
pronosticos_df <- as.data.frame(pronosticos)
pronosticos_exp <- exp(pronosticos_df)
kable(pronosticos_exp,
caption = "Pronóstico e intervalos de confianza (en dólares):",
digits = 1, format = "html") #Poner results='asis' en opciones del chunk| Point Forecast | Lo 95 | Hi 95 | Lo 99 | Hi 99 |
|---|---|---|---|---|
| 5768.5 | 2402.2 | 13852.1 | 1823 | 18252.7 |
#Simulación.
#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 = 99) #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
# SOLICITADO: Simulación con 5,000 réplicas / iteraciones
numero_de_muestras<-5000
# Se crea la lista con las 5000 muestras sobre los cargos de seguros (80% entrenamiento)
muestras<- insurance$charges %>%
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<- insurance[muestras[[j]], ]
Datos_Prueba<- insurance[-muestras[[j]], ]
# Modelo adaptado a tu estructura justificada
Modelos_Entrenamiento[[j]]<-lm(formula = log(charges) ~ age + bmi + children + smoker + region, 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,
log(Datos_Entrenamiento$charges)),
RMSE = RMSE(Modelos_Entrenamiento[[j]]$fitted.values,
log(Datos_Entrenamiento$charges)),
MAE = MAE(Modelos_Entrenamiento[[j]]$fitted.values,
log(Datos_Entrenamiento$charges)),
MAPE= MAPE(Modelos_Entrenamiento[[j]]$fitted.values,
log(Datos_Entrenamiento$charges))*100,
THEIL=TheilU(Modelos_Entrenamiento[[j]]$fitted.values,
log(Datos_Entrenamiento$charges),type = 1),
Um=Um(Modelos_Entrenamiento[[j]]$fitted.values,
log(Datos_Entrenamiento$charges)),
Us=Us(Modelos_Entrenamiento[[j]]$fitted.values,
log(Datos_Entrenamiento$charges)),
Uc=Uc(Modelos_Entrenamiento[[j]]$fitted.values,
log(Datos_Entrenamiento$charges))
)
Resultados_Performance[[j]]<-data.frame(
R2 = R2(Pronostico_Prueba[[j]], log(Datos_Prueba$charges)),
RMSE = RMSE(Pronostico_Prueba[[j]], log(Datos_Prueba$charges)),
MAE = MAE(Pronostico_Prueba[[j]], log(Datos_Prueba$charges)),
MAPE= MAPE(Pronostico_Prueba[[j]], log(Datos_Prueba$charges))*100,
THEIL=TheilU(Pronostico_Prueba[[j]], log(Datos_Prueba$charges),
type = 1), # También se puede usar la función que creamos: THEIL_U
Um=Um(Pronostico_Prueba[[j]], log(Datos_Prueba$charges)),
Us=Us(Pronostico_Prueba[[j]], log(Datos_Prueba$charges)),
Uc=Uc(Pronostico_Prueba[[j]], log(Datos_Prueba$charges))
)
} #No olvidar este corchete ;)bind_rows(Resultados_Performance_data_entrenamiento) %>%
stargazer(title = "Medidas de Performance Datos del Modelo (Entrenamiento 80%)",
type = "html",
digits = 3)| Statistic | N | Mean | St. Dev. | Min | Max |
| R2 | 5,000 | 0.766 | 0.008 | 0.742 | 0.792 |
| RMSE | 5,000 | 0.444 | 0.007 | 0.418 | 0.464 |
| MAE | 5,000 | 0.280 | 0.005 | 0.261 | 0.299 |
| MAPE | 5,000 | 3.057 | 0.058 | 2.843 | 3.267 |
| THEIL | 5,000 | 0.024 | 0.0004 | 0.023 | 0.025 |
| Um | 5,000 | 0.000 | 0.000 | 0 | 0 |
| Us | 5,000 | 0.066 | 0.003 | 0.058 | 0.075 |
| Uc | 5,000 | 0.934 | 0.003 | 0.926 | 0.943 |
bind_rows(Resultados_Performance) %>%
stargazer(title = "Medidas de Performance Simulación (Predictivo - 5,000 Réplicas)",
type = "html",
digits = 3)| Statistic | N | Mean | St. Dev. | Min | Max |
| R2 | 5,000 | 0.765 | 0.031 | 0.662 | 0.863 |
| RMSE | 5,000 | 0.447 | 0.027 | 0.358 | 0.538 |
| MAE | 5,000 | 0.283 | 0.015 | 0.234 | 0.335 |
| MAPE | 5,000 | 3.088 | 0.157 | 2.571 | 3.683 |
| THEIL | 5,000 | 0.024 | 0.002 | 0.019 | 0.030 |
| Um | 5,000 | 0.004 | 0.005 | 0.000 | 0.045 |
| Us | 5,000 | 0.072 | 0.033 | 0.00002 | 0.219 |
| Uc | 5,000 | 0.928 | 0.034 | 0.777 | 1.001 |