Análisis de conglomerados

9/11/2020

Cargar data

load("mundo98.rda")

Adecuación de data

names(mundo98)

##  [1] "region"                 "tfr"                    "contraception"         
##  [4] "educationMale"          "educationFemale"        "lifeMale"              
##  [7] "lifeFemale"             "infantMortality"        "GDPperCapita"          
## [10] "economicActivityMale"   "economicActivityFemale" "illiteracyMale"        
## [13] "illiteracyFemale"

Adecuación y tipificación de datos

datos <- na.omit(mundo98[,c(10,11)])
datos.tip <- scale(datos )

head(datos.tip)

##                economicActivityMale economicActivityFemale
## Afghanistan              1.43610331             -2.3553500
## Algeria                 -0.00788418             -2.3196579
## American.Samoa          -2.29744993             -0.2614171
## Antigua                 -0.26806211              0.5594997
## Argentina               -0.03390197             -0.3268525
## Armenia                 -1.49089836              0.3096555

Calculo de la matriz inicial de distancias

d <- dist(datos.tip)

Geración de conglomerados con la función “hclust”

fit <- hclust(d)
plot(fit)

Distancias de fusión

fit$height

##   [1] 0.00000000 0.00000000 0.02208420 0.02379469 0.02379469 0.02860896
##   [7] 0.03246381 0.03798885 0.03947745 0.03947745 0.04079987 0.04079987
##  [13] 0.04362545 0.04910065 0.05288671 0.05423721 0.05509587 0.05721791
##  [19] 0.06089255 0.06089255 0.06154536 0.06625259 0.06625259 0.07723169
##  [25] 0.07895490 0.08059488 0.08159215 0.08424433 0.08846626 0.09226362
##  [31] 0.09813766 0.10675671 0.10675671 0.10877044 0.11396656 0.11768300
##  [37] 0.11897346 0.11897346 0.11946837 0.12023952 0.12023952 0.12178509
##  [43] 0.12239961 0.13172447 0.13412507 0.13532642 0.14720649 0.14748193
##  [49] 0.14931879 0.15080367 0.15195541 0.15521162 0.16778617 0.16858263
##  [55] 0.17078141 0.17107385 0.17165374 0.17190223 0.17190223 0.17421157
##  [61] 0.17980914 0.18133366 0.18299681 0.18367237 0.18394431 0.18440886
##  [67] 0.18486714 0.19272758 0.19594780 0.19657886 0.19786284 0.20757863
##  [73] 0.21456717 0.21491756 0.22084197 0.22401293 0.22567624 0.22604957
##  [79] 0.23062884 0.23369805 0.23684982 0.24178463 0.24275249 0.24527940
##  [85] 0.24724060 0.25042177 0.26443354 0.26486133 0.26777878 0.26825013
##  [91] 0.28929230 0.29601234 0.31886991 0.32816703 0.33366154 0.33591084
##  [97] 0.33870178 0.34838937 0.35334715 0.35477557 0.35683781 0.35692037
## [103] 0.36272100 0.36907462 0.37084277 0.37445179 0.38378522 0.39189561
## [109] 0.39618472 0.40482006 0.40651528 0.44923118 0.45960528 0.46465054
## [115] 0.46835805 0.48319619 0.48813488 0.52307177 0.52505182 0.53617219
## [121] 0.53639429 0.54022754 0.57390409 0.59727517 0.59941076 0.61676302
## [127] 0.62833395 0.63354210 0.63920990 0.64938840 0.65476852 0.69601002
## [133] 0.72585467 0.74980244 0.76207589 0.79363186 0.80294828 0.80696921
## [139] 0.84291985 0.85603092 0.89911613 0.95714132 0.96504166 0.96669532
## [145] 1.00772933 1.01730623 1.13800052 1.16720808 1.26887388 1.30481439
## [151] 1.39190187 1.62169720 1.62749737 1.64803399 1.70172504 1.85703921
## [157] 2.11722412 2.13573202 2.77533467 2.80839088 2.93471788 4.01890489
## [163] 5.41926916 6.08150471

Regla de Mojena

mean(fit$height) +  3*sd(fit$height) < fit$height

##   [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [13] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [49] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [61] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [73] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [85] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [97] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [109] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [121] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [133] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [145] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [157] FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE

Método gráfico

plot(fit$height, col = "blue", pch=19 )

plot(fit)

rect.hclust(fit, k=4, border="red")

Agregando la membresía de clústers

grupo <- cutree(fit, k=4) ### Generamos una variable con los grupos

grupo <- factor(grupo) ### convertimos a factor para que represente mejor una variable nominal

data.grupos <- cbind(datos, grupo) ### Juntamos la variable de agrupación con el resto de la data

Exploración de data

head(data.grupos)

##                economicActivityMale economicActivityFemale grupo
## Afghanistan                    87.5                    7.2     1
## Algeria                        76.4                    7.8     1
## American.Samoa                 58.8                   42.4     2
## Antigua                        74.4                   56.2     3
## Argentina                      76.2                   41.3     3
## Armenia                        65.0                   52.0     2

Caracterización de conglomerados con descriptivos y gráficos

library(ggplot2)

grafico <- ggplot(data.grupos, aes(economicActivityMale, economicActivityFemale)) + geom_point(aes(color = grupo))

grafico

library(Rmisc)

summary(data.grupos$economicActivityMale)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   51.20   72.30   76.80   76.46   81.20   93.00

summary(data.grupos$economicActivityFemale)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.90   37.00   48.40   46.79   56.40   90.60

est.des2 <- summarySE(data.grupos, measurevar="economicActivityMale", groupvars=c("grupo" ), na.rm=T)
est.des2

##   grupo  N economicActivityMale       sd        se        ci
## 1     1 29             82.29310 6.155771 1.1430981 2.3415302
## 2     2 41             66.10732 4.127008 0.6445304 1.3026445
## 3     3 83             78.34458 3.886005 0.4265445 0.8485329
## 4     4 12             84.70833 4.452264 1.2852578 2.8288334

est.des3 <- summarySE(data.grupos, measurevar="economicActivityFemale", groupvars=c("grupo" ), na.rm=T)
est.des3

##   grupo  N economicActivityFemale        sd       se       ci
## 1     1 29               22.58621 11.086792 2.058765 4.217190
## 2     2 41               46.05122  7.645656 1.194051 2.413267
## 3     3 83               50.82771 10.295243 1.130050 2.248029
## 4     4 12               79.94167  5.402097 1.559451 3.432329

El gráfico de dispersión y los estadísticos descriptivos muestran algunos datos interesentes:

En general, para todos los grupos se observa que existe una brecha de participación en el ámbito laboral entre hombres (77%) y mujeres(48%)

De manera más específica:

El primer grupo (rojo) se caracteriza por presentar grandes diferencias respecto a la presencia de hombres y mujeres en el ámbito laboral (Hombres = 82%, Mujer = 23%)
El segundo grupo (verde) se caracteriza por presentar indicadores bajos de participación en el ámbito laboral para ambos grupos (Hombres = 66%, Mujer = 46%)
El tercer grupo (verde) se caracteriza por presentar indicadores moderados de participación en el ámbito laboral para ambos grupos (Hombres = 78%, Mujer = 50%)
El cuarto grupo (verde) se caracteriza por presentar indicadores altos de participación en el ámbito laboral para ambos grupos (Hombres = 84%, Mujer = 79%)

Contrastes en otras variables

Una vez caracterizados nuestrso conglomerados, podemos contrastar si nuestros conglomerados presentan diferencias en otras variables:

mundo98.grupos <- merge(data.grupos, mundo98, by ="row.names")

grafico <- ggplot(mundo98.grupos, aes(contraception)) + geom_boxplot(aes(color = grupo))

grafico

## Warning: Removed 46 rows containing non-finite values (stat_boxplot).