Trabajo final Grupo 12
#Presentado por Eberth Rojas (20181678), Fiorella Lazo (20183422), Jose Rios*(20181496)
###Presentacion Este trabajo intentará averiguar que factores influyen en los ingresos de los años de 1978 con respecto a los tratamientos realizados utilizando de base la data que Lalonde utilizo para su articulo respecto a la evaluacion de los programas de entrenamiento de evaluacion econometrica, realizada en 1986.
library(rio)
LL <- import("https://raw.github.com/arturomaldonado/Estadistica_1.0/main/LL.csv")#Introduccion a las variables Las variables presentes en la data tratan de la evaluacion econometrica de los programas de entrenamiento escrito por Lalonde en 1986. La data contiene las variables treated, que señala si se ha dado tratamiento(1) o ha sido controlado (0); age es la edad del individuo; educ es el numero de años de educacion;black es un indicador binario si el individuo es afroamericano o no; hispan, de igual manera, indica si el individuo es hispano o no; married es un indicador que permite saber si el individuo se encuentra casado; y nodeegree es un indicador que define si el individuono tiene diploma de egresado de escuela secundaria. Todas estas variables binarias resultan en 1 cuando cumplen el criterio, en su defecto es un 0. Las 3 demas variables, re74,re75,re78, mide el ingreso del individuo en los años 1974,1975 y 1978 respectivamente. u74 y u75
Variables= c("treated", "age", "education", "black", "married", "nodegree", "re74", "re75", "re78", "hispanic", "u74", "u75")
Explicación= c("variable dummy si el participante recibió el tratamiento (1) o no (0)", "edad", "años de educación", "variable dummy si el participante es Afroamericano", "variable dummy si el participante es casado", "variable dummy de no tener estudios secundarios completos", "ingresos reales en 1974", "ingresos reales en 1975", "ingresos reales en 1978", "variable dummy si el participantes es hispano", "variable dummy si era desempleado en 1974", "variable dummy si era desempleado en 1975")
Metadata= data.frame(Variables, Explicación)
Metadata## Variables
## 1 treated
## 2 age
## 3 education
## 4 black
## 5 married
## 6 nodegree
## 7 re74
## 8 re75
## 9 re78
## 10 hispanic
## 11 u74
## 12 u75
## Explicación
## 1 variable dummy si el participante recibió el tratamiento (1) o no (0)
## 2 edad
## 3 años de educación
## 4 variable dummy si el participante es Afroamericano
## 5 variable dummy si el participante es casado
## 6 variable dummy de no tener estudios secundarios completos
## 7 ingresos reales en 1974
## 8 ingresos reales en 1975
## 9 ingresos reales en 1978
## 10 variable dummy si el participantes es hispano
## 11 variable dummy si era desempleado en 1974
## 12 variable dummy si era desempleado en 1975#Eliminando la colummna married que no será necesaria:
LL$married= NULL#PREPARACIÓN DE CLUSTERS:
Se separará los clusters con respecto a las variables de cuánto perciben de ingresos en 1974 y en 1975, para esto solo se usará a los que no están desempleados, ya que no queremos que afecten los que no tenÃan sueldo en alguno de esos años.
Usamos la estrategia aglomerativa divisiva (diana): Ver anexo 1
Creando una base de datos con solo los sueldos en el 74 y 75:
data2= subset(LL, u74== 0)
data3= subset(data2, u75==0)
LL3= subset(data3[,c("re74", "re75")])Distancia:
library(factoextra)## Warning: package 'factoextra' was built under R version 4.1.2## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.1.2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(cluster)
distancia= daisy(LL3, metric = "gower")Clusters:
set.seed(123)
res.diana= hcut(distancia, k= 3, hc_func='diana')
LL3$diana= res.diana$cluster Explorando los resultados:
library(plyr)## Warning: package 'plyr' was built under R version 4.1.2aggregate(cbind(re74, re75)~ diana, data= LL3, mean)## diana re74 re75
## 1 1 4892.725 4010.458
## 2 2 35058.818 33252.695
## 3 3 21819.648 16991.694Recodificando:
LL3$diana= dplyr::recode(LL3$diana, `1` = 1, `2`=3,`3`=2)
aggregate(cbind(re74, re75)~ diana, data= LL3, mean)## diana re74 re75
## 1 1 4892.725 4010.458
## 2 2 21819.648 16991.694
## 3 3 35058.818 33252.695VISUALIZANDO:
fviz_dend(res.diana, cex = 0.7, horiz = T)## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
Una vez realizado el analisis con clusters, se continua con el proceso de analisis factorial exploratorio, para comprobar si el concepto del racismo se encuentra latente en la data recogida, por lo que se usara la data del ingreso de 1974,1975 y 1978 junto con las etnias hispanas, afrodescendientes y años de educacion
dontselect=c("treated","age","married","nodegree","u74","u75")
select=setdiff(names(LL),dontselect)
DLL=LL[,select]library(polycor)## Warning: package 'polycor' was built under R version 4.1.2corMatrix=polycor::hetcor(DLL)$correlationsSe grafica bloques de correlaciones
library(ggcorrplot)## Warning: package 'ggcorrplot' was built under R version 4.1.2ggcorrplot(corMatrix)
### el grafico muestra una ausencia de correlacion directa o inversamente fuerte, por lo que no es posible encontrar alguna variable latente relacionada con el racismo.
##REGRESIÓN:
hipotesis= formula(re78~ treated)
regresion1= lm(hipotesis, data= LL)
summary(regresion1)##
## Call:
## lm(formula = hipotesis, data = LL)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5976 -5090 -1519 3361 54332
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5090.0 302.8 16.811 <2e-16 ***
## treated 886.3 472.1 1.877 0.0609 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6242 on 720 degrees of freedom
## Multiple R-squared: 0.004872, Adjusted R-squared: 0.003489
## F-statistic: 3.525 on 1 and 720 DF, p-value: 0.06086hipotesis2= formula(re78~ treated+ black+ hispanic)
regresion2= lm(hipotesis2, data= LL)
summary(regresion2)##
## Call:
## lm(formula = hipotesis2, data = LL)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7556 -4771 -1580 3220 54659
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6677.2 783.7 8.520 <2e-16 ***
## treated 878.6 470.5 1.868 0.0622 .
## black -1906.6 797.2 -2.392 0.0170 *
## hispanic -548.0 1038.4 -0.528 0.5979
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6216 on 718 degrees of freedom
## Multiple R-squared: 0.01595, Adjusted R-squared: 0.01184
## F-statistic: 3.88 on 3 and 718 DF, p-value: 0.009081hipotesis3= formula(re78 ~ treated+age+ education+ nodegree)
regresion3= lm(hipotesis3, data= LL)
summary(regresion3)##
## Call:
## lm(formula = hipotesis3, data = LL)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6959 -4898 -1339 3388 54387
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3778.15 2520.07 1.499 0.1343
## treated 791.63 473.70 1.671 0.0951 .
## age 16.31 35.38 0.461 0.6450
## education 149.88 179.30 0.836 0.4035
## nodegree -753.95 744.78 -1.012 0.3117
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6232 on 717 degrees of freedom
## Multiple R-squared: 0.01218, Adjusted R-squared: 0.006666
## F-statistic: 2.21 on 4 and 717 DF, p-value: 0.06638Conclusiones
En este trabajo se plantearon las siguientes hipotesis: 1.Si el tratamiento afecto al ingreso obtenido en 1978
2.Si es que los rasgos etnicos tenian un efecto en el sueldo de 1978
3.Si la edad y la educacion afectan a los ingresos de 1978
Los siguientes resultados del trabajo mostraron que la primera hipotesis se cumple, ya que se muestra una significancia entre el tratamiento realizado y el ingreso obtenido, que por cada tratamiento hay una varianza de 5090 dolares aproximadamente, por lo esta hipotesis es aceptada. Respecto a la segunda hipotesis se muestra lo contrario, es decir, que no hay presencia de cambios cuando muestras una diferencia etnica, excepto cuando es afrodescendiente, aqui si se muestra una diferencia en el ingreso de 1978, con una diferencia de hasta 878 dolares, esta hipotesis se encuentra tambien se ve aceptada. Con respecto a la tercera hipotesis. se pudo comprobar que no hay una diferencia en ninguna variable que pueda confirmar la tercera hipotesis, ninguna tiene significancia, por lo que es descartada-
#####ANEXO 1:
Viendo de dónde a dónde van las variables:
summary(LL3$re74)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 188.4 1647.5 4111.9 6642.9 9142.7 39570.7summary(LL3$re75)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 74.34 1536.86 3213.22 5431.78 7503.35 37431.66Las variables tienen rangos similares por lo que no necesita reescalarse.
Ver cuántos clusters son necesarios:
library(cluster)
set.seed(123)
distancia= daisy(LL3, metric = "gower")#Para la estrategia de partición con PAM:
library(factoextra)
fviz_nbclust(LL3, pam,diss=distancia,method = "gap_stat",k.max = 10,verbose = F)
Estrategia jerarquica con agnes:
set.seed(123)
fviz_nbclust(LL3, hcut, diss = distancia, method = "gap_stat",k.max = 10,verbose = F,hc_func = "agnes")
Estrategia jerarquica con diana:
fviz_nbclust(LL3, hcut, diss = distancia, method = "gap_stat",k.max = 10,verbose = F,hc_func = "diana")
Usaremos 3 clusters por la estregia de partición, por el hecho de que por los otros dos casos nos recomiendan solo hacer un cluster.
#POR PARTICIÓN:
set.seed(123)
SUGERIDOS= 3
res.pam= pam(distancia, k= SUGERIDOS, cluster.only = F)
LL3$pam= res.pam$cluster#POR AGNES:
res.agnes= hcut(distancia, k = SUGERIDOS,hc_func='agnes')
LL3$agnes= res.agnes$clusterPOR DIANA:
res.diana= hcut(distancia, k = SUGERIDOS,hc_func='diana')
LL3$diana= res.diana$clusterEvaluemos el resultado usando el coeficiente de silueta :
.Un caso se ha clusterizado bien si tiene valor positivo
.Un caso es dificilmente clusterizable si es muy cercano a cero
.Un caso está mal clusterizado si es negativo.
Viendo qué estrategia usar:
#POR PAM:
fviz_silhouette(res.pam)## cluster size ave.sil.width
## 1 1 136 0.43
## 2 2 36 0.54
## 3 3 214 0.73
#POR AGNES:
fviz_silhouette(res.agnes)## cluster size ave.sil.width
## 1 1 154 0.34
## 2 2 36 0.55
## 3 3 196 0.76
#POR DIANA:
fviz_silhouette(res.diana)## cluster size ave.sil.width
## 1 1 350 0.83
## 2 2 5 0.82
## 3 3 31 0.68