8.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/COL/2018/Data/fit_multinomial_cor.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.3113	0.0035	0.0632	0.1833	0.2703	0.3119	0.3553	0.4289	328.6787	1.0138
Omega[2,1]	0.3113	0.0035	0.0632	0.1833	0.2703	0.3119	0.3553	0.4289	328.6787	1.0138
Omega[2,2]	1.0000	0.0000	0.0000	1.0000	1.0000	1.0000	1.0000	1.0000	3935.2880	0.9990

8.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/COL/2018/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)

8.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/COL/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
05001	806	13447	1805	8453	0.5772	0.0039	0.0000	1.5169	0.0775	0.0022	0e+00	1.6507	0.3453	0.0038	0.0000	1.5436	1	0.5773	0.0775	0.3452	0.0041	0.0021	0.0039	0.0070	0.0273	0.0112
05002	10	102	7	118	0.4618	0.0202	0.0004	0.3739	0.0293	0.0083	1e-04	0.5478	0.5089	0.0186	0.0003	0.3127	2	0.4677	0.0320	0.5003	0.0195	0.0065	0.0195	0.0417	0.2031	0.0389
05031	7	89	8	69	0.5307	0.0405	0.0016	1.0904	0.0626	0.0308	9e-04	2.6768	0.4066	0.0373	0.0014	0.9557	3	0.5368	0.0581	0.4050	0.0344	0.0152	0.0336	0.0641	0.2611	0.0830
05034	6	100	3	82	0.5666	0.0322	0.0010	0.7805	0.0204	0.0076	1e-04	0.5345	0.4130	0.0327	0.0011	0.8153	4	0.5628	0.0316	0.4056	0.0296	0.0092	0.0295	0.0526	0.2904	0.0728
05045	13	196	33	175	0.4808	0.0368	0.0014	2.1892	0.0920	0.0188	4e-04	1.7104	0.4272	0.0322	0.0010	1.7154	5	0.4971	0.0782	0.4247	0.0313	0.0165	0.0308	0.0629	0.2109	0.0725
05079	6	71	14	74	0.4434	0.0460	0.0021	1.3676	0.0882	0.0130	2e-04	0.3359	0.4683	0.0521	0.0027	1.7387	6	0.4818	0.0782	0.4401	0.0367	0.0190	0.0359	0.0762	0.2432	0.0815
05088	129	2169	321	1406	0.5647	0.0082	0.0001	1.0658	0.0827	0.0047	0e+00	1.1399	0.3526	0.0079	0.0001	1.0680	7	0.5650	0.0824	0.3525	0.0082	0.0045	0.0080	0.0145	0.0551	0.0226
05093	6	81	1	55	0.5998	0.0415	0.0017	0.9791	0.0091	0.0088	1e-04	1.1823	0.3911	0.0455	0.0021	1.1878	8	0.5817	0.0276	0.3907	0.0373	0.0098	0.0365	0.0641	0.3561	0.0935
05120	6	66	6	76	0.4384	0.0249	0.0006	0.3721	0.0300	0.0115	1e-04	0.6732	0.5316	0.0285	0.0008	0.4811	9	0.4545	0.0302	0.5153	0.0249	0.0079	0.0249	0.0549	0.2607	0.0483
05129	17	273	22	201	0.5574	0.0145	0.0002	0.4255	0.0439	0.0090	1e-04	0.9649	0.3987	0.0191	0.0004	0.7575	10	0.5588	0.0450	0.3962	0.0153	0.0063	0.0151	0.0273	0.1402	0.0380