9.5 Metodología de Benchmarking

  1. Conteos de personas agregados por dam2, personas mayores de 15 años de edad.
conteo_pp_dam <- readRDS("01 Modelo de area/PER/2017/Data/censo_dam2.rds") %>%
  filter(edad > 1)  %>% 
  group_by(dam = depto, dam2 = mpio) %>% 
  summarise(pp_dam2 = sum(n)) %>% 
  add_tally(wt = pp_dam2, name = "pp_dam") %>% 
  mutate(dam2 = case_when(dam2 == "120606"~"120699",
                          TRUE ~ dam2))
  1. Estimación del parámetro theta al nivel que la encuesta sea representativa.
Razon_empleo  <- readRDS("Rmd/PER/Recursos/Razon_empleo.rds")
tba(data.frame(estimate_dir = Razon_empleo) %>% head(10))
estimate_dir
dam_01_Ocupado 0.7462
dam_02_Ocupado 0.7066
dam_03_Ocupado 0.7846
dam_04_Ocupado 0.6630
dam_05_Ocupado 0.7219
dam_06_Ocupado 0.7791
dam_07_Ocupado 0.6290
dam_08_Ocupado 0.7574
dam_09_Ocupado 0.8197
dam_10_Ocupado 0.7163
  1. Definir los pesos por dominios.
names_cov <-  "dam"
estimaciones_mod <- estimaciones %>% transmute(
  dam = substr(dam2,1,2),
  dam2,Ocupado_mod,Desocupado_mod,Inactivo_mod) %>% 
  inner_join(conteo_pp_dam ) %>% 
  mutate(wi = pp_dam2/pp_dam)
  1. Crear variables dummys
estimaciones_mod %<>%
  fastDummies::dummy_cols(select_columns = names_cov,
                          remove_selected_columns = FALSE)

Xdummy <- estimaciones_mod %>% select(matches("dam_")) %>% 
  mutate_at(vars(matches("_\\d")) ,
            list(Ocupado = function(x) x*estimaciones_mod$Ocupado_mod,
                 Desocupado = function(x) x*estimaciones_mod$Desocupado_mod,
                 Inactivo = function(x) x*estimaciones_mod$Inactivo_mod)) %>% 
  select((matches("Ocupado|Desocupado|Inactivo")))
  1. Calcular el ponderador para cada nivel de la variable.

Ocupado

names_ocupado <- grep(pattern = "_O", x = colnames(Xdummy),value = TRUE)
gk_ocupado <- calib(Xs = Xdummy[,names_ocupado] %>% as.matrix(), 
            d =  estimaciones_mod$wi,
            total = Razon_empleo[names_ocupado] %>% as.matrix(),
            method="logit",max_iter = 5000,) 

checkcalibration(Xs = Xdummy[,names_ocupado] %>% as.matrix(), 
                 d =estimaciones_mod$wi,
                 total = Razon_empleo[names_ocupado] %>% as.matrix(),
                 g = gk_ocupado,)

Desocupado

names_descupados <- grep(pattern = "_D", x = colnames(Xdummy),value = TRUE)

gk_desocupado <- calib(Xs = Xdummy[,names_descupados]%>% as.matrix(), 
                    d =  estimaciones_mod$wi,
                    total = Razon_empleo[names_descupados]%>% as.matrix(),
                    method="logit",max_iter = 5000) 

checkcalibration(Xs = Xdummy[,names_descupados]%>% as.matrix(), 
                 d =estimaciones_mod$wi,
                 total = Razon_empleo[names_descupados]%>% as.matrix(),
                 g = gk_desocupado,)

Inactivo

names_inactivo <- grep(pattern = "_I", x = colnames(Xdummy),value = TRUE)

gk_Inactivo <- calib(Xs = Xdummy[,names_inactivo]%>% as.matrix(), 
                    d =  estimaciones_mod$wi,
                    total = Razon_empleo[names_inactivo]%>% as.matrix(),
                    method="logit",max_iter = 5000) 

checkcalibration(Xs = Xdummy[,names_inactivo]%>% as.matrix(), 
                 d =estimaciones_mod$wi,
                 total = Razon_empleo[names_inactivo]%>% as.matrix(),
                 g = gk_Inactivo,)
  1. Validar los resultados obtenidos.
par(mfrow = c(1,3))
hist(gk_ocupado)
hist(gk_desocupado)
hist(gk_Inactivo)

  1. Estimaciones ajustadas por el ponderador
estimacionesBench <- estimaciones_mod %>%
  mutate(gk_ocupado, gk_desocupado, gk_Inactivo) %>%
  transmute(
    dam,
    dam2,
    wi,gk_ocupado, gk_desocupado, gk_Inactivo,
    Ocupado_Bench = Ocupado_mod*gk_ocupado,
    Desocupado_Bench = Desocupado_mod*gk_desocupado,
    Inactivo_Bench = Inactivo_mod*gk_Inactivo
  )
  1. Validación de resultados.
indicador_agregado <- readRDS("Rmd/PER/Recursos/indicador_agregado.rds")
estimacionesBench %>%
  group_by(dam) %>% 
  summarise(Ocupado_Bench = sum(wi*Ocupado_Bench),
            Desocupado_Bench = sum(wi*Desocupado_Bench),
            Inactivo_Bench = sum(wi*Inactivo_Bench)) %>% 
  inner_join(indicador_agregado) %>% tba()
dam Ocupado_Bench Desocupado_Bench Inactivo_Bench Ocupado Desocupado Inactivo
01 0.7462 0.0114 0.2424 0.7462 0.0114 0.2424
02 0.7066 0.0197 0.2738 0.7066 0.0197 0.2738
03 0.7846 0.0126 0.2027 0.7846 0.0126 0.2027
04 0.6630 0.0294 0.3077 0.6630 0.0294 0.3077
05 0.7219 0.0201 0.2580 0.7219 0.0201 0.2580
06 0.7791 0.0126 0.2083 0.7791 0.0126 0.2083
07 0.6290 0.0434 0.3275 0.6290 0.0434 0.3275
08 0.7574 0.0212 0.2214 0.7574 0.0212 0.2214
09 0.8197 0.0171 0.1632 0.8197 0.0171 0.1632
10 0.7163 0.0225 0.2612 0.7163 0.0225 0.2612
11 0.6504 0.0177 0.3319 0.6504 0.0177 0.3319
12 0.7020 0.0136 0.2844 0.7020 0.0136 0.2844
13 0.6726 0.0203 0.3071 0.6726 0.0203 0.3071
14 0.6457 0.0221 0.3323 0.6457 0.0221 0.3323
15 0.6474 0.0428 0.3099 0.6474 0.0428 0.3099
16 0.6771 0.0154 0.3075 0.6771 0.0154 0.3075
17 0.7257 0.0145 0.2597 0.7257 0.0145 0.2597
18 0.6795 0.0308 0.2897 0.6795 0.0308 0.2897
19 0.7215 0.0294 0.2491 0.7215 0.0294 0.2491
20 0.6608 0.0175 0.3217 0.6608 0.0175 0.3217
21 0.7522 0.0202 0.2277 0.7522 0.0202 0.2277
22 0.7264 0.0179 0.2557 0.7264 0.0179 0.2557
23 0.6498 0.0280 0.3222 0.6498 0.0280 0.3222
24 0.6737 0.0314 0.2950 0.6737 0.0314 0.2950
25 0.7046 0.0199 0.2755 0.7046 0.0199 0.2755
  1. Guardar resultados
estimaciones <- inner_join(estimaciones,estimacionesBench)
saveRDS(object = estimaciones, file = "Rmd/PER/Recursos/estimaciones_Bench.rds")