10.4 Validación del modelo

La validación de un modelo es esencial para evaluar su capacidad para predecir de manera precisa y confiable los resultados futuros. En el caso de un modelo de área con respuesta multinomial, la validación se enfoca en medir la precisión del modelo para predecir las diferentes categorías de respuesta. El objetivo principal de la validación es determinar si el modelo es capaz de generalizar bien a datos no vistos y proporcionar predicciones precisas. Esto implica comparar las predicciones del modelo con los datos observados y utilizar métricas de evaluación para medir el rendimiento del modelo. La validación del modelo es esencial para garantizar la calidad de las predicciones y la confiabilidad del modelo para su uso en aplicaciones futuras.

library(posterior)
infile <- paste0("01 Modelo de area/MEX/2020/Data/fit_rtanmultinomial_con_covariable_satelite2.Rds")
fit <- readRDS(infile)

theta_dir <- indicador_dam1 %>%  
  transmute(dam2,
    n = n_desocupado + n_ocupado + n_inactivo,
            Ocupado, Desocupado, Inactivo) 

color_scheme_set("brightblue")
theme_set(theme_bw(base_size = 15))
y_pred_B <- as.array(fit, pars = "theta") %>%
  as_draws_matrix()
  
rowsrandom <- sample(nrow(y_pred_B), 100)

theta_1<-  grep(pattern = "1]",x = colnames(y_pred_B),value = TRUE)
theta_2<-  grep(pattern = "2]",x = colnames(y_pred_B),value = TRUE)
theta_3<-  grep(pattern = "3]",x = colnames(y_pred_B),value = TRUE)
y_pred1 <- y_pred_B[rowsrandom,theta_1 ]
y_pred2 <- y_pred_B[rowsrandom,theta_2 ]
y_pred3 <- y_pred_B[rowsrandom,theta_3 ]

ppc_dens_overlay(y = as.numeric(theta_dir$Ocupado), y_pred1)/
  ppc_dens_overlay(y = as.numeric(theta_dir$Desocupado), y_pred2)/
  ppc_dens_overlay(y = as.numeric(theta_dir$Inactivo), y_pred3)

La matriz de correlación de los efectos aleatorios.

omega <- summary(fit,"Omega")$summary
tba(omega)

	mean	se_mean	sd	2.5%	25%	50%	75%	97.5%	n_eff	Rhat
Omega[1,1]	1.0000	NaN	0.0000	1.0000	1.0000	1.0000	1.0000	1.0000	NaN	NaN
Omega[1,2]	0.4851	0.002	0.0429	0.3976	0.4576	0.4864	0.5153	0.5639	462.4828	1.0058
Omega[2,1]	0.4851	0.002	0.0429	0.3976	0.4576	0.4864	0.5153	0.5639	462.4828	1.0058
Omega[2,2]	1.0000	0.000	0.0000	1.0000	1.0000	1.0000	1.0000	1.0000	3358.3429	0.9990

10.4.1 Estimación de los parámetros.

El código crea dos matrices, theta_obs_ordenado y theta_pred_ordenado, que contienen las estimaciones medias de los parámetros del modelo de respuesta multinomial con covariables para los datos de observación y predicción, respectivamente. La función matrix() se utiliza para dar formato a los datos con una matriz nrow x ncol, y se asignan nombres de columna apropiados a la matriz resultante utilizando colnames(). Luego se convierten las matrices en marcos de datos (as.data.frame()) y se unen mediante full_join() para crear una única tabla que contenga todas las estimaciones de los parámetros para los datos de observación y predicción, junto con la información del indicador de área (theta_dir). El resultado final es un marco de datos llamado estimaciones_obs.

dam_pred <- readRDS("01 Modelo de area/MEX/2020/Data/dam_pred.rds")
P <- 3 
D <- nrow(indicador_dam1)
D1 <- nrow(dam_pred)
## Estimación del modelo. 
theta_obs <- summary(fit, pars = "theta")$summary[, "mean"]
theta_pred <- summary(fit, pars = "theta_pred")$summary[, "mean"]

## Ordenando la matrix de theta 
theta_obs_ordenado <- matrix(theta_obs, 
                             nrow = D,
                             ncol = P,byrow = TRUE) 

colnames(theta_obs_ordenado) <- c("Ocupado_mod", "Desocupado_mod", "Inactivo_mod")
theta_obs_ordenado%<>% as.data.frame()
theta_obs_ordenado <- cbind(dam2 = indicador_dam1$dam2,
                            theta_obs_ordenado)

theta_pred_ordenado <- matrix(theta_pred, 
                             nrow = D1,
                             ncol = P,byrow = TRUE)

colnames(theta_pred_ordenado) <- c("Ocupado_mod", "Desocupado_mod", "Inactivo_mod")
theta_pred_ordenado%<>% as.data.frame()
theta_pred_ordenado <- cbind(dam2 = dam_pred$dam2, theta_pred_ordenado)

10.4.1.1 Estimación del desviación estárdar y el coeficiente de valiación

Este bloque de código corresponde al cálculo de las desviaciones estándar (sd) y coeficientes de variación (cv) de los parámetros theta para los datos observados y predichos. En primer lugar, se utiliza la función summary() del paquete rstan para extraer los valores de sd de los parámetros theta observados y predichos, respectivamente, a partir del modelo (fit) que contiene la información de la estimación de los parámetros de la distribución Bayesiana. Luego, se organizan los valores de sd en una matriz ordenada por dam2 y se les asignan los nombres correspondientes. Con esta matriz, se calcula otra matriz que contiene los coeficientes de variación para los parámetros theta observados (theta_obs_ordenado_cv). De manera similar, se construyen matrices ordenadas por dam2 para los valores de sd y cv de los parámetros theta predichos (theta_pred_ordenado_sd y theta_pred_ordenado_cv, respectivamente).

theta_obs_sd <- summary(fit, pars = "theta")$summary[, "sd"]
theta_pred_sd <- summary(fit, pars = "theta_pred")$summary[, "sd"]

theta_obs_ordenado_sd <- matrix(theta_obs_sd, 
                             nrow = D,
                             ncol = P,byrow = TRUE) 

colnames(theta_obs_ordenado_sd) <- c("Ocupado_mod_sd", "Desocupado_mod_sd", "Inactivo_mod_sd")
theta_obs_ordenado_sd%<>% as.data.frame()
theta_obs_ordenado_sd <- cbind(dam2 = indicador_dam1$dam2,
                            theta_obs_ordenado_sd)
theta_obs_ordenado_cv <- theta_obs_ordenado_sd[,-1]/theta_obs_ordenado[,-1]

colnames(theta_obs_ordenado_cv) <- c("Ocupado_mod_cv", "Desocupado_mod_cv", "Inactivo_mod_cv")

theta_obs_ordenado_cv <- cbind(dam2 = indicador_dam1$dam2,
                               theta_obs_ordenado_cv)

theta_pred_ordenado_sd <- matrix(theta_pred_sd, 
                              nrow = D1,
                              ncol = P,byrow = TRUE)

colnames(theta_pred_ordenado_sd) <- c("Ocupado_mod_sd", "Desocupado_mod_sd", "Inactivo_mod_sd")
theta_pred_ordenado_sd%<>% as.data.frame()
theta_pred_ordenado_sd <- cbind(dam2 = dam_pred$dam2, theta_pred_ordenado_sd)

theta_pred_ordenado_cv <- theta_pred_ordenado_sd[,-1]/theta_pred_ordenado[,-1]

colnames(theta_pred_ordenado_cv) <- c("Ocupado_mod_cv", "Desocupado_mod_cv", "Inactivo_mod_cv")

theta_pred_ordenado_cv <- cbind(dam2 = dam_pred$dam2, theta_pred_ordenado_cv)

El último paso es realizar la consolidación de la bases obtenidas para la estimación puntual, desviación estándar y coeficiente de variación.

theta_obs_ordenado <- full_join(theta_obs_ordenado,theta_obs_ordenado_sd) %>% 
  full_join(theta_obs_ordenado_cv)

theta_pred_ordenado <- full_join(theta_pred_ordenado,theta_pred_ordenado_sd) %>% 
  full_join(theta_pred_ordenado_cv)


estimaciones <- full_join(indicador_dam1,
                              bind_rows(theta_obs_ordenado, theta_pred_ordenado))

saveRDS(object = estimaciones, file = "Rmd/MEX/Recursos/estimaciones.rds")
tba(head(estimaciones,10))

dam2	n_upm	n_ocupado	n_desocupado	n_inactivo	Ocupado	Ocupado_se	Ocupado_var	Ocupado_deff	Desocupado	Desocupado_se	Desocupado_var	Desocupado_deff	Inactivo	Inactivo_se	Inactivo_var	Inactivo_deff	id_orden	Ocupado_mod	Desocupado_mod	Inactivo_mod	Ocupado_mod_sd	Desocupado_mod_sd	Inactivo_mod_sd	Ocupado_mod_cv	Desocupado_mod_cv	Inactivo_mod_cv
01001	274	2560	151	1609	0.5927	0.0082	1e-04	1.2035	0.0361	0.0032	0e+00	1.3006	0.3712	0.0079	1e-04	1.1630	1	0.5921	0.0358	0.3721	0.0079	0.0030	0.0078	0.0134	0.0840	0.0210
01002	5	199	8	149	0.5602	0.0104	1e-04	0.1579	0.0223	0.0063	0e+00	0.6451	0.4175	0.0091	1e-04	0.1235	2	0.5611	0.0225	0.4164	0.0098	0.0028	0.0097	0.0175	0.1254	0.0233
01003	8	238	18	194	0.5399	0.0158	2e-04	0.4575	0.0362	0.0075	1e-04	0.7328	0.4239	0.0138	2e-04	0.3554	3	0.5414	0.0342	0.4244	0.0149	0.0051	0.0148	0.0275	0.1489	0.0348
01005	27	619	25	298	0.6365	0.0182	3e-04	1.3637	0.0352	0.0077	1e-04	1.6567	0.3283	0.0157	2e-04	1.0603	4	0.6306	0.0335	0.3360	0.0169	0.0060	0.0164	0.0268	0.1804	0.0487
01006	7	273	14	194	0.5801	0.0200	4e-04	0.7957	0.0264	0.0056	0e+00	0.5836	0.3935	0.0180	3e-04	0.6536	5	0.5805	0.0269	0.3926	0.0176	0.0054	0.0172	0.0304	0.2023	0.0437
01007	8	334	9	225	0.6132	0.0312	1e-03	2.3457	0.0155	0.0059	0e+00	1.3093	0.3714	0.0300	9e-04	2.2054	6	0.6089	0.0205	0.3706	0.0273	0.0063	0.0264	0.0449	0.3091	0.0711
01009	2	78	2	51	0.6034	0.0225	5e-04	0.2796	0.0119	0.0095	1e-04	1.0159	0.3847	0.0130	2e-04	0.0943	7	0.6023	0.0152	0.3825	0.0167	0.0035	0.0163	0.0278	0.2332	0.0426
01011	8	324	17	177	0.6359	0.0290	8e-04	1.9003	0.0298	0.0074	1e-04	0.9842	0.3343	0.0319	1e-03	2.3912	8	0.6252	0.0291	0.3458	0.0264	0.0081	0.0252	0.0422	0.2783	0.0730
02001	73	1359	55	979	0.5488	0.0190	4e-04	3.5128	0.0230	0.0050	0e+00	2.6845	0.4282	0.0181	3e-04	3.2195	9	0.5493	0.0253	0.4253	0.0175	0.0050	0.0172	0.0318	0.1989	0.0404
02002	141	2014	93	1644	0.5537	0.0113	1e-04	1.9590	0.0221	0.0039	0e+00	2.6821	0.4242	0.0110	1e-04	1.8694	10	0.5537	0.0234	0.4229	0.0110	0.0033	0.0109	0.0199	0.1419	0.0258