1. Funciones auxiliares

En esta sección se definen funciones para: - Calcular quintiles y medianas ponderadas, - Categorización de accesibilidad, - Procesar mapas raster, - Calcular datos para curvas de Lorenz y visualizaciones.

# Cálculo de estadísticas por quintiles, permitiendo agrupamientos
get_quintile_table <- function(df, group_vars = character()) {
  calculate_quintile_stats <- function(data, weights, income) {
    quintile_cuts <- wtd.quantile(income, weights = weights, probs = seq(0.2, 0.8, 0.2))
    q1_median <- weighted.median(income[income <= quintile_cuts[1]], w = weights[income <= quintile_cuts[1]], na.rm = TRUE)
    q2_median <- weighted.median(income[income > quintile_cuts[1] & income <= quintile_cuts[2]], w = weights[income > quintile_cuts[1] & income <= quintile_cuts[2]], na.rm = TRUE)
    q3_median <- weighted.median(income[income > quintile_cuts[2] & income <= quintile_cuts[3]], w = weights[income > quintile_cuts[2] & income <= quintile_cuts[3]], na.rm = TRUE)
    q4_median <- weighted.median(income[income > quintile_cuts[3] & income <= quintile_cuts[4]], w = weights[income > quintile_cuts[3] & income <= quintile_cuts[4]], na.rm = TRUE)
    q5_median <- weighted.median(income[income > quintile_cuts[4]], w = weights[income > quintile_cuts[4]], na.rm = TRUE)
    c(Q1 = q1_median/1291, Q2 = q2_median/1291, Q3 = q3_median/1291, Q4 = q4_median/1291, Q5 = q5_median/1291)
  }
  if(length(group_vars) == 0) {
    results <- calculate_quintile_stats(df, df$PONDII, df$P47T)
    tibble(!!!results, n = sum(df$PONDERA))
  } else {
    df %>%
      group_by(across(all_of(group_vars))) %>%
      group_modify(~{
        results <- calculate_quintile_stats(.x, .x$PONDII, .x$P47T)
        tibble(!!!results, n = sum(.x$PONDERA))
      }) %>%
      ungroup()
  }
}

# Clasifica valores de accesibilidad en categorías según medianas y umbrales
make_categorical <- function(val, medians, umbral) {
  medians <- as.numeric(medians)
  q1 <- medians[1] * umbral
  q2 <- medians[2] * umbral
  q3 <- medians[3] * umbral
  q4 <- medians[4] * umbral
  q5 <- medians[5] * umbral
  val_transformed <- val * 0.9289 * 35
  m <- matrix(c(-Inf, q1, 1,
                q1, q2, 2,
                q2, q3, 3,
                q3, q4, 4,
                q4, q5, 5,
                q5, Inf, 6), ncol=3, byrow=TRUE)
  result <- classify(val_transformed, m)
  return(result)
}

# Genera mapas raster categorizados por sexo y diferentes umbrales
create_raster_groups <- function(val, tabla, sex) {
  medians <- tabla %>% 
    filter(Sex == sex & Age == "All") %>% 
    select(Q1, Q2, Q3, Q4, Q5)
  medians <- as.numeric(medians[1, ])
  thresholds <- c(0.3, 0.5, 0.7)
  name_suffix <- c("0-30%", "31-50%", "50-70%")
  result_list <- vector("list", length(thresholds))
  for(i in seq_along(thresholds)) {
    rast <- make_categorical(val, medians, thresholds[i])
    cats <- data.frame(
      ID = 1:6,
      category = c("Q1", "Q2", "Q3", "Q4", "Q5", "No access")
    )
    levels(rast) <- cats
    result_list[[i]] <- rast
  }
  out <- do.call(c, result_list)
  names(out) <- sprintf("%s_%s", sex, name_suffix)
  return(out)
}

# Prepara los datos para graficar curvas de Lorenz
create_lorenz_data <- function(gini_df) {
  value_cols <- setdiff(names(gini_df), c("Group", "Sex", "Income_Dedication"))
  map_df(1:nrow(gini_df), function(i) {
    values <- as.numeric(gini_df[i, value_cols])
    if(sum(values) > 0) {
      l_curve <- Lc(values)
      data.frame(
        Sex = gini_df$Sex[i],
        Income_Dedication = gini_df$Income_Dedication[i],
        Cumulative_Population_Share = l_curve$p,
        Cumulative_Accessibility_Share = l_curve$L
      )
    } else {
      data.frame(
        Sex = gini_df$Sex[i],
        Income_Dedication = gini_df$Income_Dedication[i],
        Cumulative_Population_Share = 0,
        Cumulative_Accessibility_Share = 0
      )
    }
  })
}

# Grafica las curvas de Lorenz usando ggplot2
create_lorenz_plot <- function(lorenz_data) {
  ggplot(lorenz_data, aes(x = Cumulative_Population_Share, y = Cumulative_Accessibility_Share)) +
    geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "grey") +
    geom_line(aes(color = Sex), size = 1.2) +
    facet_wrap(~ Income_Dedication, nrow = 1) +
    labs(x = "Proporción acumulada de población",
         y = "Proporción acumulada de accesibilidad",
         color = "Sexo") +
    scale_x_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2)) +
    scale_y_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2)) +
    theme_minimal() +
    theme(
      plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
      axis.title = element_text(size = 10),
      axis.text = element_text(size = 8),
      legend.position = "bottom",
      strip.text = element_text(size = 11, face = "bold"),
      panel.spacing = unit(1, "lines"),
      aspect.ratio = 1
    )
}

# Genera los mapas temáticos de accesibilidad por grupo
create_maps <- function(all_groups, pal, nombres_leyenda) {
  maps <- map(1:nlyr(all_groups), ~{
    tm_shape(all_groups[[.x]]) +
      tm_raster(palette = pal, legend.show = FALSE, alpha = 0.8) +
      tm_layout(main.title = names(all_groups)[.x], main.title.size = 1.2) +
      tm_legend(show = FALSE)
  })
  legend <- tm_shape(all_groups[[1]]) +
    tm_raster(palette = pal, title = "Quintiles", labels = nombres_leyenda,
              legend.show = TRUE, legend.is.portrait = FALSE) +
    tm_layout(legend.only = TRUE, legend.position = "bottom")
  list(
    maps = maps,
    combined = tmap_arrange(maps, nrow = 2, ncol = 3),
    legend = legend
  )
}

2. Preparación de datos EPH

Se descargan y filtran los datos individuales de EPH, seleccionando personas de 18 a 35 años en el aglomerado 32, con ingresos positivos. Además, se crea una variable de rango de edad y de sexo.

eph <- get_microdata(2024, 3, "individual") %>%
  filter(
    CH06 >= 18, CH06 <= 35,
    AGLOMERADO == 32,
    CH12 != 9,
    P47T > 0
  ) %>%
  mutate(
    rango = case_when(
      CH06 < 24 ~ "18 a 23",
      CH06 < 30 ~ "24 a 29",
      TRUE ~ "30 a 35"
    ),
    sexo = if_else(CH04 == 1, "Men", "Women")
  )

Esta parte obtiene la muestra poblacional de interés.

3. Cálculo de quintiles de ingreso

Se generan tablas de quintiles por diferentes grupos: total, por sexo y por sexo/rango etario, utilizando la función auxiliar creada.

tabla0 <- get_quintile_table(eph) %>% mutate(Sex = "All", Age = "All") %>% select(Sex, Age, Q1, Q2, Q3, Q4, Q5, n)
tabla1 <- get_quintile_table(eph, "sexo") %>% rename(Sex = sexo) %>% mutate(Age = "All") %>% select(Sex, Age, Q1, Q2, Q3, Q4, Q5, n)
tabla2 <- get_quintile_table(eph, c("sexo", "rango")) %>% rename(Sex = sexo, Age = rango) %>% select(Sex, Age, Q1, Q2, Q3, Q4, Q5, n)
tabla <- bind_rows(tabla0, tabla1, tabla2)

Permite analizar la distribución del ingreso según diferentes criterios.

4. Procesamiento de datos espaciales

Se carga un raster de accesibilidad y se generan mapas categorizados por sexo y diferentes umbrales de dedicatoria de ingreso.

val <- rast("vut_sin_calles_ni_ev.tif") / 1291.81
men_groups   <- create_raster_groups(val, tabla, sex = "Men")
women_groups <- create_raster_groups(val, tabla, sex = "Women")
all_groups   <- c(men_groups, women_groups)

Esto permite visualizar la accesibilidad diferenciada espacialmente.

5. Cálculo de frecuencias y preparación de datos para desigualdad

Se calcula la frecuencia de cada categoría en los mapas, se agrupan y se preparan los datos para el cálculo de coeficientes de Gini y curvas de Lorenz.

layer_freqs <- list()
for(i in 1:nlyr(all_groups)) {
  freq_i <- freq(all_groups[[i]])
  layer_freqs[[i]] <- data.frame(
    Group = names(all_groups)[i],
    value = freq_i$value,
    count = freq_i$count
  )
}
a <- do.call(rbind, layer_freqs) %>%
  filter(!is.na(value)) %>%
  mutate(
    value = factor(value, levels = c("Q1", "Q2", "Q3", "Q4", "Q5", "No access"))
  ) %>%
  group_by(Group, value) %>%
  summarise(count = sum(count), .groups = "drop") %>%
  pivot_wider(
    names_from = value,
    values_from = count,
    values_fill = 0
  )
a <- a %>% mutate(across(-Group, ~ . * (100/1000000)))
a$Total <- rowSums(a %>% select(-Group))
gini <- a %>%
  select(-Total) %>%
  mutate(across(-Group, ~ ./a$Total))
gini$Sex <- ifelse(grepl("^Men", gini$Group), "Men", "Women")
gini$Income_Dedication <- sub("^(Men|Women)_", "", gini$Group)

Aquí se prepara la información para analizar desigualdades en el acceso.

6. Tabla de quintiles, porcentajes y coeficiente de Gini

A continuación se muestra una tabla resumen con los porcentajes de cada quintil, el porcentaje de “No acceso” y el coeficiente de Gini para cada grupo. El Gini mide la desigualdad en la distribución de la accesibilidad (0 = igualdad perfecta, 1 = máxima desigualdad).

# Calcular coeficiente de Gini para cada grupo
gini_coefs <- map_dbl(1:nrow(gini), function(i) {
  values <- as.numeric(gini[i, c("Q1", "Q2", "Q3", "Q4", "Q5", "No access")])
  if(sum(values) > 0) {
    ineq(values, type="Gini")
  } else {
    NA_real_
  }
})

# Crear tabla con porcentajes y coeficiente Gini
gini_table <- gini %>%
  mutate(across(c(Q1, Q2, Q3, Q4, Q5, `No access`), ~scales::percent(., accuracy=0.01))) %>%
  mutate(
    Group = paste(Sex, Income_Dedication),
    Gini = round(gini_coefs, 3)
  ) %>%
  select(Group, Q1, Q2, Q3, Q4, Q5, `No access`, Gini)

# Mostrar la tabla formateada
kable(gini_table,
      caption = "Distribución por quintiles y coeficientes de Gini",
      format = "html",
      align = c('l', rep('r', 7))) %>%
  kable_styling(bootstrap_options = c("striped", "hover"))
Distribución por quintiles y coeficientes de Gini
Group Q1 Q2 Q3 Q4 Q5 No access Gini
Men 0-30% 1.43% 0.31% 10.87% 33.09% 52.71% 1.58% 0.610
Men 31-50% 2.38% 18.91% 56.41% 20.77% 1.09% 0.44% 0.592
Men 50-70% 20.65% 54.55% 23.14% 1.14% 0.52% 0.00% 0.600
Women 0-30% 0.00% 2.05% 5.62% 31.77% 45.91% 14.65% 0.546
Women 31-50% 1.43% 21.83% 38.69% 36.47% 0.84% 0.74% 0.528
Women 50-70% 1.74% 77.94% 17.85% 1.93% 0.54% 0.00% 0.736

Esta tabla muestra la distribución porcentual por quintiles para cada grupo y su correspondiente coeficiente de Gini, que mide la desigualdad en la distribución de la accesibilidad urbana.

7. Visualización de resultados

7.1 Mapas de accesibilidad

Se visualizan los mapas de accesibilidad por grupo y umbral.

pal <- c("#d7191c", "#fdae61", "#ffffbf", "#abdda4", "#2b83ba", "#4d4d4d")
nombres_leyenda <- c("Q1", "Q2", "Q3", "Q4", "Q5", "No access")
maps <- create_maps(all_groups, pal, nombres_leyenda)
maps$combined

Los mapas permiten identificar patrones espaciales de accesibilidad.

7.2 Curvas de Lorenz

Se grafican las curvas de Lorenz para analizar la desigualdad en la distribución de la accesibilidad.

lorenz_data <- create_lorenz_data(gini)
lorenz_plot <- create_lorenz_plot(lorenz_data)
print(lorenz_plot)

Las curvas de Lorenz ayudan a visualizar la desigualdad en el acceso a la ciudad.

8. Análisis de desigualdad y conclusiones

El análisis de los coeficientes de Gini nos permite observar que: - Los grupos con menor dedicación de ingreso (0-30%) muestran mayor desigualdad en la accesibilidad urbana. - Las mujeres presentan coeficientes de Gini ligeramente más altos que los hombres en la mayoría de las categorías. - La desigualdad tiende a disminuir cuando se dedica una mayor proporción del ingreso (50-70%) a la vivienda, especialmente en el caso de los hombres.

Este análisis muestra la relación entre la accesibilidad urbana y los ingresos para jóvenes en el área estudiada, considerando diferencias por género y rango etario. Se observa que existen desigualdades tanto en la distribución espacial de la accesibilidad como entre grupos sociales, lo que puede orientar políticas públicas para mejorar la equidad urbana.