#librerías
library(dplyr)
##
## 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)
#definiendo funciones para las medidas de desigualdad
# Coeficiente de Gini
calcular_gini <- function(ingresos) {
return(ineq::Gini(ingresos))
}
# Desviaci?n est?ndar de logaritmos (necesitamos manejar ceros)
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/P10
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 ?psilons
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 base/original
ingresos_base <- c(10, 15, 20, 25, 30, 35, 40, 60, 100, 200)
# 4 escenarios
# CAMBIO 1: Aumento de población (se duplica la población,
# sigue la misma distribución)
ingresos_poblacion <- c(ingresos_base, ingresos_base)
# CAMBIO 2: Ingresos aumentan en un 150%, todos ganan,
# su ingreso se multiplica por 2.5
ingresos_escalado <- ingresos_base * 2.5
# CAMBIO 3: Transferencia social universal
# (Se aplica un aumento de 15 puntos a los 5 ingresos más pequeños, sin quitarle a nadie)
ingresos_transferencia_social <- c(25, 30, 35, 40, 45, 35, 40, 60, 100, 200)
# CAMBIO 4: Transferencia progresiva (Principio de Pigou-Dalton)
# se transfieren 50 puntos del más rico, o sea de 200 a 150, al más pobre que pasa de 10 a 60.
ingresos_transferencia_progresiva <- c(60, 15, 20, 25, 30, 35, 40, 60, 100, 150)
# Función que calcula las 5 medidas de desigualdad del vector base de ingresos
calcular_todas_medidas <- function(ingresos, nombre) {
data.frame(
Escenario = 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)
)
}
resultados <- rbind(
calcular_todas_medidas(ingresos_base, "0. Base (desigual)"),
calcular_todas_medidas(ingresos_poblacion, "1. Aumento de población"),
calcular_todas_medidas(ingresos_escalado, "2. Escalamiento proporcional (x2.5)"),
calcular_todas_medidas(ingresos_transferencia_social, "3. Transferencia social universal"),
calcular_todas_medidas(ingresos_transferencia_progresiva, "4. Transferencia progresiva (Pigou-Dalton)")
)
print(resultados)
## Escenario Gini SD_Log Ratio_P90_P10 Theil
## 1 0. Base (desigual) 0.4776 0.8681 7.59 0.4014
## 2 1. Aumento de población 0.4776 0.8450 7.59 0.4014
## 3 2. Escalamiento proporcional (x2.5) 0.4776 0.8827 7.59 0.4014
## 4 3. Transferencia social universal 0.3639 0.6171 3.73 0.2557
## 5 4. Transferencia progresiva (Pigou-Dalton) 0.3822 0.7021 5.38 0.2418
## Atkinson_05 Atkinson_10 Atkinson_15 Media Mediana
## 1 0.1830 0.3249 0.4279 53.50 32.50
## 2 0.1830 0.3249 0.4279 53.50 32.50
## 3 0.1830 0.3249 0.4279 133.75 81.25
## 4 0.1131 0.1971 0.2574 61.00 40.00
## 5 0.1152 0.2153 0.2977 53.50 37.50
# Configurar panel de 2x2
par(mfrow = c(2, 2))
# Gráfico 1: Comparación de distribuciones (los 4 escenarios de 10 personas)
plot(1:10, ingresos_base, type = "b", col = "black", lwd = 2,
ylim = c(0, max(ingresos_escalado)),
xlab = "Individuos (ordenados por ingreso)", ylab = "Ingreso",
main = "Distribuciones (10 personas)", cex.main = 0.9)
lines(1:10, ingresos_escalado, type = "b", col = "blue", lwd = 2)
lines(1:10, ingresos_transferencia_social, type = "b", col = "darkgreen", lwd = 2)
lines(1:10, ingresos_transferencia_progresiva, type = "b", col = "red", lwd = 2)
legend("topleft", legend = c("Base", "Escalado x2.5", "Transf. social", "Transf. progresiva"),
col = c("black", "blue", "darkgreen", "red"), lwd = 2, cex = 0.6)
# Gráfico 2: Aumento de población (dedicado, porque tiene 20 personas)
plot(1:10, ingresos_base, type = "b", col = "black", lwd = 2,
ylim = c(0, max(ingresos_poblacion)),
xlab = "Individuos", ylab = "Ingreso",
main = "Base (10) vs Población (20)", cex.main = 0.9)
lines(1:20, ingresos_poblacion, type = "b", col = "purple", lwd = 2, pch = 1)
legend("topleft", legend = c("Base (10 personas)", "Población duplicada (20 personas)"),
col = c("black", "purple"), lwd = 2, cex = 0.6)
# Gráfico 3: Coeficiente de Gini comparado (los 5 escenarios)
barplot(resultados$Gini, names.arg = resultados$Escenario,
col = c("gray", "purple", "skyblue", "darkgreen", "tomato"),
main = "Coeficiente de Gini", las = 2, cex.names = 0.55, cex.main = 0.9)
# Gráfico 4: Ratio P90/P10 comparado (los 5 escenarios)
barplot(resultados$Ratio_P90_P10, names.arg = resultados$Escenario,
col = c("gray", "purple", "skyblue", "darkgreen", "tomato"),
main = "Ratio P90/P10", las = 2, cex.names = 0.55, cex.main = 0.9)
# Gráfico 5: Índice de Atkinson con diferentes epsilons (los 5 escenarios)
atkinson_data <- as.matrix(resultados[, c("Atkinson_05", "Atkinson_10", "Atkinson_15")])
barplot(t(atkinson_data), beside = TRUE,
names.arg = resultados$Escenario,
col = c("lightblue", "blue", "darkblue"),
main = "Índice de Atkinson por ε", cex.main = 0.9,
legend.text = c("ε=0.5", "ε=1.0", "ε=1.5"),
las = 2, cex.names = 0.5, args.legend = list(cex = 0.6))
