NOMBRE: Yovanis Rafael Pineda Osorio
MATERIA: Análisis Cuantitativo I
AVANCE 01 PRUEBA 01 | 18 Oct 2024library(tidyverse)
library(haven)
library(wINEQ)
library(Hmisc)
library(DescTools)
library(summarytools)
data01 <- read_dta("Casen 2015.dta")Ejercicio 1
A). Elabore una tabla de frecuencia de las personas por región, considerando todos los individuos de la base. Indique las 3 regiones que tienen los mayores porcentajes de población, y aquellas 3 que tienen los menores porcentajes de población.
data_regions <- attributes(data01$region)$labels
data01$region <- factor(data01$region, levels = data_regions, labels = names(data_regions))
df_freq <- freq(
data01$region,
report.nas = FALSE,
weights = data01$expr
)
df_freq## Weighted Frequencies
## data01$region
## Type: Factor
## Weights: expr
##
## Freq % % Cum.
## ------------------------------------------------------- ------------- -------- --------
## región de tarapacá 326966.00 1.86 1.86
## región de antofagasta 574413.00 3.27 5.14
## región de atacama 281153.00 1.60 6.74
## región de coquimbo 758108.00 4.32 11.06
## región de valparaÃso 1824098.00 10.39 21.45
## región del libertador gral. bernardo o higgins 914682.00 5.21 26.66
## región del maule 1032683.00 5.88 32.54
## región del biobÃo 2067335.00 11.78 44.32
## región de la araucanÃa 983653.00 5.60 49.93
## región de los lagos 863439.00 4.92 54.84
## región de aysén del gral. carlos ibáñez del campo 103207.00 0.59 55.43
## región de magallanes y de la antártica chilena 150675.00 0.86 56.29
## región metropolitana de santiago 7134812.00 40.65 96.94
## región de los rÃos 369488.00 2.11 99.04
## región de arica y parinacota 167793.00 0.96 100.00
## Total 17552505.00 100.00 100.00A partir de los datos obtenidos se puede apreciar que las tres regiones con más poblacÃon son la región Metropolitana, Biobió y Calparaiso, mientras que las tres regiones con menos población serÃa Arica y Parinacota, Magallanes y Aysén.
B). Observar la población de cada región por tipo de zona, ¿cuáles son los porcentajes de población urbana y rural para las regiones Metropolitana, del BiobÃo y ValparaÃso?
data_zonas <- attributes(data01$zona)$labels
data01$zona <- factor(data01$zona, levels = data_zonas, labels = names(data_zonas))
df_zona <- ctable(data01$region, data01$zona,
prop = "r",
plain.ascii = FALSE,
style = "rmarkdown",
weights = data01$expr
)
df_zona## ### Cross-Tabulation, Row Proportions
## #### region * zona
## **Data Frame:** data01
##
## | | | | | |
## |--------------------------------------------------:|-----:|-------------------:|------------------:|--------------------:|
## | | zona | urbano | rural | Total |
## | region | | | | |
## | región de tarapacá | | 311228.0 (95.2%) | 15738.0 ( 4.8%) | 326966.0 (100.0%) |
## | región de antofagasta | | 565127.0 (98.4%) | 9286.0 ( 1.6%) | 574413.0 (100.0%) |
## | región de atacama | | 258371.0 (91.9%) | 22782.0 ( 8.1%) | 281153.0 (100.0%) |
## | región de coquimbo | | 618724.0 (81.6%) | 139384.0 (18.4%) | 758108.0 (100.0%) |
## | región de valparaÃso | | 1670223.0 (91.6%) | 153875.0 ( 8.4%) | 1824098.0 (100.0%) |
## | región del libertador gral. bernardo o higgins | | 650711.0 (71.1%) | 263971.0 (28.9%) | 914682.0 (100.0%) |
## | región del maule | | 696307.0 (67.4%) | 336376.0 (32.6%) | 1032683.0 (100.0%) |
## | región del biobÃo | | 1740314.0 (84.2%) | 327021.0 (15.8%) | 2067335.0 (100.0%) |
## | región de la araucanÃa | | 666079.0 (67.7%) | 317574.0 (32.3%) | 983653.0 (100.0%) |
## | región de los lagos | | 612982.0 (71.0%) | 250457.0 (29.0%) | 863439.0 (100.0%) |
## | región de aysén del gral. carlos ibáñez del campo | | 90032.0 (87.2%) | 13175.0 (12.8%) | 103207.0 (100.0%) |
## | región de magallanes y de la antártica chilena | | 144431.0 (95.9%) | 6244.0 ( 4.1%) | 150675.0 (100.0%) |
## | región metropolitana de santiago | | 6891779.0 (96.6%) | 243033.0 ( 3.4%) | 7134812.0 (100.0%) |
## | región de los rÃos | | 253194.0 (68.5%) | 116294.0 (31.5%) | 369488.0 (100.0%) |
## | región de arica y parinacota | | 151806.0 (90.5%) | 15987.0 ( 9.5%) | 167793.0 (100.0%) |
## | Total | | 15321308.0 (87.3%) | 2231197.0 (12.7%) | 17552505.0 (100.0%) |A partir de los datos obtenidos se puede inferir que la población de la region Metropolitana está distribuida en un 96.6% en zona urbana y 3.4% en zona rural. Esto lo posiciona como la región con menor población rural en términos porcentuales, en contrate con la región de BiobÃo y ValparaÃso, los cuales poseen un resultado más cercano a las de otras regionales con un 84.2% y 91.6% en zona urbana, y un 15.8% y 8.4% en zona rural respectivamente. Finalmente, la región con mayor población rural es la región de los RÃos que comprende el 31.5% del total de habitante de la región.
C). Elabor un diagrama de torta respecto del parentesco con el jefe de hogar. . ¿Cuáles son las 3 categorÃas con mayor porcentaje en dicha variable? . ¿Si suma el resto de categorÃas cuanto porcentaje obtiene?
data_pco1 <- attributes(data01$pco1)$labels
data01$pco1 <- factor(data01$pco1, levels = data_pco1, labels = names(data_pco1))
df_pco1 <- freq(data01$pco1,
report.nas = FALSE,
weights = data01$expr
)
df_pco1## Weighted Frequencies
## data01$pco1
## Type: Factor
## Weights: expr
##
## Freq % % Cum.
## ----------------------------------------- -------------- --------- ---------
## jefe(a) de hogar 5454914.000 31.078 31.078
## esposo(a) o pareja de distinto sexo 3177225.000 18.101 49.179
## esposo(a) o pareja de igual sexo 12905.000 0.074 49.252
## hijo(a) de ambos 3866800.000 22.030 71.282
## hijo(a) sólo de jefe(a) 2231440.000 12.713 83.995
## hijo(a) sólo del esposo(a) o pareja 251633.000 1.434 85.429
## padre o madre 198484.000 1.131 86.560
## suegro(a) 85187.000 0.485 87.045
## yerno o nuera 246889.000 1.407 88.452
## nieto(a) 1237371.000 7.050 95.501
## hermano(a) 227789.000 1.298 96.799
## cuñado(a) 63810.000 0.364 97.162
## otro familiar 338962.000 1.931 99.094
## no familiar 136151.000 0.776 99.869
## servicio doméstico puertas adentro 22945.000 0.131 100.000
## sin dato 0.000 0.000 100.000
## Total 17552505.000 100.000 100.000df_pco1_ <- as_tibble(df_pco1)
colnames(df_pco1_) <- c("Freq.", "Percent", "Cum.", "% Total", "% Total Cum.")
df_pco1_ <- df_pco1_ %>%
rownames_to_column(var = "pco1")
df_pco1_$pco1 <- rownames(x = df_pco1)
df_pco1_pie <- df_pco1_[-nrow(df_pco1_), ]
ggplot(df_pco1_pie, aes(x = "", y = Percent, fill = pco1)) +
geom_bar(stat = "identity", color = "white") +
coord_polar(theta = "y")## Don't know how to automatically pick scale for object of type
## <summarytools/matrix/array>. Defaulting to continuous.## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_bar()`).
Las tres categorÃas que se manifiestas con mayor población, según el
parentesco con el jefe de hogar, son: 1) Jefe(a) de hogar, con 31.078%;
2) Hijo(a) de ambos, con 22.03%; y Esposo(a) o pareja de distinto sexo,
con 18.10%. La sumatoria de estas tres categorÃas representarÃa el
71.208% (12498939) de toda la población nacional, lo que dejarÃa al
resto de categorÃas con solamente el 28.79% (5053566).
D). Estime los promedios del ingreso del trabajo, ingreso autónomo, subsidios monetarios e ingreso monetario, por hogar, para el año 2015. Compruebe sus resultados en Evolución y Distribución de Ingresos del Ministerio de Desarrollo Social, página 14.
df_income <- data01 %>% filter(pco1 == "jefe(a) de hogar")
df_income_1 <- df_income %>%
summarise(
Variable = "ytrabajocorh",
Obs = n(),
Weights = sum(expr),
Mean = Mean(ytrabajocorh, expr),
Desv.Std = SD(ytrabajocorh, expr),
Min = min(ytrabajocorh),
Max = max(ytrabajocorh)
)
df_income_1## # A tibble: 1 × 7
## Variable Obs Weights Mean Desv.Std Min Max
## <chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ytrabajocorh 83887 5454914 704588. 1016843. 0 46208335df_income_2 <- df_income %>%
summarise(
Variable = "yautcorh",
Obs = n(),
Weights = sum(expr),
Mean = Mean(yautcorh, expr),
Desv.Std = SD(yautcorh, expr),
Min = min(yautcorh),
Max = max(yautcorh)
)
df_income_2## # A tibble: 1 × 7
## Variable Obs Weights Mean Desv.Std Min Max
## <chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 yautcorh 83887 5454914 832072. 1135165. 0 109935836df_income_3 <- df_income %>%
summarise(
Variable = "ysubh",
Obs = n(),
Weights = sum(expr),
Mean = Mean(ysubh, expr),
Desv.Std = SD(ysubh, expr),
Min = min(ysubh),
Max = max(ysubh)
)
df_income_3## # A tibble: 1 × 7
## Variable Obs Weights Mean Desv.Std Min Max
## <chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ysubh 83887 5454914 26915. 49416. 0 2294355df_income_4 <- df_income %>%
summarise(
Variable = "ymonecorh",
Obs = n(),
Weights = sum(expr),
Mean = Mean(ymonecorh, expr),
Desv.Std = SD(ymonecorh, expr),
Min = min(ymonecorh),
Max = max(ymonecorh)
)
df_income_4## # A tibble: 1 × 7
## Variable Obs Weights Mean Desv.Std Min Max
## <chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ymonecorh 83887 5454914 858987. 1127797. 0 110025600E). ¿Qué valores acumulan a lo más el 10% de los datos en los ingresos anteriores? . ¿Cuáles acumulan el 90% de los datos? Calcule la razón entre los últimos respecto de los primeros. . ¿Por qué las razones calculadas tienen estos valores?
wtd.quantile(df_income$ytrabajocorh, df_income$expr, probs = seq(0, 1, 0.1))## 0% 10% 20% 30% 40% 50% 60% 70%
## 0 0 110000 250000 335000 450000 574167 743334
## 80% 90% 100%
## 1000000 1514795 46208335wtd.quantile(df_income$yautcorh, df_income$expr, probs = seq(0, 1, 0.1))## 0% 10% 20% 30% 40% 50% 60% 70%
## 0 150000 250000 331430 430000 540000 669667 841651
## 80% 90% 100%
## 1116667 1704167 109935836wtd.quantile(df_income$ysubh, df_income$expr, probs = seq(0, 1, 0.1))## 0% 10% 20% 30% 40% 50% 60% 70% 80% 90%
## 0 0 0 0 0 1920 8700 20000 45394 94355
## 100%
## 2294355wtd.quantile(df_income$ymonecorh, df_income$expr, probs = seq(0, 1, 0.1))## 0% 10% 20% 30% 40% 50% 60% 70%
## 0 189912 280309 365002 460000 566000 695659 862075
## 80% 90% 100%
## 1136667 1715000 110025600# ---
df_income_6 <- tibble(
Variables = c("ytrabajocorh", "yautcorh", "ysubh", "ymonecorh"),
P10 = c(
wtd.quantile(df_income$ytrabajocorh, df_income$expr, 0.1),
wtd.quantile(df_income$yautcorh, df_income$expr, 0.1),
wtd.quantile(df_income$ysubh, df_income$expr, 0.1),
wtd.quantile(df_income$ymonecorh, df_income$expr, 0.1)
),
P90 = c(
wtd.quantile(df_income$ytrabajocorh, df_income$expr, 0.9),
wtd.quantile(df_income$yautcorh, df_income$expr, 0.9),
wtd.quantile(df_income$ysubh, df_income$expr, 0.9),
wtd.quantile(df_income$ymonecorh, df_income$expr, 0.9)
)
)
df_income_6 %>%
mutate(Rz = P90 / P10)## # A tibble: 4 × 4
## Variables P10 P90 Rz
## <chr> <dbl> <dbl> <dbl>
## 1 ytrabajocorh 0 1514795 Inf
## 2 yautcorh 150000 1704167 11.4
## 3 ysubh 0 94355 Inf
## 4 ymonecorh 189912 1715000 9.03A partir del análisis realizado, se puede observar que los ingresos del 10% y 40% de las variables ytrabajocorh e ysubh son igual a 0, lo que indica que hay un porcentaje de personas (al menos el 10%) que no tienen ingresos de trabajo y subsidios monetarios (al menos el 40%). Por otro lado, para yautcorh e ymonecorh, las razones son 11.4 y 9.03, lo que refleja que los ingresos de quienes esán por encima del 90% de la población son considerablemente más altos (11 y 9 veces más alto respectivamente) en comparación con quienes estén por debajo del 10%, lo cual manifiesta una alta concentración de ingresos.
Por consiguiente, las razones calculadas, finitas e infinitas, plantean una gran desigualdad en la distribución de ingresos, además de que existe un número significativo de individuos que no reciben ingresos de trabajo o subsidios, lo que puede contribuir a la reducción de oportunidades y el mantenimiento de una distribución desigual en el contexto socioeconómico analizado.
F). Presente una tabla con todas las medidas de dispersión o variabilidad que conoce respecto de los ingresos anteriores, e interprételas. ¿Qué variable presenta una mayor dispersión de acuerdo a la desviación estándar y de acuerdo al coeficiente de variación? Por qué se obtiene esta diferencia?
df_income_5 <- df_income %>%
select(ytrabajocorh, yautcorh, ysubh, ymonecorh) %>%
summarise(across(everything(), list(
Range = ~ diff(range(., df_income$expr)),
Desv.Std = ~ SD(., df_income$expr),
Varianza = ~ wtd.var(., df_income$expr),
CV = ~ CoefVar(., df_income$expr),
IQR = ~ IQRw(., df_income$expr)
),
.names = "{.col}_{fn}"
)) %>%
pivot_longer(everything(),
names_to = c("Variables", "Estadisticos"),
names_sep = "_",
) %>%
pivot_wider(
names_from = Estadisticos,
values_from = value
)
df_income_5## # A tibble: 4 × 6
## Variables Range Desv.Std Varianza CV IQR
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ytrabajocorh 46208335 1016843. 1.03e12 1.44 648477
## 2 yautcorh 109935836 1135165. 1.29e12 1.36 679000
## 3 ysubh 2294355 49416. 2.44e 9 1.84 29734
## 4 ymonecorh 110025600 1127797. 1.27e12 1.31 673333Los resultados muestran que los ingresos autónomos (yautcorh) y los ingresos monetarios por hogar (ymonecorh) son las variables con mayor rango, desviación estándar, varianza y IQR. En donde los ingresos autónomos presentan la mayor desviación estandar y varianza (sd = 1,135,165 / var = 1.29e12), seguido de los ingresos monetarios (sd = 1,127,797 / var = 1.27e12), los ingresos por trabajo (sd = 1,016,843 / var = 1.03e12) y los subsidios (sd = 49,416 / var = 2.44e9).
Sin embargo, el coeficiente de variación (CV), que mide la dispersión relativa respecto a la media, es más alto para los subsidios (ysubh) con un resultado de 1.84. Lo que sugiere que, en términos relativos, la variabilidad o dispersión de los subsidios es mayor en comparación con que los ingresos de trabajo, los ingresos autónomos y los ingresos monetarios totales, los cuales tienen coeficientes de variación de 1.44, 1.36 y 1.31, respectivamente.
Ejercicio 3
A). Reproduzcir el Coeficiente de Gini de Chile para el ingreso autónomo por hogar.
Gini(df_income$yautcorh, df_income$expr)## [1] 0.5075962Atkinson(df_income$yautcorh, df_income$expr)## [1] 0.2237409Entropy(df_income$yautcorh, df_income$expr)## [1] 15.59507El coeficiente de Gini es de 0.5076, lo que sugiere una desigualdad moderadamente alta. Esto significa que hay una diferencia significativa en los ingresos autónomos entre los diferentes sectores de la población.
B). No contento con la situación de desigualdad de Chile, un investigador ha estimado un nuevo subsidio, definido por la siguiente fórmula: . subsidio=387.092,7-0,1131087yautcorh+1.125,575*edad
df_income$subsidio <- 387092.7 - 0.1131087 * df_income$yautcorh + 1125.575 * df_income$edad
df_income$ingreso2 <- df_income$yautcorh + df_income$subsidioEstime el subsidio y analice que ocurre con los estadÃsticos de tendencia central . y dispersión entre el ingreso autónomo del hogar y el ingreso autónomo del hogar . *más el nuevo subsidio. Denomine a esta última variable ingreso2.
wtd.quantile(df_income$yautcorh, df_income$expr, probs = seq(0, 1, 0.1))## 0% 10% 20% 30% 40% 50% 60% 70%
## 0 150000 250000 331430 430000 540000 669667 841651
## 80% 90% 100%
## 1116667 1704167 109935836wtd.quantile(df_income$ingreso2, df_income$expr, probs = seq(0, 1, 0.1))## 0% 10% 20% 30% 40% 50% 60%
## 407353.0 588012.9 664787.7 740536.7 828450.7 921635.5 1038409.7
## 70% 80% 90% 100%
## 1192042.2 1436961.1 1956714.5 97973772.9df_income %>%
select(yautcorh, ingreso2) %>%
summarise(across(everything(), list(
Range = ~ diff(range(.)),
Desv.Std = ~ SD(., df_income$expr),
Varianza = ~ Var(., df_income$expr),
CV = ~ CoefVar(., df_income$expr),
IQR = ~ IQRw(., df_income$expr)
),
.names = "{.col}_{fn}"
)) %>%
pivot_longer(everything(),
names_to = c("Variables", "Estadisticos"),
names_sep = "_",
) %>%
pivot_wider(
names_from = Estadisticos,
values_from = value
)## # A tibble: 2 × 6
## Variables Range Desv.Std Varianza CV IQR
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 yautcorh 109935836 1135165. 1.29e12 1.36 679000
## 2 ingreso2 97566420. 1005261. 1.01e12 0.849 604096.Los estadisticos de ingreso2 presentan valores menores de variabilidad y dispersión en comparación con los ingresos autónomos. Esto se puede fundamentar en el coeficiente de variación (CV), el cual permite comparar la dispersión de ambas variables, la cual es menor en ingreso2 (diff = 0.511).
B). Estimar el nuevo Coeficiente de Gini y compárelo con el anterior.
Gini(df_income$ingreso2, df_income$expr)## [1] 0.3148631Atkinson(df_income$ingreso2, df_income$expr)## [1] 0.08602293Entropy(df_income$ingreso2, df_income$expr)## [1] 16.31877Se puede evidenciar una reducción del coeficiente de Gigi, lo cual se justifica al presentarse una nueva ingreso (ingreso2) que presenta los datos más concentrados y mejor distribuidos entre los deciles.
C). Grafique la distribución de igualdad total y la curva de Lorenz para los dos casos anteriores.
par(mfrow = c(1, 2))
plot(Lc(df_income$yautcorh, df_income$expr))
plot(Lc(df_income$ingreso2, df_income$expr))
par(nfrow = c(1, 1))## Warning in par(nfrow = c(1, 1)): "nfrow" is not a graphical parameter