Ejercicio desigualdad

Librerías

# CARGAR LIBRERiAS NECESARIAS
library(dplyr)

## Warning: package 'dplyr' was built under R version 4.4.3

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(ineq)

Coeficiente de Gini

calcular_gini <- function(ingresos) {
  return(ineq::Gini(ingresos))
}

Desviación estándar de logaritmos

calcular_sd_log <- function(ingresos) {
  # Agregar 1 para evitar problemas con log(0) y luego ajustar
  ingresos_ajustados <- ingresos + 1
  return(sd(log(ingresos_ajustados)))
}

Ratio P90/10

calcular_ratio_p90_p10 <- function(ingresos) {
  p90 <- quantile(ingresos, 0.9)
  p10 <- quantile(ingresos, 0.1)
  return(as.numeric(p90 / p10))
}

Índice de Theil

calcular_theil <- function(ingresos) {
  n <- length(ingresos)
  ingreso_promedio <- mean(ingresos)
  # F?rmula: Theil = (1/n) * ?? (x_i/??) * log(x_i/??)
  theil <- (1/n) * sum((ingresos/ingreso_promedio) * log(ingresos/ingreso_promedio))
  return(theil)
}

Índice de Atkinson con diferentes epsilons

calcular_atkinson <- function(ingresos, epsilon = 0.5) {
  n <- length(ingresos)
  ingreso_promedio <- mean(ingresos)
  
  if (epsilon == 1) {
    # Caso especial cuando epsilon = 1
    atkinson <- 1 - (prod(ingresos)^(1/n)) / ingreso_promedio
  } else {
    # Caso general para epsilon ??? 1
    atkinson <- 1 - (mean((ingresos/ingreso_promedio)^(1-epsilon))^(1/(1-epsilon)))
  }
  return(atkinson)
}

Vector 1: Distribución base desigual

ingresos_base <- c(10, 15, 20, 25, 30, 35, 40, 60, 100, 200)

Vector 2: misma distibución pero con incremento constante

# Esto deber?a mantener la desigualdad relativa (axioma de independencia de escala)
ingresos_incremento <- ingresos_base + 50

Vector 3: Transferencia del percentil 90 más pobre

# Vamos a hacer una transferencia progresiva: del m?s rico al m?s pobre dentro del 90%
ingresos_transferencia <- c(10, 15, 20, 25, 35, 35, 35, 70, 90, 200)

Resultados

calcular_todas_medidas <- function(ingresos, nombre) {
  data.frame(
    Poblacion = nombre,
    Gini = round(calcular_gini(ingresos), 4),
    SD_Log = round(calcular_sd_log(ingresos), 4),
    Ratio_P90_P10 = round(calcular_ratio_p90_p10(ingresos), 2),
    Theil = round(calcular_theil(ingresos), 4),
    Atkinson_05 = round(calcular_atkinson(ingresos, 0.5), 4),
    Atkinson_10 = round(calcular_atkinson(ingresos, 1.0), 4),
    Atkinson_15 = round(calcular_atkinson(ingresos, 1.5), 4),
    Media = round(mean(ingresos), 2),
    Mediana = round(median(ingresos), 2)
  )
}

Medias

resultados <- rbind(
  calcular_todas_medidas(ingresos_base, "Base (desigual)"),
  calcular_todas_medidas(ingresos_incremento, "Con incremento constante"),
  calcular_todas_medidas(ingresos_transferencia, "Con transferencia progresiva")
)

print y visualización

print("MEDIDAS DE DESIGUALDAD PARA LAS TRES POBLACIONES")

## [1] "MEDIDAS DE DESIGUALDAD PARA LAS TRES POBLACIONES"

print(resultados)

##                      Poblacion   Gini SD_Log Ratio_P90_P10  Theil Atkinson_05
## 1              Base (desigual) 0.4776 0.8681          7.59 0.4014      0.1830
## 2     Con incremento constante 0.2469 0.4325          2.48 0.1144      0.0524
## 3 Con transferencia progresiva 0.4701 0.8639          6.97 0.3930      0.1796
##   Atkinson_10 Atkinson_15 Media Mediana
## 1      0.3249      0.4279  53.5    32.5
## 2      0.0955      0.1304 103.5    82.5
## 3      0.3202      0.4236  53.5    35.0

par(mfrow = c(2, 2))

plot(1:10, ingresos_base, type = "b", col = "blue", lwd = 2, 
     ylim = c(0, max(ingresos_incremento)), 
     xlab = "Individuos (ordenados por ingreso)", ylab = "Ingreso",
     main = "Comparaci?n de Distribuciones")
lines(1:10, ingresos_incremento, type = "b", col = "red", lwd = 2)
lines(1:10, ingresos_transferencia, type = "b", col = "green", lwd = 2)
legend("topleft", legend = c("Base", "Incremento", "Transferencia"), 
       col = c("blue", "red", "green"), lwd = 2)

# Gr?fico 2: Coeficiente de Gini comparado
barplot(resultados$Gini, names.arg = resultados$Poblacion, 
        col = c("blue", "red", "green"), main = "Coeficiente de Gini")

# Gr?fico 3: Ratio P90/P10 comparado
barplot(resultados$Ratio_P90_P10, names.arg = resultados$Poblacion,
        col = c("blue", "red", "green"), main = "Ratio P90/P10")

# Gr?fico 4: ?ndice de Atkinson con diferentes ?psilons
atkinson_data <- as.matrix(resultados[, c("Atkinson_05", "Atkinson_10", "Atkinson_15")])
barplot(t(atkinson_data), beside = TRUE, 
        names.arg = resultados$Poblacion,
        col = c("lightblue", "blue", "darkblue"),
        main = "?ndice de Atkinson por ??",
        legend.text = c("??=0.5", "??=1.0", "??=1.5"))

# 1er escenario: Aumento poblacional en el vector base # Vector 1: Distribución base desigual + Aumento poblacional en el vector base

ingresos_base_cambio_1 <- c(10, 10, 15, 15, 20, 20, 25, 25, 30, 30, 35, 35, 40, 40, 60, 60, 100, 100, 200, 200)

2do escenario: Transferencia universal

Vector 1: Distribución base desigual + transferencia universal

ingresos_base_cambio_2 <- c(12, 17, 22, 27, 32, 37, 42, 62, 102, 202)

3er escenario: Transferencia de tipo Pigou Dalton, del más rico al más pobre

Vector 1: Distribución base desigual + transferencia de 5 pesos del más rico al más pobre

ingresos_base_cambio_3 <- c(15, 15, 20, 25, 30, 35, 40, 60, 100, 195)

4to escenario: Reordenar el vector

Vector 1: Distribución base desigual + aleatoriedad

ingresos_base_cambio_4 <- c(200, 25, 60, 10, 100, 35, 15, 40, 30, 20)

Resultados

calcular_todas_medidas <- function(ingresos, nombre) {
  data.frame(
    Poblacion = nombre,
    Gini = round(calcular_gini(ingresos), 4),
    SD_Log = round(calcular_sd_log(ingresos), 4),
    Ratio_P90_P10 = round(calcular_ratio_p90_p10(ingresos), 2),
    Theil = round(calcular_theil(ingresos), 4),
    Atkinson_05 = round(calcular_atkinson(ingresos, 0.5), 4),
    Atkinson_10 = round(calcular_atkinson(ingresos, 1.0), 4),
    Atkinson_15 = round(calcular_atkinson(ingresos, 1.5), 4),
    Media = round(mean(ingresos), 2),
    Mediana = round(median(ingresos), 2)
  )
}

Medias

resultados <- rbind(
  calcular_todas_medidas(ingresos_base, "Base (desigual)"),
  calcular_todas_medidas(ingresos_base_cambio_1, "Aumento pob"),
  calcular_todas_medidas(ingresos_base_cambio_2, "T universal"),
  calcular_todas_medidas(ingresos_base_cambio_3, "T Pigou-Dalton"),
  calcular_todas_medidas(ingresos_base_cambio_4, "Reordenar")
)

print y visualización

print("MEDIDAS DE DESIGUALDAD PARA LAS TRES POBLACIONES")

## [1] "MEDIDAS DE DESIGUALDAD PARA LAS TRES POBLACIONES"

print(resultados)

##         Poblacion   Gini SD_Log Ratio_P90_P10  Theil Atkinson_05 Atkinson_10
## 1 Base (desigual) 0.4776 0.8681          7.59 0.4014      0.1830      0.3249
## 2     Aumento pob 0.4776 0.8450          7.59 0.4014      0.1830      0.3249
## 3     T universal 0.4604 0.8245          6.79 0.3735      0.1698      0.3012
## 4  T Pigou-Dalton 0.4607 0.8103          7.30 0.3756      0.1698      0.2987
## 5       Reordenar 0.4776 0.8681          7.59 0.4014      0.1830      0.3249
##   Atkinson_15 Media Mediana
## 1      0.4279  53.5    32.5
## 2      0.4279  53.5    32.5
## 3      0.3971  55.5    34.5
## 4      0.3900  53.5    32.5
## 5      0.4279  53.5    32.5

paleta_azules <- c("#9ECAE1", "#4292C6", "#08519C")

# Gráfico 1: Comparación de distribuciones
plot(seq_along(ingresos_base), ingresos_base, type = "b", col = paleta_azules[3], lwd = 2, 
     ylim = c(0, max(ingresos_base_cambio_1)), 
     xlab = "Individuos (ordenados por ingreso)", ylab = "Ingreso",
     main = "Comparación de Distribuciones")
lines(seq_along(ingresos_base_cambio_1), ingresos_base_cambio_1, type = "b", col = paleta_azules[2], lwd = 2)
lines(seq_along(ingresos_base_cambio_2), ingresos_base_cambio_2, type = "b", col = paleta_azules[1], lwd = 2)
legend("topleft", legend = c("Base", "Aumento poblacional", "T Universal"), 
       col = c(paleta_azules[3], paleta_azules[2], paleta_azules[1]), lwd = 2, cex = 0.7)

# Gráfico 2: Coeficiente de Gini
barplot(resultados$Gini, names.arg = resultados$Poblacion, 
        col = paleta_azules, main = "Coeficiente de Gini",
        las = 2, cex.names = 0.7)

# Gráfico 3: Ratio P90/P10
barplot(resultados$Ratio_P90_P10, names.arg = resultados$Poblacion,
        col = paleta_azules, main = "Ratio P90/P10",
        las = 2, cex.names = 0.7)

# Gráfico 4: Índice de Atkinson por epsilon
atkinson_data <- as.matrix(resultados[, c("Atkinson_05", "Atkinson_10", "Atkinson_15")])
barplot(t(atkinson_data), beside = TRUE, 
        names.arg = resultados$Poblacion,
        col = paleta_azules,
        main = "Índice de Atkinson por ε",
        las = 2, cex.names = 0.7,
        legend.text = c("ε=0.5", "ε=1.0", "ε=1.5"))