Taller de Análisis de Correspondencia
Peter Olejua, olejua.peter@javeriana.edu.co
Pontificia Universidad Javeriana, Bogotá2017 septiembre 12
Problema
Los datos del archivo “depresion.csv” que se encuentra en la plataforma, corresponden a la información de 294 pacientes estudiados para evaluar si sufrian o no de depresion. Dentro de las variables que se estudiaron se encuentran las siguientes:
- sexo: 1. Masculino 2. Femenino
- edad: Edad en años cumplidos
- estcivil: Estado Civil: 1.Soltero 2.Casado 3. Divorciado 4. Separado 5. vuido
- niveleducat: Nivel Educativo: 1. Primaria Incompleta 2. Primaria Completa 3. Bachillerato incompleto
- Bachillerato Completo 5. Pregrado 6. Maestría 7. Doctorado
- ocupacion: Ocupacion: 1. Tiempo Completo 2. Medio Tiempo 3. Desempleado 4.Pensionado 5.Ama de Casa 6.Estudiante 7.Otro
- religión: 1. Protestante 2. Catolico 3.Judio 4.Ninguna 5.Otra
- depresion: 0.No 1.Si
- alcohol: Comsume alcohol regularmente: 0.No 1.Si
- est_salud: Cual es su estad de salud: 1.Excelente 2.Bueno 3.Regular 4.Malo
- medico_reg: ¿Tiene un médico regular?
- Tratamiento: Tiene un médico que le recete medicamentos o tratamientos medicos: 1.Si 2.No
- diascama: pasado todo el día en la cama en los últimos dos meses? 0.No 1.Si
- aguda: Alguna enfermedad aguda en los últimos dos meses? 0.No 1. Si
- cronica: Alguna enfermedad crónica en los últimos dos meses? 0.No 1. Si
Sí el objetivo del estudio es el predecir si los pacientes sufren o no de depresión, considerando para ello las variables en estudio, que método emplearía, evalúe si cumple los supuestos (si es necesario transforme u organice la información), ejecútelo y discuta los resultados.
Sí el objetivo del estudio es el de clasificar los pacientes en grupos, que método emplearía, evalúe si cumple los supuestos (si es necesario transforme u organice la información), ejecútelo y discuta los resultados.
Sí el objetivo del estudio es el caracterizar estos pacientes a través de sus categorías de respuesta, que método emplearía, evalúe si cumple los supuestos (si es necesario transforme u organice la información), ejecútelo y discuta los resultados.
Análisis exploratorio
library(readr)
datos <- read_csv("depresion.csv")
str(datos)
summary(datos)
table(datos$sexo)
datos$sexo <- factor(datos$sexo, levels = 1:2, labels = c('Masculino', 'Femenino'))
table(unclass(datos$sexo), datos$sexo)
datos$sexo = relevel(datos$sexo, ref=1)
table(datos$estcivil)
datos$estcivil <- factor(datos$estcivil, levels = 1:5,
labels = c('Soltero', 'Casado', 'Divorciado', 'Separado', 'Viudo'))
table(unclass(datos$estcivil), datos$estcivil)
datos$estcivil = relevel(datos$estcivil, ref=1)
table(datos$niveleducat)
datos$niveleducat <- factor(datos$niveleducat, levels = 1:7,
labels = c('Primaria Incompleta', 'Primaria Completa', 'Bachillerato incompleto', 'Bachillerato Completo', 'Pregrado', 'Maestría', 'Doctorado'))
table(unclass(datos$niveleducat), datos$niveleducat)
table(datos$ocupacion)
datos$ocupacion <- factor(datos$ocupacion, levels = 1:7,
labels = c('Tiempo Completo', 'Medio Tiempo', 'Desempleado', 'Pensionado', 'Ama de Casa', 'Estudiante', 'Otro'))
table(unclass(datos$ocupacion), datos$ocupacion)
datos$ocupacion = relevel(datos$ocupacion, ref=1)
table(datos$religion)
datos$religion <- factor(datos$religion, levels = c(1:4,6),
labels = c('Protestante', 'Catolico', 'Judio', 'Ninguna', 'Otra'))
table(unclass(datos$religion), datos$religion)
datos$religion = relevel(datos$religion, ref=1)
table(datos$depresion)
datos$depresion <- factor(datos$depresion, levels = 0:1, labels = c('No', 'Sí'))
table(unclass(datos$depresion), datos$depresion)
datos$depresion = relevel(datos$depresion, ref=1)
table(datos$alcohol)
datos$alcohol <- factor(datos$alcohol, levels = 2:1, labels = c('No', 'Sí'))
table(unclass(datos$alcohol), datos$alcohol)
datos$alcohol = relevel(datos$alcohol, ref=1)
table(datos$est_salud)
datos$est_salud <- factor(datos$est_salud, levels = 1:4,
labels = c('Excelente', 'Bueno', 'Regular', 'Malo'))
table(unclass(datos$est_salud), datos$est_salud)
datos$est_salud = relevel(datos$est_salud, ref=1)
table(datos$medico_reg)
datos$medico_reg <- factor(datos$medico_reg, levels = 2:1, labels = c('No', 'Sí'))
table(unclass(datos$medico_reg), datos$medico_reg)
datos$medico_reg = relevel(datos$medico_reg, ref=1)
table(datos$tratamiento)
datos$tratamiento <- factor(datos$tratamiento, levels = 1:2, labels = c('No', 'Sí'))
table(unclass(datos$tratamiento), datos$tratamiento)
datos$tratamiento = relevel(datos$tratamiento, ref=1)
table(datos$diascama)
datos$diascama <- factor(datos$diascama, levels = 0:1, labels = c('No', 'Sí'))
table(unclass(datos$diascama), datos$diascama)
datos$diascama = relevel(datos$diascama, ref=1)
table(datos$aguda)
datos$aguda <- factor(datos$aguda, levels = 0:1, labels = c('No', 'Sí'))
table(unclass(datos$aguda), datos$aguda)
datos$aguda = relevel(datos$aguda, ref=1)
table(datos$cronica)
datos$cronica <- factor(datos$cronica, levels = 0:1, labels = c('No', 'Sí'))
table(unclass(datos$cronica), datos$cronica)
datos$cronica = relevel(datos$cronica, ref=1)summary(datos) id sexo edad estcivil
Min. : 1.00 Masculino:111 Min. :18.00 Soltero : 73
1st Qu.: 74.25 Femenino :183 1st Qu.:28.00 Casado :127
Median :147.50 Median :42.50 Divorciado: 43
Mean :147.50 Mean :44.41 Separado : 13
3rd Qu.:220.75 3rd Qu.:59.00 Viudo : 38
Max. :294.00 Max. :89.00
niveleducat ocupacion religion
Primaria Incompleta : 5 Tiempo Completo:167 Protestante:155
Primaria Completa : 61 Medio Tiempo : 42 Catolico : 51
Bachillerato incompleto:114 Desempleado : 14 Judio : 30
Bachillerato Completo : 48 Pensionado : 38 Ninguna : 56
Pregrado : 43 Ama de Casa : 27 Otra : 2
Maestría : 14 Estudiante : 2
Doctorado : 9 Otro : 4
depresion alcohol est_salud medico_reg tratamiento diascama
No:244 No: 60 Excelente:130 No: 55 No:148 No:231
Sí: 50 Sí:234 Bueno :115 Sí:239 Sí:146 Sí: 63
Regular : 35
Malo : 14
aguda cronica
No:207 No:145
Sí: 87 Sí:149
by(datos[-1],datos$depresion,summary)datos$depresion: No
sexo edad estcivil
Masculino:101 Min. :18.00 Soltero : 57
Femenino :143 1st Qu.:29.00 Casado :110
Median :43.50 Divorciado: 36
Mean :45.24 Separado : 9
3rd Qu.:59.00 Viudo : 32
Max. :89.00
niveleducat ocupacion religion
Primaria Incompleta : 5 Tiempo Completo:147 Protestante:134
Primaria Completa :45 Medio Tiempo : 31 Catolico : 43
Bachillerato incompleto:93 Desempleado : 8 Judio : 23
Bachillerato Completo :44 Pensionado : 34 Ninguna : 43
Pregrado :35 Ama de Casa : 20 Otra : 1
Maestría :14 Estudiante : 1
Doctorado : 8 Otro : 3
depresion alcohol est_salud medico_reg tratamiento diascama
No:244 No: 51 Excelente:113 No: 42 No:118 No:202
Sí: 0 Sí:193 Bueno : 97 Sí:202 Sí:126 Sí: 42
Regular : 25
Malo : 9
aguda cronica
No:176 No:126
Sí: 68 Sí:118
--------------------------------------------------------
datos$depresion: Sí
sexo edad estcivil
Masculino:10 Min. :18.00 Soltero :16
Femenino :40 1st Qu.:26.00 Casado :17
Median :34.50 Divorciado: 7
Mean :40.38 Separado : 4
3rd Qu.:51.00 Viudo : 6
Max. :79.00
niveleducat ocupacion religion
Primaria Incompleta : 0 Tiempo Completo:20 Protestante:21
Primaria Completa :16 Medio Tiempo :11 Catolico : 8
Bachillerato incompleto:21 Desempleado : 6 Judio : 7
Bachillerato Completo : 4 Pensionado : 4 Ninguna :13
Pregrado : 8 Ama de Casa : 7 Otra : 1
Maestría : 0 Estudiante : 1
Doctorado : 1 Otro : 1
depresion alcohol est_salud medico_reg tratamiento diascama aguda
No: 0 No: 9 Excelente:17 No:13 No:30 No:29 No:31
Sí:50 Sí:41 Bueno :18 Sí:37 Sí:20 Sí:21 Sí:19
Regular :10
Malo : 5
cronica
No:19
Sí:31
library(ggplot2); require(gridExtra)
# Edad
with(datos,boxplot(edad ~ depresion , main="Edad vs Depresión", las=2))
# sexo
tabla <- with(datos,table(sexo,depresion))
p1 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=sexo, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs sexo")+
theme(legend.position="none")
# Estado civil
tabla <- with(datos,table(estcivil,depresion))
p2 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=estcivil, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs estcivil")+
theme(legend.position="none")
# niveleducat
tabla <- with(datos,table(niveleducat,depresion))
p3 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=niveleducat, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs niveleducat")
grid.arrange(p1, p2, p3, ncol=3)
# ocupacion
tabla <- with(datos,table(ocupacion,depresion))
p1 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=ocupacion, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs ocupacion")+
theme(legend.position="none")
# religion
tabla <- with(datos,table(religion,depresion))
p2 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=religion, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs religion")+
theme(legend.position="none")
# alcohol
tabla <- with(datos,table(alcohol,depresion))
p3 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=alcohol, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs alcohol")
grid.arrange(p1, p2, p3, ncol=3)
# est_salud
tabla <- with(datos,table(est_salud,depresion))
p1 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=est_salud, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs est_salud")+
theme(legend.position="none")
# medico_reg
tabla <- with(datos,table(medico_reg,depresion))
p2 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=medico_reg, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs medico_reg")+
theme(legend.position="none")
# tratamiento
tabla <- with(datos,table(tratamiento,depresion))
p3 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=tratamiento, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs tratamiento")
grid.arrange(p1, p2, p3, ncol=3)
# diascama
tabla <- with(datos,table(diascama,depresion))
p1 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=diascama, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs diascama")+
theme(legend.position="none")
# aguda
tabla <- with(datos,table(aguda,depresion))
p2 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=aguda, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs aguda")+
theme(legend.position="none")
# cronica
tabla <- with(datos,table(cronica,depresion))
p3 <- ggplot(as.data.frame(prop.table(tabla,1)), aes(x=cronica, y = Freq, fill=depresion)) +
geom_bar(stat="identity") +
theme(axis.text.x=element_text(angle=45,hjust=1))+
labs(title = "% Depresión vs cronica")
grid.arrange(p1, p2, p3, ncol=3)
La proporción de personas con depresión es mayor en mujeres, seperados, personas con primaria completa, estudiantes y desempleados; Judíos, ninguna u otras religiones, consumidores de alcohol, personas con un mal estado de salud, cuando no se cuenta con un médico regular o que le recete sus tratamientos; en aquellos con dos meses en cama, con una enfermedad aguda o crónica
1. Predicción de la depresión
Una alternativa es usar árboles de clasificación. No necesitamos algún supuesto en particular. Los datos ya han sido formateados adecuadamente al momento del análisis exploratorio. Por ahora, usamos como muestra de entrenamiento todos los datos y no utilizamos una data de validación.
Ajuste
Ajustamos un árbol de clasificación para la depresión considerando las demás variables (edad continua) ecepto el id. Se obtiene el siguiente árbol:
# Classification Tree with rpart
library(rpart)
# grow tree
set.seed(17)
fit <- rpart(depresion ~ .,
method="class", data=datos[-1])
# plot tree
library(rattle)
fancyRpartPlot(fit, cex=.8)
Importancia de las variables
La importancia de las variables, a continuación, es calculada como la suma de los decrecimientos en la impureza.
# variable importance
library(knitr)
kable(fit$variable.importance, digits = 2)| diascama | 4.27 |
| religion | 4.10 |
| ocupacion | 3.88 |
| niveleducat | 3.25 |
| est_salud | 2.16 |
| sexo | 1.78 |
| edad | 1.53 |
| estcivil | 1.34 |
| tratamiento | 0.76 |
| cronica | 0.25 |
Estar los últimos dos meses en cama es el mejor predictor.
Características operativas del arbol
Bajo esta muestra de modelamiento (100%), obtenemos la matriz de confusión
pred = predict(fit, type="class")
library(caret)
confusionMatrix(pred, datos$depresion)Confusion Matrix and Statistics
Reference
Prediction No Sí
No 228 26
Sí 16 24
Accuracy : 0.8571
95% CI : (0.8118, 0.8951)
No Information Rate : 0.8299
P-Value [Acc > NIR] : 0.1207
Kappa : 0.4502
Mcnemar's Test P-Value : 0.1649
Sensitivity : 0.9344
Specificity : 0.4800
Pos Pred Value : 0.8976
Neg Pred Value : 0.6000
Prevalence : 0.8299
Detection Rate : 0.7755
Detection Prevalence : 0.8639
Balanced Accuracy : 0.7072
'Positive' Class : No
Este árbol no es muy preciso (86%). Con un p-valor=0.1207, no podemos asegurar que la precisión sea mayor a la tasa de no información.
Poda del árbol
El árbol anterior puede ser podado con base al parámetro de complejidad,
# printcp(fit) # display the results
# summary(fit) # detailed summary of splits
library(knitr)
kable(fit$cptable, digits=3)| CP | nsplit | rel error | xerror | xstd |
|---|---|---|---|---|
| 0.027 | 0 | 1.00 | 1.00 | 0.129 |
| 0.020 | 3 | 0.92 | 1.16 | 0.136 |
| 0.010 | 7 | 0.84 | 1.26 | 0.141 |
plotcp(fit) # visualize cross-validation results
# prune the tree
pfit<- prune(fit, cp= fit$cptable[which.min(fit$cptable[,"xerror"]),"CP"])
# summary(pfit)
# plot the pruned tree
# fancyRpartPlot(pfit)La siguiente es la matriz de confusión para el árbol podado,
pred = predict(pfit, type="class")
library(caret)
confusionMatrix(pred, datos$depresion)Confusion Matrix and Statistics
Reference
Prediction No Sí
No 244 50
Sí 0 0
Accuracy : 0.8299
95% CI : (0.782, 0.8711)
No Information Rate : 0.8299
P-Value [Acc > NIR] : 0.5377
Kappa : 0
Mcnemar's Test P-Value : 4.219e-12
Sensitivity : 1.0000
Specificity : 0.0000
Pos Pred Value : 0.8299
Neg Pred Value : NaN
Prevalence : 0.8299
Detection Rate : 0.8299
Detection Prevalence : 1.0000
Balanced Accuracy : 0.5000
'Positive' Class : No
Este árbol no es útil ya que predice todos los casos como no-drepresión. El ábol definitivo es el primero ajustado.
Conclusión
El árbol no tiene buenas medidas. Su precisión, sensibilidad y valor predictivo negativos son demasiado bajos. Se recomienda usar otra técnica, por ejemplo regresión logística y comparar los resultados.
2. Clasificar los pacientes en grupos
La técnica adecuada en este caso es análisis de conglomerados. Para el agrupamiento usamos todas las variables.
Distancia de Gower
Dado que tenomos datos mixtos usamos la distancia Gower.
library(cluster)
gower_dist <- daisy(datos[,-1],
metric = "gower")
summary(gower_dist)43071 dissimilarities, summarized :
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.001006 0.382290 0.501010 0.487480 0.584510 0.977870
Metric : mixed ; Types = N, I, N, N, N, N, N, N, N, N, N, N, N, N
Number of objects : 294hist(gower_dist, main="Distancia de Gower")
Los dos sujetos más similares y los dos más distintos
gower_mat <- as.matrix(gower_dist)
# Output most similar pair
datos[
which(gower_mat == min(gower_mat[gower_mat != min(gower_mat)]),
arr.ind = TRUE)[1, ], ]| id | sexo | edad | estcivil | niveleducat | ocupacion | religion | depresion | alcohol | est_salud | medico_reg | tratamiento | diascama | aguda | cronica |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 214 | Masculino | 25 | Casado | Bachillerato incompleto | Tiempo Completo | Protestante | No | Sí | Bueno | Sí | Sí | No | No | No |
| 204 | Masculino | 26 | Casado | Bachillerato incompleto | Tiempo Completo | Protestante | No | Sí | Bueno | Sí | Sí | No | No | No |
# Output most dissimilar pair
datos[
which(gower_mat == max(gower_mat[gower_mat != max(gower_mat)]),
arr.ind = TRUE)[1, ], ]| id | sexo | edad | estcivil | niveleducat | ocupacion | religion | depresion | alcohol | est_salud | medico_reg | tratamiento | diascama | aguda | cronica |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 227 | Femenino | 89 | Viudo | Doctorado | Medio Tiempo | Protestante | No | Sí | Excelente | No | Sí | No | No | No |
| 211 | Masculino | 47 | Casado | Primaria Completa | Otro | Catolico | Sí | No | Regular | Sí | No | Sí | Sí | Sí |
Aglomerativo
Número de clusters
library(seriation)
dissplot(gower_mat)
library(NbClust)
clusters <- 2:6
Medidas <- data.frame(clusters,
frey= NA,mcclain= NA,cindex= NA,silhouette= NA,dunn= NA
)
Medidas <- rbind(Medidas, c("Best.nc", rep(NA,5)))
indices <- c('frey', 'mcclain', 'cindex', 'silhouette', 'dunn')
for (i in seq_along(indices)) {
res<-NbClust(diss=gower_dist, distance = NULL,
min.nc=min(clusters), max.nc=max(clusters),
method = "ward.D2",
index = indices[i])
res$All.index
res$Best.nc
res$All.CriticalValues
res$Best.partition
Medidas[i+1] <- c(res$All.index,res$Best.nc[1])
}
Only frey, mcclain, cindex, sihouette and dunn can be computed. To compute the other indices, data matrix is needed
Only frey, mcclain, cindex, sihouette and dunn can be computed. To compute the other indices, data matrix is needed
Only frey, mcclain, cindex, sihouette and dunn can be computed. To compute the other indices, data matrix is needed
Only frey, mcclain, cindex, sihouette and dunn can be computed. To compute the other indices, data matrix is needed
Only frey, mcclain, cindex, sihouette and dunn can be computed. To compute the other indices, data matrix is needed Medidas| clusters | frey | mcclain | cindex | silhouette | dunn |
|---|---|---|---|---|---|
| 2 | 0.3498 | 0.8110 | 0.4921 | 0.1591 | 0.0910 |
| 3 | 0.5614 | 1.4793 | 0.4706 | 0.1215 | 0.0916 |
| 4 | 0.3289 | 1.9685 | 0.4934 | 0.0978 | 0.0946 |
| 5 | 0.0413 | 2.8227 | 0.4911 | 0.0940 | 0.0917 |
| 6 | 0.7905 | 3.1569 | 0.4826 | 0.0908 | 0.0927 |
| Best.nc | 1.0000 | 2.0000 | 3.0000 | 2.0000 | 4.0000 |
Partitioning around medoids (PAM)
Number of clusters
# Calculate silhouette width for many k using PAM
sil_width <- c(NA)
for(i in 2:10){
pam_fit <- pam(gower_dist,
diss = TRUE,
k = i)
sil_width[i] <- pam_fit$silinfo$avg.width
}
# Plot sihouette width (higher is better)
plot(1:10, sil_width,
xlab = "Number of clusters",
ylab = "Silhouette Width")
lines(1:10, sil_width)
Seleccionamos el método Aglomerativo y Ward con dos segmentos
hier <- hclust(gower_dist, method = 'ward.D2')
plot(hier)
segmento <- cutree(hier,2)
rect.hclust(hier, k=2) 
# Medidas
sil <- silhouette(segmento,dist = gower_dist)
summary(sil)Silhouette of 294 units in 2 clusters from silhouette.default(x = segmento, dist = gower_dist) :
Cluster sizes and average silhouette widths:
169 125
0.113978 0.220132
Individual silhouette widths:
Min. 1st Qu. Median Mean 3rd Qu. Max.
-0.29694 0.08279 0.18940 0.15911 0.24465 0.35729 clValid::connectivity(clusters = as.integer(segmento), distance = as.matrix(gower_dist), neighbSize=10)[1] 107.179clValid::dunn(distance = as.matrix(gower_dist), clusters = as.integer(segmento))[1] 0.09100999Las medidas conseguidas son consideradas como pobres. La técnica de clustering ha conseguido una probre discrimiación en grupos homogéneos al interior y heterogéneos entre ellos.
Descripción de los clusters
library(FactoMineR)
catdes(donnee = data.frame(as.factor(segmento), datos),1)$test.chi2
p.value df
cronica 8.602794e-34 1
tratamiento 2.939923e-33 1
est_salud 7.241488e-09 3
sexo 1.117061e-07 1
diascama 2.369520e-04 1
ocupacion 1.846419e-03 6
estcivil 2.024419e-03 4
medico_reg 9.151696e-03 1
aguda 9.826645e-03 1
alcohol 1.273732e-02 1
depresion 4.938771e-02 1
$category
$category$`1`
Cla/Mod Mod/Cla Global p.value
cronica=Sí 91.94631 81.065089 50.680272 4.156006e-37
tratamiento=No 91.89189 80.473373 50.340136 1.693820e-36
sexo=Femenino 69.39891 75.147929 62.244898 1.277113e-07
est_salud=Regular 94.28571 19.526627 11.904762 4.067925e-07
diascama=Sí 77.77778 28.994083 21.428571 1.871601e-04
est_salud=Malo 100.00000 8.284024 4.761905 3.386438e-04
aguda=Sí 68.96552 35.502959 29.591837 9.782981e-03
medico_reg=Sí 61.08787 86.390533 81.292517 1.028672e-02
alcohol=No 71.66667 25.443787 20.408163 1.243669e-02
ocupacion=Pensionado 73.68421 16.568047 12.925170 3.004435e-02
estcivil=Viudo 73.68421 16.568047 12.925170 3.004435e-02
depresion=Sí 70.00000 20.710059 17.006803 4.970163e-02
depresion=No 54.91803 79.289941 82.993197 4.970163e-02
alcohol=Sí 53.84615 74.556213 79.591837 1.243669e-02
medico_reg=No 41.81818 13.609467 18.707483 1.028672e-02
aguda=No 52.65700 64.497041 70.408163 9.782981e-03
ocupacion=Medio Tiempo 35.71429 8.875740 14.285714 2.459458e-03
estcivil=Soltero 41.09589 17.751479 24.829932 1.256471e-03
diascama=No 51.94805 71.005917 78.571429 1.871601e-04
est_salud=Excelente 43.07692 33.136095 44.217687 9.337406e-06
sexo=Masculino 37.83784 24.852071 37.755102 1.277113e-07
tratamiento=Sí 22.60274 19.526627 49.659864 1.693820e-36
cronica=No 22.06897 18.934911 49.319728 4.156006e-37
v.test
cronica=Sí 12.727565
tratamiento=No 12.617371
sexo=Femenino 5.282100
est_salud=Regular 5.065751
diascama=Sí 3.735745
est_salud=Malo 3.583790
aguda=Sí 2.583407
medico_reg=Sí 2.566039
alcohol=No 2.499505
ocupacion=Pensionado 2.169505
estcivil=Viudo 2.169505
depresion=Sí 1.962523
depresion=No -1.962523
alcohol=Sí -2.499505
medico_reg=No -2.566039
aguda=No -2.583407
ocupacion=Medio Tiempo -3.028285
estcivil=Soltero -3.225741
diascama=No -3.735745
est_salud=Excelente -4.431974
sexo=Masculino -5.282100
tratamiento=Sí -12.617371
cronica=No -12.727565
$category$`2`
Cla/Mod Mod/Cla Global p.value v.test
cronica=No 77.931034 90.4 49.319728 4.156006e-37 12.727565
tratamiento=Sí 77.397260 90.4 49.659864 1.693820e-36 12.617371
sexo=Masculino 62.162162 55.2 37.755102 1.277113e-07 5.282100
est_salud=Excelente 56.923077 59.2 44.217687 9.337406e-06 4.431974
diascama=No 48.051948 88.8 78.571429 1.871601e-04 3.735745
estcivil=Soltero 58.904110 34.4 24.829932 1.256471e-03 3.225741
ocupacion=Medio Tiempo 64.285714 21.6 14.285714 2.459458e-03 3.028285
aguda=No 47.342995 78.4 70.408163 9.782981e-03 2.583407
medico_reg=No 58.181818 25.6 18.707483 1.028672e-02 2.566039
alcohol=Sí 46.153846 86.4 79.591837 1.243669e-02 2.499505
depresion=No 45.081967 88.0 82.993197 4.970163e-02 1.962523
depresion=Sí 30.000000 12.0 17.006803 4.970163e-02 -1.962523
ocupacion=Pensionado 26.315789 8.0 12.925170 3.004435e-02 -2.169505
estcivil=Viudo 26.315789 8.0 12.925170 3.004435e-02 -2.169505
alcohol=No 28.333333 13.6 20.408163 1.243669e-02 -2.499505
medico_reg=Sí 38.912134 74.4 81.292517 1.028672e-02 -2.566039
aguda=Sí 31.034483 21.6 29.591837 9.782981e-03 -2.583407
est_salud=Malo 0.000000 0.0 4.761905 3.386438e-04 -3.583790
diascama=Sí 22.222222 11.2 21.428571 1.871601e-04 -3.735745
est_salud=Regular 5.714286 1.6 11.904762 4.067925e-07 -5.065751
sexo=Femenino 30.601093 44.8 62.244898 1.277113e-07 -5.282100
tratamiento=No 8.108108 9.6 50.340136 1.693820e-36 -12.617371
cronica=Sí 8.053691 9.6 50.680272 4.156006e-37 -12.727565
$quanti.var
Eta2 P-value
edad 0.04765825 0.0001613887
$quanti
$quanti$`1`
v.test Mean in category Overall mean sd in category Overall sd
edad 3.736826 47.80473 44.41497 17.2638 18.05466
p.value
edad 0.000186358
$quanti$`2`
v.test Mean in category Overall mean sd in category Overall sd
edad -3.736826 39.832 44.41497 18.08855 18.05466
p.value
edad 0.000186358
attr(,"class")
[1] "catdes" "list " by(datos, segmento, summary, na.rm=T)segmento: 1
id sexo edad estcivil
Min. : 1.0 Masculino: 42 Min. :18.0 Soltero :30
1st Qu.: 70.0 Femenino :127 1st Qu.:33.0 Casado :71
Median :146.0 Median :47.0 Divorciado:30
Mean :145.3 Mean :47.8 Separado :10
3rd Qu.:216.0 3rd Qu.:60.0 Viudo :28
Max. :294.0 Max. :83.0
niveleducat ocupacion religion
Primaria Incompleta : 2 Tiempo Completo:96 Protestante:97
Primaria Completa :36 Medio Tiempo :15 Catolico :26
Bachillerato incompleto:73 Desempleado : 5 Judio :18
Bachillerato Completo :26 Pensionado :28 Ninguna :27
Pregrado :21 Ama de Casa :20 Otra : 1
Maestría : 7 Estudiante : 1
Doctorado : 4 Otro : 4
depresion alcohol est_salud medico_reg tratamiento diascama
No:134 No: 43 Excelente:56 No: 23 No:136 No:120
Sí: 35 Sí:126 Bueno :66 Sí:146 Sí: 33 Sí: 49
Regular :33
Malo :14
aguda cronica
No:109 No: 32
Sí: 60 Sí:137
--------------------------------------------------------
segmento: 2
id sexo edad estcivil
Min. : 8.0 Masculino:69 Min. :18.00 Soltero :43
1st Qu.: 77.0 Femenino :56 1st Qu.:24.00 Casado :56
Median :149.0 Median :34.00 Divorciado:13
Mean :150.5 Mean :39.83 Separado : 3
3rd Qu.:232.0 3rd Qu.:52.00 Viudo :10
Max. :293.0 Max. :89.00
niveleducat ocupacion religion
Primaria Incompleta : 3 Tiempo Completo:71 Protestante:58
Primaria Completa :25 Medio Tiempo :27 Catolico :25
Bachillerato incompleto:41 Desempleado : 9 Judio :12
Bachillerato Completo :22 Pensionado :10 Ninguna :29
Pregrado :22 Ama de Casa : 7 Otra : 1
Maestría : 7 Estudiante : 1
Doctorado : 5 Otro : 0
depresion alcohol est_salud medico_reg tratamiento diascama aguda
No:110 No: 17 Excelente:74 No:32 No: 12 No:111 No:98
Sí: 15 Sí:108 Bueno :49 Sí:93 Sí:113 Sí: 14 Sí:27
Regular : 2
Malo : 0
cronica
No:113
Sí: 12
Conclusión
En el grupo 1 están principalmente los sujetos con enfermedades crónica, que no tienen un doctor que les asigne un tratamiento y cuyo estado de salud está entre regular y malo. En el grupo 2 están principalmente los sujetos sin enfermedades crónica, que sí tienen un doctor que les asigne un tratamiento y cuyo estado de salud está entre bueno y excelente. Esta representación tiene pobres medidas. Dado que la mayoría de variables son categóricas quizá sea más conveniente observar esta población desde el punto de vista de dichas categorías utilizando un análisis de correspondencias como en el siguiente punto.
3. Caracterización a través de las categorías.
Empleamos una Análisis de Correspondencias Múltiple. Previamente debemos categorizar las variables continuas (edad)
library(reshape2)
df2 = melt(datos[-1], id.vars = c('edad'),
variable.name ='Variable', value.name = "Valor")
library(ggplot2)
p <- ggplot(data = df2, aes(x=Valor, y=edad))+
geom_boxplot() +
theme(axis.text.x=element_text(angle=45,hjust=1))
p + facet_wrap( ~ Variable, ncol = 3, scales="free")
Para categorizar la edad nos fijamos en las diferencias por estados civil, nivel educativo y ocupación. Así creamos las categorías “<18”, “[18,40)”, “[40,60)” y “>60”
datos$edad_cut <- cut(datos$edad, breaks = c(-Inf,18,40,60,Inf),include.lowest = T, ordered_result = T,
labels = c("<18", "[18,40)", "[40,60)", ">60"))
summary(datos$edad_cut) <18 [18,40) [40,60) >60
5 132 96 61 Inercias ajustadas
class_df <- as.data.frame(sapply(datos, class))
var_categoricas <- unlist(class_df[1,]) %in% c("ordered","factor")
library(ca)
res.mca <- mjca(datos[,var_categoricas], lambda="adjusted")
summary(res.mca, scree = TRUE)
Principal inertias (eigenvalues):
dim value % cum% scree plot
1 0.023704 39.7 39.7 *************
2 0.008685 14.5 54.2 *****
3 0.004737 7.9 62.1 ***
4 0.001977 3.3 65.4 *
5 0.001658 2.8 68.2 *
6 0.001246 2.1 70.3 *
7 0.000835 1.4 71.7
8 0.000562 0.9 72.6
9 0.000259 0.4 73.1
10 0.000235 0.4 73.5
11 8.8e-050 0.1 73.6
12 6.8e-050 0.1 73.7
13 4.1e-050 0.1 73.8
14 00000000 0.0 73.8
-------- -----
Total: 0.059755
Columns:
name mass qlt inr k=1 cor ctr
1 | sexo:Masculino | 27 608 19 | -143 454 23 |
2 | sexo:Femenino | 44 608 11 | 87 454 14 |
3 | estcivil:Soltero | 18 593 24 | -243 566 44 |
4 | estcivil:Casado | 31 16 15 | 15 13 0 |
5 | estcivil:Divorciado | 10 144 21 | -65 122 2 |
6 | estcivil:Separado | 3 358 25 | 110 44 2 |
7 | estcivil:Viudo | 9 764 32 | 455 628 81 |
8 | niveleducat:Primaria Incompleta | 1 115 26 | 87 8 0 |
9 | niveleducat:Primaria Completa | 15 516 25 | 258 511 41 |
10 | niveleducat:Bachillerato incompleto | 28 135 15 | 39 121 2 |
11 | niveleducat:Bachillerato Completo | 12 184 20 | -78 175 3 |
12 | niveleducat:Pregrado | 10 676 23 | -261 676 30 |
13 | niveleducat:Maestría | 3 311 24 | -222 226 7 |
14 | niveleducat:Doctorado | 2 304 24 | -281 273 7 |
15 | ocupacion:Tiempo Completo | 41 624 16 | -155 620 41 |
16 | ocupacion:Medio Tiempo | 10 52 21 | -50 51 1 |
17 | ocupacion:Desempleado | 3 113 25 | -111 44 2 |
18 | ocupacion:Pensionado | 9 696 36 | 504 562 99 |
19 | ocupacion:Ama de Casa | 7 562 26 | 344 528 33 |
20 | ocupacion:Estudiante | 0 173 26 | -343 56 2 |
21 | ocupacion:Otro | 1 468 25 | 439 241 8 |
22 | religion:Protestante | 38 227 13 | 64 226 7 |
23 | religion:Catolico | 12 14 21 | -24 13 0 |
24 | religion:Judio | 7 60 22 | 0 0 0 |
25 | religion:Ninguna | 14 320 22 | -148 317 12 |
26 | religion:Otra | 0 27 27 | -243 26 1 |
27 | depresion:No | 59 479 5 | -12 35 0 |
28 | depresion:Sí | 12 479 24 | 60 35 2 |
29 | alcohol:No | 15 551 23 | 203 492 25 |
30 | alcohol:Sí | 57 551 6 | -52 492 7 |
31 | est_salud:Excelente | 32 775 18 | -189 772 47 |
32 | est_salud:Bueno | 28 442 16 | 56 180 4 |
33 | est_salud:Regular | 9 737 26 | 308 515 34 |
34 | est_salud:Malo | 3 604 28 | 522 550 39 |
35 | medico_reg:No | 13 509 23 | -204 503 23 |
36 | medico_reg:Sí | 58 509 5 | 47 503 5 |
37 | tratamiento:No | 36 731 18 | 169 587 43 |
38 | tratamiento:Sí | 35 731 18 | -171 587 44 |
39 | diascama:No | 56 639 7 | -8 5 0 |
40 | diascama:Sí | 15 639 27 | 28 5 0 |
41 | aguda:No | 50 613 9 | 21 37 1 |
42 | aguda:Sí | 21 613 22 | -50 37 2 |
43 | cronica:No | 35 714 19 | -170 567 43 |
44 | cronica:Sí | 36 714 18 | 166 567 42 |
45 | edad_cut:<18 | 1 127 28 | -71 4 0 |
46 | edad_cut:[18,40) | 32 755 21 | -226 728 69 |
47 | edad_cut:[40,60) | 23 174 19 | 60 89 3 |
48 | edad_cut:>60 | 15 701 36 | 401 540 101 |
k=2 cor ctr
1 -84 155 22 |
2 51 155 13 |
3 53 27 6 |
4 -7 3 0 |
5 28 23 1 |
6 294 314 31 |
7 -211 136 48 |
8 -312 106 14 |
9 25 5 1 |
10 -14 14 1 |
11 19 10 0 |
12 -8 1 0 |
13 137 85 7 |
14 -95 31 2 |
15 12 4 1 |
16 9 2 0 |
17 140 69 8 |
18 -246 134 64 |
19 87 34 6 |
20 496 117 14 |
21 427 228 20 |
22 4 1 0 |
23 8 1 0 |
24 -60 60 3 |
25 15 3 0 |
26 -46 1 0 |
27 -44 444 13 |
28 214 444 64 |
29 71 59 8 |
30 -18 59 2 |
31 -12 3 1 |
32 -68 262 15 |
33 202 222 40 |
34 165 55 11 |
35 22 6 1 |
36 -5 6 0 |
37 84 144 29 |
38 -85 144 29 |
39 -83 633 45 |
40 305 633 164 |
41 -83 576 40 |
42 198 576 95 |
43 -87 147 30 |
44 84 147 30 |
45 400 123 22 |
46 44 27 7 |
47 59 86 9 |
48 -219 161 82 |# Inertia percentage
library(factoextra)
fviz_screeplot(res.mca)
# Biplots
plot(res.mca, map='symbiplot', contrib='relative', main='Correspondencias múltiple (inercias ajustadas)')
# number of categories per variable
cats = apply(datos[,var_categoricas], 2, function(x) nlevels(as.factor(x)))
library(ggplot2)
# data frame with variable coordinates
mca1_vars_df = data.frame(res.mca$colcoord, Variable = rep(names(cats), cats))
rownames(mca1_vars_df) = res.mca$levelnames
# plot of variable categories
ggplot(data=mca1_vars_df,
aes(x = X1, y=X2, label = abbreviate(rownames(mca1_vars_df),20))) +
geom_hline(yintercept = 0, colour = "gray70") +
geom_vline(xintercept = 0, colour = "gray70") +
geom_text(aes(colour=Variable)) +
ggtitle("MCA biplot")
Con el método de inercias ajustadas las representación en dos dimensiones de las categorías apena alcanza el 54.2% de la inercia total.
Análisis conjunto (JCA)
library(ca)
res.mca <- mjca(datos[,var_categoricas], lambda="JCA")
summary(res.mca, scree = TRUE)
Principal inertias (eigenvalues):
dim value
1 0.029938
2 0.011457
3 0.004554
4 0.002405
5 0.001717
6 0.001331
7 0.001070
8 0.000784
9 5e-04000
10 0.000308
11 0.000190
12 0.000141
13 8.8e-050
14 2.3e-050
--------
Total: 0.063280
Diagonal inertia discounted from eigenvalues: 0.0077926
Percentage explained by JCA in 2 dimensions: 60.6%
(Eigenvalues are not nested)
[Iterations in JCA: 23 , epsilon = 8.08e-05]
Columns:
name mass inr k=1 k=2 cor ctr
1 | sexo:Masculino | 27 19 | -128 98 | 582 20
2 | sexo:Femenino | 44 11 | 77 -60 | 582 12
3 | estcivil:Soltero | 18 24 | -268 -43 | 643 33
4 | estcivil:Casado | 31 15 | 12 6 | 10 0
5 | estcivil:Divorciado | 10 21 | -77 -31 | 179 2
6 | estcivil:Separado | 3 25 | 67 -284 | 322 8
7 | estcivil:Viudo | 9 32 | 538 196 | 895 75
8 | niveleducat:Primaria Incompleta | 1 26 | 149 291 | 123 4
9 | niveleducat:Primaria Completa | 15 25 | 257 -41 | 520 28
10 | niveleducat:Bachillerato incompleto | 28 15 | 39 4 | 122 1
11 | niveleducat:Bachillerato Completo | 12 20 | -86 -15 | 219 2
12 | niveleducat:Pregrado | 10 23 | -258 40 | 675 20
13 | niveleducat:Maestría | 3 24 | -236 -110 | 315 6
14 | niveleducat:Doctorado | 2 24 | -260 120 | 284 5
15 | ocupacion:Tiempo Completo | 41 16 | -185 -12 | 734 32
16 | ocupacion:Medio Tiempo | 10 21 | -62 -1 | 64 1
17 | ocupacion:Desempleado | 3 25 | -155 -123 | 114 3
18 | ocupacion:Pensionado | 9 36 | 663 243 | 885 102
19 | ocupacion:Ama de Casa | 7 26 | 365 -95 | 560 23
20 | ocupacion:Estudiante | 0 26 | -495 -469 | 183 5
21 | ocupacion:Otro | 1 25 | 400 -479 | 485 10
22 | religion:Protestante | 38 13 | 55 -10 | 184 3
23 | religion:Catolico | 12 21 | -18 -1 | 8 0
24 | religion:Judio | 7 22 | 12 53 | 53 1
25 | religion:Ninguna | 14 22 | -135 -3 | 282 7
26 | religion:Otra | 0 27 | -227 92 | 28 1
27 | depresion:No | 59 5 | -7 45 | 480 3
28 | depresion:Sí | 12 24 | 36 -218 | 480 17
29 | alcohol:No | 15 23 | 182 -86 | 503 17
30 | alcohol:Sí | 57 6 | -47 22 | 503 4
31 | est_salud:Excelente | 32 18 | -199 52 | 849 34
32 | est_salud:Bueno | 28 16 | 63 53 | 405 5
33 | est_salud:Regular | 9 26 | 315 -260 | 808 35
34 | est_salud:Malo | 3 28 | 550 -264 | 677 31
35 | medico_reg:No | 13 23 | -188 2 | 454 14
36 | medico_reg:Sí | 58 5 | 43 0 | 454 3
37 | tratamiento:No | 36 18 | 170 -122 | 817 39
38 | tratamiento:Sí | 35 18 | -172 124 | 817 40
39 | diascama:No | 56 7 | 1 97 | 728 12
40 | diascama:Sí | 15 27 | -3 -356 | 728 45
41 | aguda:No | 50 9 | 31 87 | 679 11
42 | aguda:Sí | 21 22 | -73 -207 | 679 27
43 | cronica:No | 35 19 | -170 127 | 803 40
44 | cronica:Sí | 36 18 | 166 -124 | 803 39
45 | edad_cut:<18 | 1 28 | -200 -427 | 138 6
46 | edad_cut:[18,40) | 32 21 | -281 -52 | 893 56
47 | edad_cut:[40,60) | 23 19 | 43 -68 | 167 4
48 | edad_cut:>60 | 15 36 | 557 254 | 914 111
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |# Biplots
plot(res.mca, map='symbiplot', contrib='relative', main='Correspondencias múltiple Conjunto')
# number of categories per variable
cats = apply(datos[,var_categoricas], 2, function(x) nlevels(as.factor(x)))
library(ggplot2)
# data frame with variable coordinates
mca1_vars_df = data.frame(res.mca$colcoord, Variable = rep(names(cats), cats))
rownames(mca1_vars_df) = res.mca$levelnames
# plot of variable categories
ggplot(data=mca1_vars_df,
aes(x = X1, y=X2, label = abbreviate(rownames(mca1_vars_df),20))) +
geom_hline(yintercept = 0, colour = "gray70") +
geom_vline(xintercept = 0, colour = "gray70") +
geom_text(aes(colour=Variable)) +
ggtitle("MCA biplot")
Con la solución por análisis conjunto el porcentaje de inercia estimada por la dosprimeras dimensiones es del 60.6% (inercias no anidadas). La calidad de varias categorías mejora considerablemente, siendo en algunos casos superior a 800.
Interpretación de resultados
Grupo 1
Personas mayores de 60 años de edad, viudos y pensionados. Este grupo podría ser subdividido en aquellos que completaron la primaria y los que no.
Grupo 2
Aquellos con un estado de salud regular o malo
Grupo 3
Estudiantes menores de edad
Grupo 4
Los deprimidos, separados, con enfermedades agudas y dos meses en cama
Grupo 5
El resto de los pacientes.